Updated yesod-auth for redirect changes
This commit is contained in:
Michael Snoyman
parent
95b6678e9f
commit
69f2f7b3e7
@ -133,12 +133,12 @@ setCreds doRedirects creds = do
|
||||
Nothing -> do rh <- defaultLayout $ addHtml [QQ(shamlet)| <h1>Invalid login |]
|
||||
sendResponse rh
|
||||
Just ar -> do setMessageI Msg.InvalidLogin
|
||||
redirect RedirectTemporary ar
|
||||
redirect ar
|
||||
Just aid -> do
|
||||
setSession credsKey $ toPathPiece aid
|
||||
when doRedirects $ do
|
||||
setMessageI Msg.NowLoggedIn
|
||||
redirectUltDest RedirectTemporary $ loginDest y
|
||||
redirectUltDest $ loginDest y
|
||||
|
||||
getCheckR :: YesodAuth m => GHandler Auth m RepHtmlJson
|
||||
getCheckR = do
|
||||
@ -175,7 +175,7 @@ postLogoutR :: YesodAuth m => GHandler Auth m ()
|
||||
postLogoutR = do
|
||||
y <- getYesod
|
||||
deleteSession credsKey
|
||||
redirectUltDest RedirectTemporary $ logoutDest y
|
||||
redirectUltDest $ logoutDest y
|
||||
|
||||
handlePluginR :: YesodAuth m => Text -> [Text] -> GHandler Auth m ()
|
||||
handlePluginR plugin pieces = do
|
||||
@ -222,7 +222,7 @@ redirectLogin = do
|
||||
y <- getYesod
|
||||
setUltDest'
|
||||
case authRoute y of
|
||||
Just z -> redirect RedirectTemporary z
|
||||
Just z -> redirect z
|
||||
Nothing -> permissionDenied "Please configure authRoute"
|
||||
|
||||
instance YesodAuth m => RenderMessage m AuthMessage where
|
||||
|
||||
@ -163,7 +163,7 @@ getVerifyR lid key = do
|
||||
setCreds False $ Creds "email" email [("verifiedEmail", email)] -- FIXME uid?
|
||||
toMaster <- getRouteToMaster
|
||||
setMessageI Msg.AddressVerified
|
||||
redirect RedirectTemporary $ toMaster setpassR
|
||||
redirect $ toMaster setpassR
|
||||
_ -> return ()
|
||||
defaultLayout $ do
|
||||
setTitleI Msg.InvalidKey
|
||||
@ -193,7 +193,7 @@ postLoginR = do
|
||||
Nothing -> do
|
||||
setMessageI Msg.InvalidEmailPass
|
||||
toMaster <- getRouteToMaster
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
|
||||
getPasswordR :: YesodAuthEmail master => GHandler Auth master RepHtml
|
||||
getPasswordR = do
|
||||
@ -203,7 +203,7 @@ getPasswordR = do
|
||||
Just _ -> return ()
|
||||
Nothing -> do
|
||||
setMessageI Msg.BadSetPass
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
defaultLayout $ do
|
||||
setTitleI Msg.SetPassTitle
|
||||
addWidget
|
||||
@ -233,17 +233,17 @@ postPasswordR = do
|
||||
y <- getYesod
|
||||
when (new /= confirm) $ do
|
||||
setMessageI Msg.PassMismatch
|
||||
redirect RedirectTemporary $ toMaster setpassR
|
||||
redirect $ toMaster setpassR
|
||||
maid <- maybeAuthId
|
||||
aid <- case maid of
|
||||
Nothing -> do
|
||||
setMessageI Msg.BadSetPass
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
Just aid -> return aid
|
||||
salted <- liftIO $ saltPass new
|
||||
setPassword aid salted
|
||||
setMessageI Msg.PassUpdated
|
||||
redirect RedirectTemporary $ loginDest y
|
||||
redirect $ loginDest y
|
||||
|
||||
saltLength :: Int
|
||||
saltLength = 5
|
||||
|
||||
@ -71,7 +71,7 @@ authFacebook cid secret perms =
|
||||
tm <- getRouteToMaster
|
||||
render <- getUrlRender
|
||||
let fb = Facebook.Facebook cid secret $ render $ tm url
|
||||
redirectText RedirectTemporary $ Facebook.getForwardUrl fb perms
|
||||
redirect $ Facebook.getForwardUrl fb perms
|
||||
dispatch "GET" [] = do
|
||||
render <- getUrlRender
|
||||
tm <- getRouteToMaster
|
||||
@ -92,11 +92,11 @@ authFacebook cid secret perms =
|
||||
case mtoken of
|
||||
Nothing -> do
|
||||
-- Well... then just logout from our app.
|
||||
redirect RedirectTemporary (tm LogoutR)
|
||||
redirect (tm LogoutR)
|
||||
Just at -> do
|
||||
render <- getUrlRender
|
||||
let logout = Facebook.getLogoutUrl at (render $ tm LogoutR)
|
||||
redirectText RedirectTemporary logout
|
||||
redirect logout
|
||||
dispatch _ _ = notFound
|
||||
login tm = do
|
||||
render <- lift getUrlRender
|
||||
|
||||
@ -61,14 +61,14 @@ authGoogleEmail =
|
||||
attempt
|
||||
(\err -> do
|
||||
setMessage $ toHtml $ show err
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
)
|
||||
(redirectText RedirectTemporary)
|
||||
redirect
|
||||
res
|
||||
Nothing -> do
|
||||
toMaster <- getRouteToMaster
|
||||
setMessageI Msg.NoOpenID
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues
|
||||
dispatch "GET" ["complete"] = do
|
||||
rr <- getRequest
|
||||
@ -85,15 +85,15 @@ completeHelper gets' = do
|
||||
toMaster <- getRouteToMaster
|
||||
let onFailure err = do
|
||||
setMessage $ toHtml $ show err
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
let onSuccess (OpenId.Identifier ident, _) = do
|
||||
memail <- lookupGetParam "openid.ext1.value.email"
|
||||
case (memail, "https://www.google.com/accounts/o8/id" `T.isPrefixOf` ident) of
|
||||
(Just email, True) -> setCreds True $ Creds "openid" email []
|
||||
(_, False) -> do
|
||||
setMessage "Only Google login is supported"
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
(Nothing, _) -> do
|
||||
setMessage "No email address provided"
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
attempt onFailure onSuccess res
|
||||
|
||||
@ -179,7 +179,7 @@ postLoginR uniq = do
|
||||
then setCreds True $ Creds "hashdb" (fromMaybe "" mu) []
|
||||
else do setMessage [QQ(shamlet)| Invalid username/password |]
|
||||
toMaster <- getRouteToMaster
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
|
||||
|
||||
-- | A drop in for the getAuthId method of your YesodAuth instance which
|
||||
@ -208,7 +208,7 @@ getAuthIdHashDB authR uniq creds = do
|
||||
Just (uid, _) -> return $ Just uid
|
||||
Nothing -> do
|
||||
setMessage [QQ(shamlet)| User not found |]
|
||||
redirect RedirectTemporary $ authR LoginR
|
||||
redirect $ authR LoginR
|
||||
|
||||
-- | Prompt for username and password, validate that against a database
|
||||
-- which holds the username and a hash of the password
|
||||
|
||||
@ -99,7 +99,7 @@ postLoginR config = do
|
||||
let errorMessage (message :: Text) = do
|
||||
setMessage [QQ(shamlet)|Error: #{message}|]
|
||||
toMaster <- getRouteToMaster
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
|
||||
case (mu,mp) of
|
||||
(Nothing, _ ) -> errorMessage "Please fill in your username"
|
||||
|
||||
@ -53,7 +53,7 @@ authOAuth name ident reqUrl accUrl authUrl key sec = AuthPlugin name dispatch lo
|
||||
tm <- getRouteToMaster
|
||||
let oauth' = oauth { oauthCallback = Just $ encodeUtf8 $ render $ tm url }
|
||||
tok <- liftIO $ getTemporaryCredential oauth'
|
||||
redirectText RedirectTemporary (fromString $ authorizeUrl oauth' tok)
|
||||
redirect $ authorizeUrl oauth' tok
|
||||
dispatch "GET" [] = do
|
||||
(verifier, oaTok) <- runInputGet $ (,)
|
||||
<$> ireq textField "oauth_verifier"
|
||||
|
||||
@ -64,14 +64,14 @@ authOpenIdExtended extensionFields =
|
||||
attempt
|
||||
(\err -> do
|
||||
setMessage $ toHtml $ show err
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
)
|
||||
(redirectText RedirectTemporary)
|
||||
redirect
|
||||
res
|
||||
Nothing -> do
|
||||
toMaster <- getRouteToMaster
|
||||
setMessageI Msg.NoOpenID
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues
|
||||
dispatch "GET" ["complete"] = do
|
||||
rr <- getRequest
|
||||
@ -88,7 +88,7 @@ completeHelper gets' = do
|
||||
toMaster <- getRouteToMaster
|
||||
let onFailure err = do
|
||||
setMessage $ toHtml $ show err
|
||||
redirect RedirectTemporary $ toMaster LoginR
|
||||
redirect $ toMaster LoginR
|
||||
let onSuccess (OpenId.Identifier ident, _) =
|
||||
setCreds True $ Creds "openid" ident gets'
|
||||
attempt onFailure onSuccess res
|
||||
|
||||
@ -21,7 +21,7 @@ library
|
||||
cpp-options: -DGHC7
|
||||
else
|
||||
build-depends: base >= 4 && < 4.3
|
||||
build-depends: authenticate >= 0.11 && < 0.12
|
||||
build-depends: authenticate >= 0.11.1 && < 0.12
|
||||
, bytestring >= 0.9.1.4 && < 0.10
|
||||
, yesod-core >= 0.10 && < 0.11
|
||||
, wai >= 1.0 && < 1.1
|
||||
|
||||
Loading…
Reference in New Issue
Block a user