This commit is contained in:
Alexey Khudyakov 2011-06-05 21:50:07 +04:00
parent e81a636020
commit 233d53258f

View File

@ -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