diff --git a/src/Handler/AccountSettings.hs b/src/Handler/AccountSettings.hs index be835b4..70b4d6d 100644 --- a/src/Handler/AccountSettings.hs +++ b/src/Handler/AccountSettings.hs @@ -34,17 +34,23 @@ getChangePasswordR = do postChangePasswordR :: Handler Html postChangePasswordR = do - userId <- requireAuthId - mauthuname <- maybeAuthUsername - mresult <- runInputPostResult ((,) <$> ireq textField "oldpassword" <*> ireq textField "newpassword") - case (mauthuname, mresult) of - (Just uname, FormSuccess (old, new)) -> do - muser <- runDB (authenticatePassword uname old) - case muser of - Just _ -> do - new' <- liftIO (hashPassword new) - void $ runDB (update userId [UserPasswordHash CP.=. new']) - setMessage "Password Changed Successfully" - _ -> setMessage "Incorrect Old Password" + (userId, user) <- requireAuthPair + runInputPostResult ((,) <$> ireq textField "oldpassword" <*> ireq textField "newpassword") >>= \case + FormSuccess (old, new) -> do + runDB (authenticatePassword (userName user) old) >>= \case + Nothing -> setMessage "Incorrect Old Password" + Just _ -> validateNewPassword new >>= \case + Just newValid -> do + newHash <- liftIO (hashPassword newValid) + void $ runDB (update userId [UserPasswordHash CP.=. newHash]) + setMessage "Password Changed Successfully" + _ -> pure () _ -> setMessage "Missing Required Fields" 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 diff --git a/src/Model.hs b/src/Model.hs index abe7d04..edab4e4 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -148,13 +148,12 @@ sqliteGroupConcat expr sep = unsafeSqlFunction "GROUP_CONCAT" [expr, sep] authenticatePassword :: Text -> Text -> DB (Maybe (Entity User)) authenticatePassword username password = do - muser <- getBy (UniqueUserName username) - case muser of - Nothing -> return Nothing + getBy (UniqueUserName username) >>= \case + Nothing -> pure Nothing Just dbuser -> if validatePasswordHash (userPasswordHash (entityVal dbuser)) password - then return (Just dbuser) - else return Nothing + then pure (Just dbuser) + else pure Nothing getUserByName :: UserNameP -> DB (Maybe (Entity User)) getUserByName (UserNameP uname) =