Bug fixes for last change
This commit is contained in:
parent
799ee875f6
commit
24e6806cde
@ -184,19 +184,19 @@ getOpenIdR = do
|
|||||||
applyLayout "Log in via OpenID" mempty [$hamlet|
|
applyLayout "Log in via OpenID" mempty [$hamlet|
|
||||||
$maybe message msg
|
$maybe message msg
|
||||||
%p.message $msg$
|
%p.message $msg$
|
||||||
%form!method=get!action=@rtom.OpenIdForward@
|
%form!method=get!action=@rtom.OpenIdForwardR@
|
||||||
%label!for=openid OpenID: $
|
%label!for=openid OpenID: $
|
||||||
%input#openid!type=text!name=openid
|
%input#openid!type=text!name=openid
|
||||||
%input!type=submit!value=Login
|
%input!type=submit!value=Login
|
||||||
|]
|
|]
|
||||||
|
|
||||||
getOpenIdForward :: GHandler Auth master ()
|
getOpenIdForwardR :: GHandler Auth master ()
|
||||||
getOpenIdForward = do
|
getOpenIdForwardR = do
|
||||||
testOpenId
|
testOpenId
|
||||||
oid <- runFormGet' $ stringInput "openid"
|
oid <- runFormGet' $ stringInput "openid"
|
||||||
render <- getUrlRender
|
render <- getUrlRender
|
||||||
toMaster <- getRouteToMaster
|
toMaster <- getRouteToMaster
|
||||||
let complete = render $ toMaster OpenIdComplete
|
let complete = render $ toMaster OpenIdCompleteR
|
||||||
res <- runAttemptT $ OpenId.getForwardUrl oid complete
|
res <- runAttemptT $ OpenId.getForwardUrl oid complete
|
||||||
attempt
|
attempt
|
||||||
(\err -> do
|
(\err -> do
|
||||||
@ -205,8 +205,8 @@ getOpenIdForward = do
|
|||||||
(redirectString RedirectTemporary)
|
(redirectString RedirectTemporary)
|
||||||
res
|
res
|
||||||
|
|
||||||
getOpenIdComplete :: YesodAuth master => GHandler Auth master ()
|
getOpenIdCompleteR :: YesodAuth master => GHandler Auth master ()
|
||||||
getOpenIdComplete = do
|
getOpenIdCompleteR = do
|
||||||
testOpenId
|
testOpenId
|
||||||
rr <- getRequest
|
rr <- getRequest
|
||||||
let gets' = reqGetParams rr
|
let gets' = reqGetParams rr
|
||||||
@ -258,8 +258,8 @@ getDisplayName extra =
|
|||||||
where
|
where
|
||||||
choices = ["verifiedEmail", "email", "displayName", "preferredUsername"]
|
choices = ["verifiedEmail", "email", "displayName", "preferredUsername"]
|
||||||
|
|
||||||
getCheck :: Yesod master => GHandler Auth master RepHtmlJson
|
getCheckR :: Yesod master => GHandler Auth master RepHtmlJson
|
||||||
getCheck = do
|
getCheckR = do
|
||||||
creds <- maybeCreds
|
creds <- maybeCreds
|
||||||
applyLayoutJson "Authentication Status" mempty (html creds) (json creds)
|
applyLayoutJson "Authentication Status" mempty (html creds) (json creds)
|
||||||
where
|
where
|
||||||
@ -277,8 +277,8 @@ $maybe creds c
|
|||||||
$ creds >>= credsDisplayName)
|
$ creds >>= credsDisplayName)
|
||||||
]
|
]
|
||||||
|
|
||||||
getLogout :: YesodAuth master => GHandler Auth master ()
|
getLogoutR :: YesodAuth master => GHandler Auth master ()
|
||||||
getLogout = do
|
getLogoutR = do
|
||||||
y <- getYesod
|
y <- getYesod
|
||||||
deleteSession credsKey
|
deleteSession credsKey
|
||||||
redirectUltDest RedirectTemporary $ defaultDest y
|
redirectUltDest RedirectTemporary $ defaultDest y
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user