AuthEmail: Fix forgot-password endpoint

This is a quick fix for PR#1524.
Currently, defining `emailPreviouslyRegisteredResponse` will prevent
`sendConfirmationEmail` from happening, even when `registerHelper` is
called from `postForgotPasswordR`.
This commit is contained in:
hainq 2018-07-09 17:22:24 +07:00
parent 71d951c09b
commit 0c136f14eb

View File

@ -516,10 +516,10 @@ parseRegister = withObject "email" (\obj -> do
registerHelper :: YesodAuthEmail master registerHelper :: YesodAuthEmail master
=> Bool -- ^ allow usernames? => Bool -- ^ allow usernames?
-> Bool -- ^ allow password? -> Bool -- ^ forgot password?
-> Route Auth -> Route Auth
-> AuthHandler master TypedContent -> AuthHandler master TypedContent
registerHelper allowUsername allowPassword dest = do registerHelper allowUsername forgotPassword dest = do
y <- getYesod y <- getYesod
checkCsrfHeaderOrParam defaultCsrfHeaderName defaultCsrfParamName checkCsrfHeaderOrParam defaultCsrfHeaderName defaultCsrfParamName
result <- runInputPostResult $ (,) result <- runInputPostResult $ (,)
@ -542,8 +542,8 @@ registerHelper allowUsername allowPassword dest = do
| allowUsername -> Right $ TS.strip x | allowUsername -> Right $ TS.strip x
| otherwise -> Left Msg.InvalidEmailAddress | otherwise -> Left Msg.InvalidEmailAddress
let mpass = case (allowPassword, creds) of let mpass = case (forgotPassword, creds) of
(True, Just (_, mp)) -> mp (False, Just (_, mp)) -> mp
_ -> Nothing _ -> Nothing
case eidentifier of case eidentifier of
@ -571,9 +571,10 @@ registerHelper allowUsername allowPassword dest = do
Nothing -> loginErrorMessageI dest (Msg.IdentifierNotFound identifier) Nothing -> loginErrorMessageI dest (Msg.IdentifierNotFound identifier)
Just creds@(_, False, _, _) -> sendConfirmationEmail creds Just creds@(_, False, _, _) -> sendConfirmationEmail creds
Just creds@(_, True, _, _) -> do Just creds@(_, True, _, _) -> do
case emailPreviouslyRegisteredResponse identifier of if forgotPassword then sendConfirmationEmail creds
Just response -> response else case emailPreviouslyRegisteredResponse identifier of
Nothing -> sendConfirmationEmail creds Just response -> response
Nothing -> sendConfirmationEmail creds
where sendConfirmationEmail (lid, _, verKey, email) = do where sendConfirmationEmail (lid, _, verKey, email) = do
render <- getUrlRender render <- getUrlRender
tp <- getRouteToParent tp <- getRouteToParent
@ -583,7 +584,7 @@ registerHelper allowUsername allowPassword dest = do
postRegisterR :: YesodAuthEmail master => AuthHandler master TypedContent postRegisterR :: YesodAuthEmail master => AuthHandler master TypedContent
postRegisterR = registerHelper False True registerR postRegisterR = registerHelper False False registerR
getForgotPasswordR :: YesodAuthEmail master => AuthHandler master Html getForgotPasswordR :: YesodAuthEmail master => AuthHandler master Html
getForgotPasswordR = forgotPasswordHandler getForgotPasswordR = forgotPasswordHandler
@ -627,7 +628,7 @@ defaultForgotPasswordHandler = do
} }
postForgotPasswordR :: YesodAuthEmail master => AuthHandler master TypedContent postForgotPasswordR :: YesodAuthEmail master => AuthHandler master TypedContent
postForgotPasswordR = registerHelper True False forgotPasswordR postForgotPasswordR = registerHelper True True forgotPasswordR
getVerifyR :: YesodAuthEmail site getVerifyR :: YesodAuthEmail site
=> AuthEmailId site => AuthEmailId site