module Handler.Login where import Import import Data.Text data Credentials = Credentials { credentialsName :: Text , credentialsPasswd :: Text } deriving Show getLoginR :: Handler Html getLoginR = do (loginWidget, enctype) <- generateFormPost loginForm defaultLayout $ do $(widgetFile "login") postLoginR :: Handler Html 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 setSession "userId" $ extractKey $ entityKey user setMessage $ [shamlet|
Successfully logged in|]
              redirect $ HomeR
            False -> do
              setMessage $ [shamlet|
Login error|]
              redirect $ LoginR
        Nothing -> do
          setMessage $ [shamlet|
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
  deleteSession "userId"
  setMessage $ [shamlet|
Succesfully logged out|]
  redirect $ HomeR