Use when
This commit is contained in:
parent
e81a636020
commit
233d53258f
@ -31,6 +31,7 @@ import Language.Haskell.TH.Syntax hiding (lift)
|
|||||||
import qualified Network.Wai as W
|
import qualified Network.Wai as W
|
||||||
import Text.Hamlet (hamlet)
|
import Text.Hamlet (hamlet)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
import Control.Monad (when)
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
@ -110,24 +111,17 @@ setCreds doRedirects creds = do
|
|||||||
maid <- getAuthId creds
|
maid <- getAuthId creds
|
||||||
case maid of
|
case maid of
|
||||||
Nothing ->
|
Nothing ->
|
||||||
if doRedirects
|
when doRedirects $ do
|
||||||
then do
|
|
||||||
case authRoute y of
|
case authRoute y of
|
||||||
Nothing -> do
|
Nothing -> do rh <- defaultLayout [QQ(hamlet)| <h1>Invalid login |]
|
||||||
rh <- defaultLayout
|
|
||||||
[QQ(hamlet)| <h1>Invalid login |]
|
|
||||||
sendResponse rh
|
sendResponse rh
|
||||||
Just ar -> do
|
Just ar -> do setMessageI Msg.InvalidLogin
|
||||||
setMessageI Msg.InvalidLogin
|
|
||||||
redirect RedirectTemporary ar
|
redirect RedirectTemporary ar
|
||||||
else return ()
|
|
||||||
Just aid -> do
|
Just aid -> do
|
||||||
setSession credsKey $ toSinglePiece aid
|
setSession credsKey $ toSinglePiece aid
|
||||||
if doRedirects
|
when doRedirects $ do
|
||||||
then do
|
|
||||||
setMessageI Msg.NowLoggedIn
|
setMessageI Msg.NowLoggedIn
|
||||||
redirectUltDest RedirectTemporary $ loginDest y
|
redirectUltDest RedirectTemporary $ loginDest y
|
||||||
else return ()
|
|
||||||
|
|
||||||
getCheckR :: YesodAuth m => GHandler Auth m RepHtmlJson
|
getCheckR :: YesodAuth m => GHandler Auth m RepHtmlJson
|
||||||
getCheckR = do
|
getCheckR = do
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user