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:
parent
d8414c3c20
commit
76fc5887f9
@ -107,6 +107,8 @@ data EmailCreds site = EmailCreds
|
||||
, emailCredsEmail :: Email
|
||||
}
|
||||
|
||||
data UserForm = UserForm { email :: Text }
|
||||
|
||||
class ( YesodAuth site
|
||||
, PathPiece (AuthEmailId site)
|
||||
, (RenderMessage site Msg.AuthMessage)
|
||||
@ -299,18 +301,37 @@ getRegisterR = registerHandler
|
||||
-- Since: 1.2.6
|
||||
defaultRegisterHandler :: YesodAuthEmail master => AuthHandler master Html
|
||||
defaultRegisterHandler = do
|
||||
email <- newIdent
|
||||
tp <- getRouteToParent
|
||||
((f,widget),e) <- lift $ runFormPost registrationForm
|
||||
toParentRoute <- getRouteToParent
|
||||
lift $ authLayout $ do
|
||||
setTitleI Msg.RegisterLong
|
||||
[whamlet|
|
||||
<p>_{Msg.EnterEmail}
|
||||
<form method="post" action="@{tp registerR}">
|
||||
<form method="post" action="@{toParentRoute registerR}">
|
||||
<div id="registerForm">
|
||||
<label for=#{email}>_{Msg.Email}:
|
||||
<input ##{email} type="email" name="email" width="150" autofocus>
|
||||
^{widget}
|
||||
<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
|
||||
=> Bool -- ^ allow usernames?
|
||||
|
||||
Loading…
Reference in New Issue
Block a user