authentication works

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

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|<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
+  deleteSession "username"
+  setMessage $ [shamlet|<pre>Succesfully logged out|]
+  redirect $ HomeR

config/routes

@@ -6,4 +6,5 @@
 / HomeR GET POST
 /signup SignupR GET POST
 /login LoginR GET POST
+/logout LogoutR GET
 /activate/#String ActivateR GET

templates/default-layout.hamlet

@@ -1,3 +1,17 @@
+<nav>
+  <div id="top-nav">
+  <ul id="user-nav">
+    $maybe user <- msu
+      Logged in as #{fromJust msu}
+      <li>
+        <a href=@{LogoutR}>Logout
+    $nothing
+      <li>
+        <a href=@{LoginR}>Login
+      <li>
+        <a href=@{SignupR}>Signup
+
+
 $maybe msg <- mmsg
     <div #message>#{msg}
 ^{widget}

templates/home.hamlet

@@ -1,6 +1,3 @@
-<a href=@{LoginR}>Login
-<a href=@{SignupR}>Signup
-
 $if null recentMedia
   <p>This gallery is still empty.
 $else

templates/login.hamlet

@@ -0,0 +1,6 @@
+<h3>Login
+
+<form method=post enctype=#{enctype}>
+  ^{loginWidget}
+  <div>
+    <input type=submit value="Login">