haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Unified OpenID 1 and 2

Browse Source
This commit is contained in:
Michael Snoyman 2010-10-05 11:17:28 +02:00
parent ba671beb8d
commit c9d0fd57a2
1 changed files with 5 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
Yesod/Helpers/Auth2/OpenId.hs
View File

@ -8,8 +8,6 @@ import Yesod
import Yesod.Helpers.Auth2 import Yesod.Helpers.Auth2
import qualified Web.Authenticate.OpenId as OpenId import qualified Web.Authenticate.OpenId as OpenId
import Control.Monad.Attempt import Control.Monad.Attempt
import qualified Web.Authenticate.OpenId2 as OpenId2
import Control.Exception (toException)
forwardUrl :: AuthRoute forwardUrl :: AuthRoute
forwardUrl = PluginR "openid" ["forward"] forwardUrl = PluginR "openid" ["forward"]
@ -18,8 +16,7 @@ authOpenId :: YesodAuth m => AuthPlugin m
authOpenId = authOpenId =
AuthPlugin "openid" dispatch login AuthPlugin "openid" dispatch login
where where
complete1 = PluginR "openid" ["complete1"] complete = PluginR "openid" ["complete"]
complete2 = PluginR "openid" ["complete2"]
name = "openid_identifier" name = "openid_identifier"
login tm = do login tm = do
ident <- newIdent ident <- newIdent
@ -31,7 +28,7 @@ authOpenId =
addBody [$hamlet| addBody [$hamlet|
%form!method=get!action=@tm.forwardUrl@ %form!method=get!action=@tm.forwardUrl@
%label!for=openid OpenID: $ %label!for=openid OpenID: $
%input#$ident$!type=text!name=$name$ %input#$ident$!type=text!name=$name$!value="http://"
%input!type=submit!value="Login via OpenID" %input!type=submit!value="Login via OpenID"
|] |]
dispatch "GET" ["forward"] = do dispatch "GET" ["forward"] = do
@ -40,20 +37,11 @@ authOpenId =
FormSuccess oid -> do FormSuccess oid -> do
render <- getUrlRender render <- getUrlRender
toMaster <- getRouteToMaster toMaster <- getRouteToMaster
let complete2' = render $ toMaster complete2 let complete' = render $ toMaster complete
res2 <- runAttemptT $ OpenId2.getForwardUrl oid complete2'
msg <-
case res2 of
Failure e -> return $ toException e
Success url -> redirectString RedirectTemporary url
let complete' = render $ toMaster complete1
res <- runAttemptT $ OpenId.getForwardUrl oid complete' res <- runAttemptT $ OpenId.getForwardUrl oid complete'
attempt attempt
(\err -> do (\err -> do
setMessage $ string $ unlines setMessage $ string $ show err
[ show err
, show $ toException msg
]
redirect RedirectTemporary $ toMaster LoginR redirect RedirectTemporary $ toMaster LoginR
) )
(redirectString RedirectTemporary) (redirectString RedirectTemporary)
@ -62,9 +50,7 @@ authOpenId =
toMaster <- getRouteToMaster toMaster <- getRouteToMaster
setMessage $ string "No OpenID identifier found" setMessage $ string "No OpenID identifier found"
redirect RedirectTemporary $ toMaster LoginR redirect RedirectTemporary $ toMaster LoginR
dispatch "GET" ["complete1"] = completeHelper OpenId.authenticate dispatch "GET" ["complete"] = completeHelper OpenId.authenticate
dispatch "GET" ["complete2"] =
completeHelper (fmap OpenId.Identifier . OpenId2.authenticate)
dispatch _ _ = notFound dispatch _ _ = notFound
completeHelper completeHelper