register and login now work
This commit is contained in:
parent
ff3bc3f89e
commit
07c0d37ceb
@ -47,18 +47,27 @@ getHomeR = do
|
|||||||
postHomeR :: Handler Html
|
postHomeR :: Handler Html
|
||||||
postHomeR = do
|
postHomeR = do
|
||||||
((result, loginWidget), loginEnctype) <- runFormPost loginForm
|
((result, loginWidget), loginEnctype) <- runFormPost loginForm
|
||||||
defaultLayout $ do
|
let loginfail err = defaultLayout $ do
|
||||||
setTitle "NEAT"
|
setTitle "NEAT"
|
||||||
[whamlet|
|
[whamlet|
|
||||||
<h1>
|
<h1>
|
||||||
Welcome to NEAT.
|
Welcome to NEAT.
|
||||||
<div>
|
<div>
|
||||||
|
<div class="alert alert-danger fade in">#{err}
|
||||||
Login
|
Login
|
||||||
<form method=post action=@{HomeR} enctype=#{loginEnctype}>
|
<form method=post action=@{HomeR} enctype=#{loginEnctype}>
|
||||||
^{loginWidget}
|
^{loginWidget}
|
||||||
<button>Submit
|
<button>Submit
|
||||||
<a href=@{RegisterR}>Register Account
|
<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)
|
sampleForm :: Form (FileInfo, Text)
|
||||||
|
@ -2,7 +2,7 @@ module Handler.Register where
|
|||||||
|
|
||||||
import Import
|
import Import
|
||||||
import Yesod.Form.Bootstrap3
|
import Yesod.Form.Bootstrap3
|
||||||
import Yesod.Form.Functions
|
import Handler.Home (getHomeR)
|
||||||
|
|
||||||
getRegisterR :: Handler Html
|
getRegisterR :: Handler Html
|
||||||
getRegisterR = do
|
getRegisterR = do
|
||||||
@ -18,16 +18,20 @@ getRegisterR = do
|
|||||||
postRegisterR :: Handler Html
|
postRegisterR :: Handler Html
|
||||||
postRegisterR = do
|
postRegisterR = do
|
||||||
((result,registerWidget), registerEnctype) <- runFormPost registerForm
|
((result,registerWidget), registerEnctype) <- runFormPost registerForm
|
||||||
let again error = defaultLayout $ do
|
let again err = defaultLayout $ do
|
||||||
setTitle "Register"
|
setTitle "Register"
|
||||||
[whamlet|
|
[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
|
<h1>Register
|
||||||
<form method=post action=@{RegisterR} enctype=#{registerEnctype}>
|
<form method=post action=@{RegisterR} enctype=#{registerEnctype}>
|
||||||
^{registerWidget}
|
^{registerWidget}
|
||||||
|]
|
|]
|
||||||
case result of
|
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
|
FormFailure (err:_) -> again err
|
||||||
_ -> again "Invalid input"
|
_ -> again "Invalid input"
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@ User
|
|||||||
|
|
||||||
Email
|
Email
|
||||||
email Text
|
email Text
|
||||||
user UserId Maybe
|
user UserId
|
||||||
verkey Text Maybe
|
verkey Text Maybe
|
||||||
UniqueEmail email
|
UniqueEmail email
|
||||||
|
|
||||||
|
@ -52,6 +52,7 @@ library
|
|||||||
, yesod >= 1.4.1 && < 1.5
|
, yesod >= 1.4.1 && < 1.5
|
||||||
, yesod-core >= 1.4.6 && < 1.5
|
, yesod-core >= 1.4.6 && < 1.5
|
||||||
, yesod-auth >= 1.4.0 && < 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-static >= 1.4.0.3 && < 1.5
|
||||||
, yesod-form >= 1.4.0 && < 1.5
|
, yesod-form >= 1.4.0 && < 1.5
|
||||||
, classy-prelude >= 0.10.2
|
, classy-prelude >= 0.10.2
|
||||||
|
Loading…
Reference in New Issue
Block a user