adjust password validation
This commit is contained in:
parent
d3a7d82dc0
commit
89a5cd5775
|
@ -34,17 +34,23 @@ getChangePasswordR = do
|
||||||
|
|
||||||
postChangePasswordR :: Handler Html
|
postChangePasswordR :: Handler Html
|
||||||
postChangePasswordR = do
|
postChangePasswordR = do
|
||||||
userId <- requireAuthId
|
(userId, user) <- requireAuthPair
|
||||||
mauthuname <- maybeAuthUsername
|
runInputPostResult ((,) <$> ireq textField "oldpassword" <*> ireq textField "newpassword") >>= \case
|
||||||
mresult <- runInputPostResult ((,) <$> ireq textField "oldpassword" <*> ireq textField "newpassword")
|
FormSuccess (old, new) -> do
|
||||||
case (mauthuname, mresult) of
|
runDB (authenticatePassword (userName user) old) >>= \case
|
||||||
(Just uname, FormSuccess (old, new)) -> do
|
Nothing -> setMessage "Incorrect Old Password"
|
||||||
muser <- runDB (authenticatePassword uname old)
|
Just _ -> validateNewPassword new >>= \case
|
||||||
case muser of
|
Just newValid -> do
|
||||||
Just _ -> do
|
newHash <- liftIO (hashPassword newValid)
|
||||||
new' <- liftIO (hashPassword new)
|
void $ runDB (update userId [UserPasswordHash CP.=. newHash])
|
||||||
void $ runDB (update userId [UserPasswordHash CP.=. new'])
|
|
||||||
setMessage "Password Changed Successfully"
|
setMessage "Password Changed Successfully"
|
||||||
_ -> setMessage "Incorrect Old Password"
|
_ -> pure ()
|
||||||
_ -> setMessage "Missing Required Fields"
|
_ -> setMessage "Missing Required Fields"
|
||||||
redirect ChangePasswordR
|
redirect ChangePasswordR
|
||||||
|
|
||||||
|
validateNewPassword :: Text -> Handler (Maybe Text)
|
||||||
|
validateNewPassword = \case
|
||||||
|
new | length new < 6 -> do
|
||||||
|
setMessage "Password must be at least 6 characters long"
|
||||||
|
pure Nothing
|
||||||
|
new -> pure $ Just new
|
||||||
|
|
|
@ -148,13 +148,12 @@ sqliteGroupConcat expr sep = unsafeSqlFunction "GROUP_CONCAT" [expr, sep]
|
||||||
|
|
||||||
authenticatePassword :: Text -> Text -> DB (Maybe (Entity User))
|
authenticatePassword :: Text -> Text -> DB (Maybe (Entity User))
|
||||||
authenticatePassword username password = do
|
authenticatePassword username password = do
|
||||||
muser <- getBy (UniqueUserName username)
|
getBy (UniqueUserName username) >>= \case
|
||||||
case muser of
|
Nothing -> pure Nothing
|
||||||
Nothing -> return Nothing
|
|
||||||
Just dbuser ->
|
Just dbuser ->
|
||||||
if validatePasswordHash (userPasswordHash (entityVal dbuser)) password
|
if validatePasswordHash (userPasswordHash (entityVal dbuser)) password
|
||||||
then return (Just dbuser)
|
then pure (Just dbuser)
|
||||||
else return Nothing
|
else pure Nothing
|
||||||
|
|
||||||
getUserByName :: UserNameP -> DB (Maybe (Entity User))
|
getUserByName :: UserNameP -> DB (Maybe (Entity User))
|
||||||
getUserByName (UserNameP uname) =
|
getUserByName (UserNameP uname) =
|
||||||
|
|
Loading…
Reference in a new issue