/
AccountSettings.hs
56 lines (49 loc) · 1.9 KB
/
AccountSettings.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
module Handler.AccountSettings where
import Import
import qualified ClassyPrelude.Yesod as CP
getAccountSettingsR :: Handler Html
getAccountSettingsR = do
(_, user) <- requireAuthPair
let accountSettingsEl = "accountSettings" :: Text
let accountSettings = toAccountSettingsForm user
defaultLayout do
$(widgetFile "user-settings")
toWidgetBody [julius|
app.userR = "@{UserR (UserNameP $ userName user)}";
app.dat.accountSettings = #{ toJSON accountSettings } || [];
|]
toWidget [julius|
PS['Main'].renderAccountSettings('##{rawJS 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