AccountSettings.hs

module Handler.AccountSettings where

import qualified ClassyPrelude.Yesod as CP
import Import

getAccountSettingsR :: Handler Html
getAccountSettingsR = do
  app <- getYesod
  let frontendBundleName = appFrontendBundleName app
      archiveBackendEnabled = isJust (appArchiver app)
  (_, user) <- requireAuthPair
  let accountSettingsEl = "accountSettings" :: Text
  let accountSettings = toAccountSettingsForm archiveBackendEnabled user
  defaultLayout do
    $(widgetFile "user-settings")
    toWidgetBody
      [julius|
        app.userR = "@{UserR (UserNameP $ userName user)}";
        app.dat.accountSettings = #{ toJSON accountSettings } || []; 
    |]
    toWidget
      [hamlet|
      <script type="module">
        import { renderAccountSettings } from '@{StaticR (StaticRoute ["js", frontendBundleName] [])}'
        renderAccountSettings('##{accountSettingsEl}')(app.dat.accountSettings)();
    |]

postEditAccountSettingsR :: Handler ()
postEditAccountSettingsR = do
  userId <- requireAuthId
  accountSettingsForm <- requireCheckJsonBody
  runDB (updateUserFromAccountSettingsForm userId accountSettingsForm)

getChangePasswordR :: Handler Html
getChangePasswordR = do
  void requireAuthId
  req <- getRequest
  defaultLayout
    $ $(widgetFile "change-password")

postChangePasswordR :: Handler Html
postChangePasswordR = do
  (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