GoogleEmail skips unnecessary parameter

This commit is contained in:
Michael Snoyman 2012-02-12 15:23:01 +02:00
parent 4a53d48bb5
commit 2e71fb0a28
2 changed files with 24 additions and 32 deletions

View File

@ -31,45 +31,37 @@ import Control.Exception.Lifted (try, SomeException)
forwardUrl :: AuthRoute
forwardUrl = PluginR "googleemail" ["forward"]
googleIdent :: Text
googleIdent = "https://www.google.com/accounts/o8/id"
authGoogleEmail :: YesodAuth m => AuthPlugin m
authGoogleEmail =
AuthPlugin "googleemail" dispatch login
where
complete = PluginR "googleemail" ["complete"]
name = "openid_identifier"
login tm = do
[whamlet|
<form method=get action=@{tm forwardUrl}>
<input type=hidden name=openid_identifier value=https://www.google.com/accounts/o8/id>
<input type=submit value=_{Msg.LoginGoogle}>
|]
login tm =
[whamlet|<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}|]
dispatch "GET" ["forward"] = do
roid <- runInputGet $ iopt textField name
case roid of
Just oid -> do
render <- getUrlRender
toMaster <- getRouteToMaster
let complete' = render $ toMaster complete
master <- getYesod
eres <- lift $ try $ OpenId.getForwardUrl oid complete' Nothing
[ ("openid.ax.type.email", "http://schema.openid.net/contact/email")
, ("openid.ns.ax", "http://openid.net/srv/ax/1.0")
, ("openid.ns.ax.required", "email")
, ("openid.ax.mode", "fetch_request")
, ("openid.ax.required", "email")
, ("openid.ui.icon", "true")
] (authHttpManager master)
either
(\err -> do
setMessage $ toHtml $ show (err :: SomeException)
redirect $ toMaster LoginR
)
redirect
eres
Nothing -> do
toMaster <- getRouteToMaster
setMessageI Msg.NoOpenID
render <- getUrlRender
toMaster <- getRouteToMaster
let complete' = render $ toMaster complete
master <- getYesod
eres <- lift $ try $ OpenId.getForwardUrl googleIdent complete' Nothing
[ ("openid.ax.type.email", "http://schema.openid.net/contact/email")
, ("openid.ns.ax", "http://openid.net/srv/ax/1.0")
, ("openid.ns.ax.required", "email")
, ("openid.ax.mode", "fetch_request")
, ("openid.ax.required", "email")
, ("openid.ui.icon", "true")
] (authHttpManager master)
either
(\err -> do
setMessage $ toHtml $ show (err :: SomeException)
redirect $ toMaster LoginR
)
redirect
eres
dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues
dispatch "GET" ["complete"] = do
rr <- getRequest

View File

@ -1,5 +1,5 @@
name: yesod-auth
version: 0.8.1
version: 0.8.1.1
license: BSD3
license-file: LICENSE
author: Michael Snoyman, Patrick Brisbin