module Handler.AccountSettings where

import Import
import qualified ClassyPrelude.Yesod as CP

getAccountSettingsR :: Handler Html
getAccountSettingsR :: Handler Html
getAccountSettingsR = do
  (UserId
_, User
user) <- HandlerFor App (UserId, User)
HandlerFor App (AuthId App, AuthEntity App)
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
  WidgetFor App () -> Handler Html
forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout do
    $(widgetFile "user-settings")
    JavascriptUrl (Route App) -> WidgetFor App ()
forall site a (m :: * -> *).
(ToWidgetBody site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ App) =>
JavascriptUrl (Route App) -> m ()
toWidgetBody [julius|
        app.userR = "@{UserR (UserNameP $ userName user)}";
        app.dat.accountSettings = #{ toJSON accountSettings } || []; 
    |]
    JavascriptUrl (Route App) -> WidgetFor App ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ App) =>
JavascriptUrl (Route App) -> m ()
toWidget [julius|
      PS.renderAccountSettings('##{rawJS accountSettingsEl}')(app.dat.accountSettings)();
    |]

postEditAccountSettingsR :: Handler ()
postEditAccountSettingsR :: Handler ()
postEditAccountSettingsR = do
  UserId
userId <- HandlerFor App UserId
HandlerFor App (AuthId (HandlerSite (HandlerFor App)))
forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  AccountSettingsForm
accountSettingsForm <- HandlerFor App AccountSettingsForm
forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireCheckJsonBody
  YesodDB App () -> Handler ()
forall a. YesodDB App a -> HandlerFor App a
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
  HandlerFor App UserId -> Handler ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void HandlerFor App UserId
HandlerFor App (AuthId (HandlerSite (HandlerFor App)))
forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  YesodRequest
req <- HandlerFor App YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
  WidgetFor App () -> Handler Html
forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout (WidgetFor App () -> Handler Html)
-> WidgetFor App () -> Handler Html
forall a b. (a -> b) -> a -> b
$
    $(widgetFile "change-password")

postChangePasswordR :: Handler Html
postChangePasswordR :: Handler Html
postChangePasswordR = do
  (UserId
userId, User
user) <- HandlerFor App (UserId, User)
HandlerFor App (AuthId App, AuthEntity App)
forall master (m :: * -> *).
(YesodAuthPersist master, Typeable (AuthEntity master),
 MonadHandler m, HandlerSite m ~ master) =>
m (AuthId master, AuthEntity master)
requireAuthPair
  FormInput (HandlerFor App) (Text, Text)
-> HandlerFor App (FormResult (Text, Text))
forall (m :: * -> *) a.
MonadHandler m =>
FormInput m a -> m (FormResult a)
runInputPostResult ((,) (Text -> Text -> (Text, Text))
-> FormInput (HandlerFor App) Text
-> FormInput (HandlerFor App) (Text -> (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field (HandlerFor App) Text
-> Text -> FormInput (HandlerFor App) Text
forall (m :: * -> *) a.
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m a -> Text -> FormInput m a
ireq Field (HandlerFor App) Text
forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Text
textField Text
"oldpassword" FormInput (HandlerFor App) (Text -> (Text, Text))
-> FormInput (HandlerFor App) Text
-> FormInput (HandlerFor App) (Text, Text)
forall a b.
FormInput (HandlerFor App) (a -> b)
-> FormInput (HandlerFor App) a -> FormInput (HandlerFor App) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field (HandlerFor App) Text
-> Text -> FormInput (HandlerFor App) Text
forall (m :: * -> *) a.
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m a -> Text -> FormInput m a
ireq Field (HandlerFor App) Text
forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Text
textField Text
"newpassword") HandlerFor App (FormResult (Text, Text))
-> (FormResult (Text, Text) -> Handler ()) -> Handler ()
forall a b.
HandlerFor App a -> (a -> HandlerFor App b) -> HandlerFor App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    FormSuccess (Text
old, Text
new) -> do
      YesodDB App (Maybe (Entity User))
-> HandlerFor App (Maybe (Entity User))
forall a. YesodDB App a -> HandlerFor App a
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) HandlerFor App (Maybe (Entity User))
-> (Maybe (Entity User) -> Handler ()) -> Handler ()
forall a b.
HandlerFor App a -> (a -> HandlerFor App b) -> HandlerFor App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Entity User)
Nothing -> Html -> Handler ()
forall (m :: * -> *). MonadHandler m => Html -> m ()
setMessage Html
"Incorrect Old Password"
        Just Entity User
_ -> Text -> Handler (Maybe Text)
validateNewPassword Text
new Handler (Maybe Text) -> (Maybe Text -> Handler ()) -> Handler ()
forall a b.
HandlerFor App a -> (a -> HandlerFor App b) -> HandlerFor App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just Text
newValid -> do
            BCrypt
newHash <- IO BCrypt -> HandlerFor App BCrypt
forall a. IO a -> HandlerFor App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO BCrypt
hashPassword Text
newValid)
            Handler () -> Handler ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$ YesodDB App () -> Handler ()
forall a. YesodDB App a -> HandlerFor App a
forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB (UserId -> [Update User] -> SqlPersistT (HandlerFor App) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Key record -> [Update record] -> ReaderT SqlBackend m ()
update UserId
userId [EntityField User BCrypt
forall typ. (typ ~ BCrypt) => EntityField User typ
UserPasswordHash EntityField User BCrypt -> BCrypt -> Update User
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
CP.=. BCrypt
newHash])
            Html -> Handler ()
forall (m :: * -> *). MonadHandler m => Html -> m ()
setMessage Html
"Password Changed Successfully"
          Maybe Text
_ -> () -> Handler ()
forall a. a -> HandlerFor App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    FormResult (Text, Text)
_ -> Html -> Handler ()
forall (m :: * -> *). MonadHandler m => Html -> m ()
setMessage Html
"Missing Required Fields"
  Route App -> Handler Html
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 | Text -> Int
forall mono. MonoFoldable mono => mono -> Int
length Text
new Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6 -> do
          Html -> Handler ()
forall (m :: * -> *). MonadHandler m => Html -> m ()
setMessage Html
"Password must be at least 6 characters long"
          Maybe Text -> Handler (Maybe Text)
forall a. a -> HandlerFor App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
    Text
new -> Maybe Text -> Handler (Maybe Text)
forall a. a -> HandlerFor App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Handler (Maybe Text))
-> Maybe Text -> Handler (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
new