haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #1461 from LiveViewTech/redirect_to_current

Browse Source 
Redirect to current
This commit is contained in:
Michael Snoyman 2017-12-08 09:02:59 +02:00 committed by GitHub
commit c122af25ad
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
yesod-auth/ChangeLog.md
View File

@ -1,3 +1,7 @@
## 1.4.21
* Add redirectToCurrent to Yesod.Auth module for controlling setUltDestCurrent in redirectLogin [#1461](https://github.com/yesodweb/yesod/pull/1461)
## 1.4.20 ## 1.4.20
* Extend `YesodAuthEmail` to support extensible password hashing via * Extend `YesodAuthEmail` to support extensible password hashing via

14
yesod-auth/Yesod/Auth.hs
View File

@ -166,7 +166,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
-- > when (isJust ma) $ -- > when (isJust ma) $
-- > lift $ redirect HomeR -- or any other Handler code you want -- > lift $ redirect HomeR -- or any other Handler code you want
-- > defaultLoginHandler -- > defaultLoginHandler
-- --
loginHandler :: HandlerT Auth (HandlerT master IO) Html loginHandler :: HandlerT Auth (HandlerT master IO) Html
loginHandler = defaultLoginHandler loginHandler = defaultLoginHandler
@ -182,6 +182,12 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
redirectToReferer :: master -> Bool redirectToReferer :: master -> Bool
redirectToReferer _ = False redirectToReferer _ = False
-- | When being redirected to the login page should the current page
-- be set to redirect back to. Default is 'True'.
-- @since 1.4.18
redirectToCurrent :: master -> Bool
redirectToCurrent _ = True
-- | Return an HTTP connection manager that is stored in the foundation -- | Return an HTTP connection manager that is stored in the foundation
-- type. This allows backends to reuse persistent connections. If none of -- type. This allows backends to reuse persistent connections. If none of
-- the backends you're using use HTTP connections, you can safely return -- the backends you're using use HTTP connections, you can safely return
@ -551,15 +557,15 @@ requireAuthPair :: (YesodAuthPersist master, Typeable (AuthEntity master))
=> HandlerT master IO (AuthId master, AuthEntity master) => HandlerT master IO (AuthId master, AuthEntity master)
requireAuthPair = maybeAuthPair >>= maybe handleAuthLack return requireAuthPair = maybeAuthPair >>= maybe handleAuthLack return
handleAuthLack :: Yesod master => HandlerT master IO a handleAuthLack :: YesodAuth master => HandlerT master IO a
handleAuthLack = do handleAuthLack = do
aj <- acceptsJson aj <- acceptsJson
if aj then notAuthenticated else redirectLogin if aj then notAuthenticated else redirectLogin
redirectLogin :: Yesod master => HandlerT master IO a redirectLogin :: YesodAuth master => HandlerT master IO a
redirectLogin = do redirectLogin = do
y <- getYesod y <- getYesod
setUltDestCurrent when (redirectToCurrent y) setUltDestCurrent
case authRoute y of case authRoute y of
Just z -> redirect z Just z -> redirect z
Nothing -> permissionDenied "Please configure authRoute" Nothing -> permissionDenied "Please configure authRoute"

2
yesod-auth/yesod-auth.cabal
View File

@ -1,5 +1,5 @@
name: yesod-auth name: yesod-auth
version: 1.4.20 version: 1.4.21
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman, Patrick Brisbin author: Michael Snoyman, Patrick Brisbin