authentication works

This commit is contained in:
nek0 2014-08-12 18:14:59 +02:00
parent c10806fffc
commit 8a81217624
6 changed files with 64 additions and 6 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

6
templates/login.hamlet Normal file
View file

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