Unified OpenID 1 and 2

This commit is contained in:
Michael Snoyman 2010-10-05 11:17:28 +02:00
parent ba671beb8d
commit c9d0fd57a2

View File

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