Drezil/neat
1
0
Fork 0
Code Issues 5 Pull Requests Projects Releases Wiki Activity

register and login now work

Browse Source
This commit is contained in:
Stefan Dresselhaus
2015-06-16 17:03:34 +02:00
parent ff3bc3f89e
commit 07c0d37ceb
4 changed files with 20 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
Handler/Home.hs
View File

@ -47,18 +47,27 @@ getHomeR = do
postHomeR :: Handler Html
postHomeR = do
((result, loginWidget), loginEnctype) <- runFormPost loginForm
defaultLayout $ do
let loginfail err = defaultLayout $ do
setTitle "NEAT"
[whamlet|
<h1>
Welcome to NEAT.
<div>
<div class="alert alert-danger fade in">#{err}
Login
<form method=post action=@{HomeR} enctype=#{loginEnctype}>
^{loginWidget}
<button>Submit
<a href=@{RegisterR}>Register Account
|]
case result of
FormSuccess (u,pw) -> do
login <- runDB $ selectFirst [UserIdent ==. u, UserPassword ==. (Just pw)] []
case login of
Nothing -> loginfail ("wrong username or password" :: Text)
Just (Entity _ (User name _ _)) ->
defaultLayout $ do [whamlet|<h1>Hello #{name}|]
_ -> loginfail ("wrong username or password" :: Text)
sampleForm :: Form (FileInfo, Text)

12
Handler/Register.hs
View File

@ -2,7 +2,7 @@ module Handler.Register where
import Import
import Yesod.Form.Bootstrap3
import Yesod.Form.Functions
import Handler.Home (getHomeR)
getRegisterR :: Handler Html
getRegisterR = do
@ -18,16 +18,20 @@ getRegisterR = do
postRegisterR :: Handler Html
postRegisterR = do
((result,registerWidget), registerEnctype) <- runFormPost registerForm
let again error = defaultLayout $ do
let again err = defaultLayout $ do
setTitle "Register"
[whamlet|
<div class="alert alert-danger fade in"><strong>Error:</strong> #{error}
<div class="alert alert-danger fade in"><strong>Error:</strong> #{err}
<h1>Register
<form method=post action=@{RegisterR} enctype=#{registerEnctype}>
^{registerWidget}
|]
case result of
FormSuccess a -> defaultLayout $ [whamlet|<h1> success|]
FormSuccess (user,mail) -> do
_ <- runDB $ do
uid <- insert user
insert $ Email mail uid Nothing
getHomeR
FormFailure (err:_) -> again err
_ -> again "Invalid input"