-- | Settings for user
module Routes.UserSettings
( getSettingsR
, postSettingsR
) where
import ClassyPrelude hiding (Handler)
import qualified Database.Persist as Persistent
import qualified Yesod
import qualified Yesod.Auth as Auth
import Database (User (User), userUsername)
import Database.Persist (entityVal, (=.))
import Database.Persist.Sql (SqlBackend)
import HagiaSite (Handler, Route (SettingsR), Widget)
import Yesod (FormResult, Html, MForm, runDB, whamlet)
import Yesod.Auth.Util.PasswordStore (makePassword)
data SettingsForm = SettingsForm
{ settingsUsername :: !(Maybe Text)
, settingsPassword :: !(Maybe Text)
}
deriving (Eq, Show)
settingsForm :: User -> Html -> MForm Handler (FormResult SettingsForm, Widget)
settingsForm User{userUsername} =
Yesod.renderDivs $
SettingsForm
<$> Yesod.aopt Yesod.textField "username" (Just . Just $ userUsername)
<*> Yesod.aopt Yesod.passwordField "password" Nothing
getSettingsR :: Handler Html
getSettingsR = do
user <- entityVal <$> Auth.requireAuth
(widget, enctype) <- Yesod.generateFormPost $ settingsForm user
Yesod.defaultLayout $ do
Yesod.setTitle "Global settings"
[whamlet|
<h1> Settings
<form method=post action=@{SettingsR} enctype=#{enctype}>
^{widget}
<button>Submit
|]
postSettingsR :: Handler Html
postSettingsR = do
userId <- Auth.requireAuthId
user <- runDB $ Yesod.get404 userId
((result, widget), enctype) <- Yesod.runFormPost $ settingsForm user
message <- case result of
Yesod.FormSuccess x -> do
maybeChange (runDB . updateUsername userId) $ settingsUsername x
maybeChange (runDB . updatePassword userId) $ settingsPassword x
pure [whamlet|<div> Updated succesfully|]
_ -> pure [whamlet|<div> Invalid input|]
Yesod.defaultLayout $ do
Yesod.setTitle "Global settings"
[whamlet|
<h1> Settings
^{message}
<form method=post action=@{SettingsR} enctype=#{enctype}>
^{widget}
<button>Submit
|]
maybeChange :: Applicative f => (a -> f ()) -> Maybe a -> f ()
maybeChange = maybe (pure ())
updateUsername :: MonadIO m => Persistent.Key User -> Text -> ReaderT SqlBackend m ()
updateUsername userId newUsername = do
Persistent.update userId [#username =. newUsername]
-- | For the future: updating password should probably require a second auth
updatePassword :: MonadIO m => Persistent.Key User -> Text -> ReaderT SqlBackend m ()
updatePassword userId newPassword = do
passwordHash <- liftIO $ makePassword (encodeUtf8 newPassword) 14
Persistent.update userId [#password =. decodeUtf8 passwordHash]