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

Use when

Browse Source
This commit is contained in:
Alexey Khudyakov 2011-06-05 21:50:07 +04:00
parent e81a636020
commit 233d53258f
1 changed files with 10 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
Yesod/Auth.hs
View File

@ -31,7 +31,8 @@ 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.Trans.Class (lift) import Control.Monad (when)
import Control.Monad.Trans.Class (lift)
import Data.Aeson import Data.Aeson
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
@ -106,28 +107,21 @@ credsKey = "_ID"
-- | FIXME: won't show up till redirect -- | FIXME: won't show up till redirect
setCreds :: YesodAuth m => Bool -> Creds m -> GHandler s m () setCreds :: YesodAuth m => Bool -> Creds m -> GHandler s m ()
setCreds doRedirects creds = do setCreds doRedirects creds = do
y <- getYesod y <- getYesod
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 rh <- defaultLayout [QQ(hamlet)| <h1>Invalid login |]
Nothing -> do
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