add a way to control redirection to current location when redirectLogin is called

This commit is contained in:
Casey Allred 2017-12-07 13:56:53 -07:00
parent fc9d45aa33
commit f82d08b32a
3 changed files with 16 additions and 6 deletions

View File

@ -1,3 +1,7 @@
## 1.4.18
* Add redirectToCurrent to Yesod.Auth module for controlling setUltDestCurrent in redirectLogin
## 1.4.17 ## 1.4.17
* Add Show instance for user credentials `Creds` * Add Show instance for user credentials `Creds`

View File

@ -167,7 +167,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
-- > 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 :: AuthHandler master Html
loginHandler = defaultLoginHandler loginHandler = defaultLoginHandler
-- | Used for i18n of messages provided by this package. -- | Used for i18n of messages provided by this package.
@ -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
@ -550,15 +556,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"

View File

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