register and login now work
This commit is contained in:
parent
ff3bc3f89e
commit
07c0d37ceb
@ -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)
|
||||
|
@ -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"
|
||||
|
||||
|
@ -7,7 +7,7 @@ User
|
||||
|
||||
Email
|
||||
email Text
|
||||
user UserId Maybe
|
||||
user UserId
|
||||
verkey Text Maybe
|
||||
UniqueEmail email
|
||||
|
||||
|
@ -52,6 +52,7 @@ library
|
||||
, yesod >= 1.4.1 && < 1.5
|
||||
, yesod-core >= 1.4.6 && < 1.5
|
||||
, yesod-auth >= 1.4.0 && < 1.5
|
||||
, yesod-persistent >= 1.4.0 && < 1.5
|
||||
, yesod-static >= 1.4.0.3 && < 1.5
|
||||
, yesod-form >= 1.4.0 && < 1.5
|
||||
, classy-prelude >= 0.10.2
|
||||
|
Loading…
Reference in New Issue
Block a user