module Handler.AccountSettings where

import Import
import qualified ClassyPrelude.Yesod as CP

getAccountSettingsR :: Handler Html
getAccountSettingsR :: Handler Html
getAccountSettingsR = do
  (UserId
_, User
user) <- forall master (m :: * -> *).
(YesodAuthPersist master, Typeable (AuthEntity master),
 MonadHandler m, HandlerSite m ~ master) =>
m (AuthId master, AuthEntity master)
requireAuthPair
  let accountSettingsEl :: Text
accountSettingsEl = Text
"accountSettings" :: Text
  let accountSettings :: AccountSettingsForm
accountSettings = User -> AccountSettingsForm
toAccountSettingsForm User
user
  forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout do
    $(widgetFile "user-settings")
    forall site a (m :: * -> *).
(ToWidgetBody site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidgetBody [julius|
        app.userR = "@{UserR (UserNameP $ userName user)}";
        app.dat.accountSettings = #{ toJSON accountSettings } || []; 
    |]
    forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget [julius|
      PS.renderAccountSettings('##{rawJS accountSettingsEl}')(app.dat.accountSettings)();
    |]

postEditAccountSettingsR :: Handler ()
postEditAccountSettingsR :: Handler ()
postEditAccountSettingsR = do
  UserId
userId <- forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  AccountSettingsForm
accountSettingsForm <- forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireCheckJsonBody
  forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB (UserId -> AccountSettingsForm -> DB ()
updateUserFromAccountSettingsForm UserId
userId AccountSettingsForm
accountSettingsForm)


getChangePasswordR :: Handler Html
getChangePasswordR :: Handler Html
getChangePasswordR = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  YesodRequest
req <- forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
  forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout forall a b. (a -> b) -> a -> b
$
    $(widgetFile "change-password")

postChangePasswordR :: Handler Html
postChangePasswordR :: Handler Html
postChangePasswordR = do
  (UserId
userId, User
user) <- forall master (m :: * -> *).
(YesodAuthPersist master, Typeable (AuthEntity master),
 MonadHandler m, HandlerSite m ~ master) =>
m (AuthId master, AuthEntity master)
requireAuthPair
  forall (m :: * -> *) a.
MonadHandler m =>
FormInput m a -> m (FormResult a)
runInputPostResult ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m a -> Text -> FormInput m a
ireq forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Text
textField Text
"oldpassword" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m a -> Text -> FormInput m a
ireq forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Text
textField Text
"newpassword") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    FormSuccess (Text
old, Text
new) -> do
      forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB (Text -> Text -> DB (Maybe (Entity User))
authenticatePassword (User -> Text
userName User
user) Text
old) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Entity User)
Nothing -> forall (m :: * -> *). MonadHandler m => Html -> m ()
setMessage Html
"Incorrect Old Password"
        Just Entity User
_ -> Text -> Handler (Maybe Text)
validateNewPassword Text
new forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just Text
newValid -> do
            BCrypt
newHash <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO BCrypt
hashPassword Text
newValid)
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB (forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update UserId
userId [forall typ. (typ ~ BCrypt) => EntityField User typ
UserPasswordHash forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
CP.=. BCrypt
newHash])
            forall (m :: * -> *). MonadHandler m => Html -> m ()
setMessage Html
"Password Changed Successfully"
          Maybe Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    FormResult (Text, Text)
_ -> forall (m :: * -> *). MonadHandler m => Html -> m ()
setMessage Html
"Missing Required Fields"
  forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect Route App
ChangePasswordR

validateNewPassword :: Text -> Handler (Maybe Text)
validateNewPassword :: Text -> Handler (Maybe Text)
validateNewPassword = \case
    Text
new | forall mono. MonoFoldable mono => mono -> Int
length Text
new forall a. Ord a => a -> a -> Bool
< Int
6 -> do
          forall (m :: * -> *). MonadHandler m => Html -> m ()
setMessage Html
"Password must be at least 6 characters long"
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Text
new -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
new