Bug fixes for last change

This commit is contained in:
Michael Snoyman 2010-08-18 00:01:03 +03:00
parent 799ee875f6
commit 24e6806cde

View File

@ -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