Unified OpenID 1 and 2
This commit is contained in:
parent
ba671beb8d
commit
c9d0fd57a2
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user