Fixed registerHandler CSRF issue

The default register handler for email authentication didn't provide a
CSRF token. I provided one by using a monadic form helper.
This commit is contained in:
Alex Kardos 2016-02-17 20:39:09 -07:00
parent d8414c3c20
commit 76fc5887f9

View File

@ -107,6 +107,8 @@ data EmailCreds site = EmailCreds
, emailCredsEmail :: Email , emailCredsEmail :: Email
} }
data UserForm = UserForm { email :: Text }
class ( YesodAuth site class ( YesodAuth site
, PathPiece (AuthEmailId site) , PathPiece (AuthEmailId site)
, (RenderMessage site Msg.AuthMessage) , (RenderMessage site Msg.AuthMessage)
@ -299,18 +301,37 @@ getRegisterR = registerHandler
-- Since: 1.2.6 -- Since: 1.2.6
defaultRegisterHandler :: YesodAuthEmail master => AuthHandler master Html defaultRegisterHandler :: YesodAuthEmail master => AuthHandler master Html
defaultRegisterHandler = do defaultRegisterHandler = do
email <- newIdent ((f,widget),e) <- lift $ runFormPost registrationForm
tp <- getRouteToParent toParentRoute <- getRouteToParent
lift $ authLayout $ do lift $ authLayout $ do
setTitleI Msg.RegisterLong setTitleI Msg.RegisterLong
[whamlet| [whamlet|
<p>_{Msg.EnterEmail} <p>_{Msg.EnterEmail}
<form method="post" action="@{tp registerR}"> <form method="post" action="@{toParentRoute registerR}">
<div id="registerForm"> <div id="registerForm">
<label for=#{email}>_{Msg.Email}: ^{widget}
<input ##{email} type="email" name="email" width="150" autofocus>
<button .btn>_{Msg.Register} <button .btn>_{Msg.Register}
|] |]
where
registrationForm extra = do
let emailSettings = FieldSettings {
fsLabel = "Email" ,
fsTooltip = Nothing ,
fsId = Just "email",
fsName = Just "email",
fsAttrs = []
}
(emailRes, emailView) <- mreq textField emailSettings Nothing
let userRes = UserForm <$> emailRes
let widget = do
[whamlet|
#{extra}
^{fvInput emailView}
|]
return (userRes, widget)
registerHelper :: YesodAuthEmail master registerHelper :: YesodAuthEmail master
=> Bool -- ^ allow usernames? => Bool -- ^ allow usernames?