eidolon/Handler/Login.hs

48 lines
1.3 KiB
Haskell
Raw Normal View History

2014-08-12 12:42:25 +00:00
module Handler.Login where
import Import
2014-08-13 20:30:48 +00:00
import Data.Text
2014-08-12 12:42:25 +00:00
2014-08-12 16:14:59 +00:00
data Credentials = Credentials
{ credentialsName :: Text
, credentialsPasswd :: Text
}
deriving Show
2014-08-12 12:42:25 +00:00
getLoginR :: Handler Html
2014-08-12 16:14:59 +00:00
getLoginR = do
(loginWidget, enctype) <- generateFormPost loginForm
defaultLayout $ do
$(widgetFile "login")
2014-08-12 12:42:25 +00:00
postLoginR :: Handler Html
2014-08-12 16:14:59 +00:00
postLoginR = do
((result, loginWidget), enctype) <- runFormPost loginForm
case result of
FormSuccess cred -> do
tuser <- runDB $ selectFirst [UserName ==. credentialsName cred] []
case tuser of
Just user -> do
case credentialsPasswd cred == userPassword (entityVal user) of
True -> do
2014-08-13 20:30:48 +00:00
setSession "userId" $ pack $ show $ entityKey user
2014-08-12 16:14:59 +00:00
setMessage $ [shamlet|<pre>Successfully logged in|]
redirect $ HomeR
False -> do
setMessage $ [shamlet|<pre>Login error|]
redirect $ LoginR
Nothing -> do
setMessage $ [shamlet|<pre>User does not exist|]
redirect $ LoginR
loginForm :: Form Credentials
loginForm = renderDivs $ Credentials
<$> areq textField "Username" Nothing
<*> areq passwordField "Password" Nothing
getLogoutR :: Handler Html
getLogoutR = do
2014-08-13 20:30:48 +00:00
deleteSession "userId"
2014-08-12 16:14:59 +00:00
setMessage $ [shamlet|<pre>Succesfully logged out|]
redirect $ HomeR