yesod-auth: redirectToReferer
This commit is contained in:
parent
1f88d34c0c
commit
4070b8e49a
@ -96,6 +96,11 @@ class (Yesod m, SinglePiece (AuthId m), RenderMessage m FormMessage) => YesodAut
|
|||||||
-> AuthMessage -> Text
|
-> AuthMessage -> Text
|
||||||
renderAuthMessage _ _ = defaultMessage
|
renderAuthMessage _ _ = defaultMessage
|
||||||
|
|
||||||
|
-- | After login and logout, redirect to the referring page, instead of
|
||||||
|
-- 'loginDest' and 'logoutDest'. Default is 'False'.
|
||||||
|
redirectToReferer :: m -> Bool
|
||||||
|
redirectToReferer _ = False
|
||||||
|
|
||||||
mkYesodSub "Auth"
|
mkYesodSub "Auth"
|
||||||
[ ClassP ''YesodAuth [VarT $ mkName "master"]
|
[ ClassP ''YesodAuth [VarT $ mkName "master"]
|
||||||
]
|
]
|
||||||
@ -149,11 +154,16 @@ $nothing
|
|||||||
[ (T.pack "logged_in", Bool $ maybe False (const True) creds)
|
[ (T.pack "logged_in", Bool $ maybe False (const True) creds)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
setUltDestReferer' :: YesodAuth master => GHandler sub master ()
|
||||||
|
setUltDestReferer' = do
|
||||||
|
m <- getYesod
|
||||||
|
when (redirectToReferer m) setUltDestReferer
|
||||||
|
|
||||||
getLoginR :: YesodAuth m => GHandler Auth m RepHtml
|
getLoginR :: YesodAuth m => GHandler Auth m RepHtml
|
||||||
getLoginR = setUltDestReferer >> loginHandler
|
getLoginR = setUltDestReferer' >> loginHandler
|
||||||
|
|
||||||
getLogoutR :: YesodAuth m => GHandler Auth m ()
|
getLogoutR :: YesodAuth m => GHandler Auth m ()
|
||||||
getLogoutR = setUltDestReferer >> postLogoutR -- FIXME redirect to post
|
getLogoutR = setUltDestReferer' >> postLogoutR -- FIXME redirect to post
|
||||||
|
|
||||||
postLogoutR :: YesodAuth m => GHandler Auth m ()
|
postLogoutR :: YesodAuth m => GHandler Auth m ()
|
||||||
postLogoutR = do
|
postLogoutR = do
|
||||||
|
|||||||
@ -20,14 +20,20 @@ mkYesod "BID" [parseRoutes|
|
|||||||
/auth AuthR Auth getAuth
|
/auth AuthR Auth getAuth
|
||||||
|]
|
|]
|
||||||
|
|
||||||
getRootR :: Handler ()
|
getRootR :: Handler RepHtml
|
||||||
getRootR = redirect RedirectTemporary $ AuthR LoginR
|
getRootR = getAfterLoginR
|
||||||
|
|
||||||
getAfterLoginR :: Handler RepHtml
|
getAfterLoginR :: Handler RepHtml
|
||||||
getAfterLoginR = do
|
getAfterLoginR = do
|
||||||
mauth <- maybeAuthId
|
mauth <- maybeAuthId
|
||||||
defaultLayout $ addHamlet [hamlet|
|
defaultLayout $ addHamlet [hamlet|
|
||||||
<p>Auth: #{show mauth}
|
<p>Auth: #{show mauth}
|
||||||
|
$maybe _ <- mauth
|
||||||
|
<p>
|
||||||
|
<a href=@{AuthR LogoutR}>Logout
|
||||||
|
$nothing
|
||||||
|
<p>
|
||||||
|
<a href=@{AuthR LoginR}>Login
|
||||||
|]
|
|]
|
||||||
|
|
||||||
instance Yesod BID where
|
instance Yesod BID where
|
||||||
|
|||||||
@ -1,5 +1,5 @@
|
|||||||
name: yesod-auth
|
name: yesod-auth
|
||||||
version: 0.7.3
|
version: 0.7.4
|
||||||
license: BSD3
|
license: BSD3
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Michael Snoyman, Patrick Brisbin
|
author: Michael Snoyman, Patrick Brisbin
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user