diff --git a/Foundation.hs b/Foundation.hs index 4ce8d7b..be4db98 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -14,10 +14,12 @@ import qualified Database.Persist import Database.Persist.Sql (SqlPersistT) import Settings.StaticFiles import Settings (widgetFile, Extra (..)) --- import Model +import Model import Text.Jasmine (minifym) import Text.Hamlet (hamletFile) import Yesod.Core.Types (Logger) +-- costom imports +import Data.Maybe -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -63,6 +65,7 @@ instance Yesod App where defaultLayout widget = do master <- getYesod mmsg <- getMessage + msu <- lookupSession "username" -- We break up the default layout into two components: -- default-layout is the contents of the body tag, and diff --git a/Handler/Login.hs b/Handler/Login.hs index b9fa9bb..33c7d1a 100644 --- a/Handler/Login.hs +++ b/Handler/Login.hs @@ -2,8 +2,45 @@ module Handler.Login where import Import +data Credentials = Credentials + { credentialsName :: Text + , credentialsPasswd :: Text + } + deriving Show + getLoginR :: Handler Html -getLoginR = error "Not yet implemented: getLoginR" +getLoginR = do + (loginWidget, enctype) <- generateFormPost loginForm + defaultLayout $ do + $(widgetFile "login") postLoginR :: Handler Html -postLoginR = error "Not yet implemented: postLoginR" +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 "username" $ userName (entityVal 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 "username" + setMessage $ [shamlet|Succesfully logged out|] + redirect $ HomeR diff --git a/config/routes b/config/routes index 6a73369..3674938 100644 --- a/config/routes +++ b/config/routes @@ -6,4 +6,5 @@ / HomeR GET POST /signup SignupR GET POST /login LoginR GET POST +/logout LogoutR GET /activate/#String ActivateR GET diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index fa86744..b2cf2e5 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -1,3 +1,17 @@ +