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
|
, 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?
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user