Used monadic form helper for password handler
This needed to happen in order to automatically get CSRF protection Several changes happened while switching over: * Relied on built in names for inputs * Cleaned up naming * Created password helpers for each field * Added a translation for current password
This commit is contained in:
parent
4ed1e7e486
commit
e3aa310c84
@ -107,6 +107,7 @@ data EmailCreds site = EmailCreds
|
|||||||
, emailCredsEmail :: Email
|
, emailCredsEmail :: Email
|
||||||
}
|
}
|
||||||
|
|
||||||
|
data PasswordForm = PasswordForm { passwordCurrent :: Text, passwordNew :: Text, passwordConfirm :: Text }
|
||||||
data UserForm = UserForm { email :: Text }
|
data UserForm = UserForm { email :: Text }
|
||||||
data UserLoginForm = UserLoginForm { loginEmail :: Text, loginPassword :: Text }
|
data UserLoginForm = UserLoginForm { loginEmail :: Text, loginPassword :: Text }
|
||||||
|
|
||||||
@ -516,40 +517,77 @@ getPasswordR = do
|
|||||||
-- Since: 1.2.6
|
-- Since: 1.2.6
|
||||||
defaultSetPasswordHandler :: YesodAuthEmail master => Bool -> AuthHandler master TypedContent
|
defaultSetPasswordHandler :: YesodAuthEmail master => Bool -> AuthHandler master TypedContent
|
||||||
defaultSetPasswordHandler needOld = do
|
defaultSetPasswordHandler needOld = do
|
||||||
tp <- getRouteToParent
|
messageRender <- lift getMessageRender
|
||||||
pass0 <- newIdent
|
toParent <- getRouteToParent
|
||||||
pass1 <- newIdent
|
|
||||||
pass2 <- newIdent
|
|
||||||
mr <- lift getMessageRender
|
|
||||||
selectRep $ do
|
selectRep $ do
|
||||||
provideJsonMessage $ mr Msg.SetPass
|
provideJsonMessage $ messageRender Msg.SetPass
|
||||||
provideRep $ lift $ authLayout $ do
|
provideRep $ lift $ authLayout $ do
|
||||||
setTitleI Msg.SetPassTitle
|
((_,widget),enctype) <- liftWidgetT $ runFormPost $ setPasswordForm needOld
|
||||||
[whamlet|
|
setTitleI Msg.SetPassTitle
|
||||||
$newline never
|
[whamlet|
|
||||||
<h3>_{Msg.SetPass}
|
<h3>_{Msg.SetPass}
|
||||||
<form method="post" action="@{tp setpassR}">
|
<form method="post" action="@{toParent setpassR}">
|
||||||
<table>
|
^{widget}
|
||||||
$if needOld
|
|]
|
||||||
<tr>
|
where
|
||||||
<th>
|
setPasswordForm needOld extra = do
|
||||||
<label for=#{pass0}>Current Password
|
(currentPasswordRes, currentPasswordView) <- mreq passwordField currentPasswordSettings Nothing
|
||||||
<td>
|
(newPasswordRes, newPasswordView) <- mreq passwordField newPasswordSettings Nothing
|
||||||
<input ##{pass0} type="password" name="current" autofocus>
|
(confirmPasswordRes, confirmPasswordView) <- mreq passwordField confirmPasswordSettings Nothing
|
||||||
<tr>
|
|
||||||
<th>
|
let passwordFormRes = PasswordForm <$> currentPasswordRes <*> newPasswordRes <*> confirmPasswordRes
|
||||||
<label for=#{pass1}>_{Msg.NewPass}
|
let widget = do
|
||||||
<td>
|
[whamlet|
|
||||||
<input ##{pass1} type="password" name="new" :not needOld:autofocus>
|
#{extra}
|
||||||
<tr>
|
<table>
|
||||||
<th>
|
$if needOld
|
||||||
<label for=#{pass2}>_{Msg.ConfirmPass}
|
<tr>
|
||||||
<td>
|
<th>
|
||||||
<input ##{pass2} type="password" name="confirm">
|
^{fvLabel currentPasswordView}
|
||||||
<tr>
|
<td>
|
||||||
<td colspan="2">
|
^{fvInput currentPasswordView}
|
||||||
<input type="submit" value=_{Msg.SetPassTitle}>
|
<tr>
|
||||||
|]
|
<th>
|
||||||
|
^{fvLabel newPasswordView}
|
||||||
|
<td>
|
||||||
|
^{fvInput newPasswordView}
|
||||||
|
<tr>
|
||||||
|
<th>
|
||||||
|
^{fvLabel confirmPasswordView}
|
||||||
|
<td>
|
||||||
|
^{fvInput confirmPasswordView}
|
||||||
|
<tr>
|
||||||
|
<td colspan="2">
|
||||||
|
<input type=submit value=_{Msg.SetPassTitle}>
|
||||||
|
|]
|
||||||
|
|
||||||
|
return (passwordFormRes, widget)
|
||||||
|
currentPasswordSettings =
|
||||||
|
FieldSettings {
|
||||||
|
fsLabel = SomeMessage Msg.CurrentPassword,
|
||||||
|
fsTooltip = Nothing,
|
||||||
|
fsId = Just "currentPassword",
|
||||||
|
fsName = Just "current",
|
||||||
|
fsAttrs = [("autofocus", "")]
|
||||||
|
}
|
||||||
|
newPasswordSettings =
|
||||||
|
FieldSettings {
|
||||||
|
fsLabel = SomeMessage Msg.NewPass,
|
||||||
|
fsTooltip = Nothing,
|
||||||
|
fsId = Just "newPassword",
|
||||||
|
fsName = Just "new",
|
||||||
|
fsAttrs = [("autofocus", ""), (":not", ""), ("needOld:autofocus", "")]
|
||||||
|
}
|
||||||
|
confirmPasswordSettings =
|
||||||
|
FieldSettings {
|
||||||
|
fsLabel = SomeMessage Msg.ConfirmPass,
|
||||||
|
fsTooltip = Nothing,
|
||||||
|
fsId = Just "confirmPassword",
|
||||||
|
fsName = Just "confirm",
|
||||||
|
fsAttrs = [("autofocus", "")]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
postPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) TypedContent
|
postPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) TypedContent
|
||||||
postPasswordR = do
|
postPasswordR = do
|
||||||
|
|||||||
@ -60,6 +60,7 @@ data AuthMessage =
|
|||||||
| ProvideIdentifier
|
| ProvideIdentifier
|
||||||
| SendPasswordResetEmail
|
| SendPasswordResetEmail
|
||||||
| PasswordResetPrompt
|
| PasswordResetPrompt
|
||||||
|
| CurrentPassword
|
||||||
| InvalidUsernamePass
|
| InvalidUsernamePass
|
||||||
| Logout
|
| Logout
|
||||||
| LogoutTitle
|
| LogoutTitle
|
||||||
@ -78,6 +79,7 @@ englishMessage LoginYahoo = "Login via Yahoo"
|
|||||||
englishMessage Email = "Email"
|
englishMessage Email = "Email"
|
||||||
englishMessage UserName = "User name"
|
englishMessage UserName = "User name"
|
||||||
englishMessage Password = "Password"
|
englishMessage Password = "Password"
|
||||||
|
englishMessage CurrentPassword = "Current Password"
|
||||||
englishMessage Register = "Register"
|
englishMessage Register = "Register"
|
||||||
englishMessage RegisterLong = "Register a new account"
|
englishMessage RegisterLong = "Register a new account"
|
||||||
englishMessage EnterEmail = "Enter your e-mail address below, and a confirmation e-mail will be sent to you."
|
englishMessage EnterEmail = "Enter your e-mail address below, and a confirmation e-mail will be sent to you."
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user