{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module Server.Handlers.UserHandlers
    ( UserAPI
    , userServer
    ) where

import Control.Monad.IO.Class
import Data.Password.Argon2
import Data.Text (Text)
import Hasql.Connection (Connection)
import qualified Hasql.Session as Session
import Servant
import Servant.Auth.Server
import Server.Auth (AuthMethod)
import qualified Server.Auth as Auth
import Server.HandlerUtil
import qualified UserManagement.Sessions as Sessions
import qualified UserManagement.User as User
import Prelude hiding (readFile)

type UserAPI =
    Auth AuthMethod Auth.Token
        :> "register"
        :> ReqBody '[JSON] Auth.UserRegisterData
        :> Post '[JSON] User.UserID
        :<|> "me"
            :> ( Auth AuthMethod Auth.Token
                    :> Get '[JSON] User.FullUser
                    :<|> Auth AuthMethod Auth.Token
                        :> "reset-password"
                        :> ReqBody '[JSON] Text
                        :> Patch '[JSON] NoContent
               )
        :<|> "users"
            :> ( Auth AuthMethod Auth.Token
                    :> Get '[JSON] [User.User]
                    :<|> Auth AuthMethod Auth.Token
                        :> Capture "userId" User.UserID
                        :> Get '[JSON] User.FullUser
                    :<|> Auth AuthMethod Auth.Token
                        :> Capture "userId" User.UserID
                        :> Delete '[JSON] NoContent
                    :<|> Auth AuthMethod Auth.Token
                        :> Capture "userId" User.UserID
                        :> ReqBody '[JSON] Auth.UserUpdate
                        :> Patch '[JSON] NoContent
               )

userServer :: Server UserAPI
userServer :: Server UserAPI
userServer =
    AuthResult Token -> UserRegisterData -> Handler UserID
registerHandler
        (AuthResult Token -> UserRegisterData -> Handler UserID)
-> (((AuthResult Token -> Handler FullUser)
     :<|> (AuthResult Token -> Text -> Handler NoContent))
    :<|> ((AuthResult Token -> Handler [User])
          :<|> ((AuthResult Token -> UserID -> Handler FullUser)
                :<|> ((AuthResult Token -> UserID -> Handler NoContent)
                      :<|> (AuthResult Token
                            -> UserID -> UserUpdate -> Handler NoContent)))))
-> (AuthResult Token -> UserRegisterData -> Handler UserID)
   :<|> (((AuthResult Token -> Handler FullUser)
          :<|> (AuthResult Token -> Text -> Handler NoContent))
         :<|> ((AuthResult Token -> Handler [User])
               :<|> ((AuthResult Token -> UserID -> Handler FullUser)
                     :<|> ((AuthResult Token -> UserID -> Handler NoContent)
                           :<|> (AuthResult Token
                                 -> UserID -> UserUpdate -> Handler NoContent)))))
forall a b. a -> b -> a :<|> b
:<|> ( AuthResult Token -> Handler FullUser
meHandler
                (AuthResult Token -> Handler FullUser)
-> (AuthResult Token -> Text -> Handler NoContent)
-> (AuthResult Token -> Handler FullUser)
   :<|> (AuthResult Token -> Text -> Handler NoContent)
forall a b. a -> b -> a :<|> b
:<|> AuthResult Token -> Text -> Handler NoContent
updateMyPasswordHandler
             )
        ((AuthResult Token -> Handler FullUser)
 :<|> (AuthResult Token -> Text -> Handler NoContent))
-> ((AuthResult Token -> Handler [User])
    :<|> ((AuthResult Token -> UserID -> Handler FullUser)
          :<|> ((AuthResult Token -> UserID -> Handler NoContent)
                :<|> (AuthResult Token
                      -> UserID -> UserUpdate -> Handler NoContent))))
-> ((AuthResult Token -> Handler FullUser)
    :<|> (AuthResult Token -> Text -> Handler NoContent))
   :<|> ((AuthResult Token -> Handler [User])
         :<|> ((AuthResult Token -> UserID -> Handler FullUser)
               :<|> ((AuthResult Token -> UserID -> Handler NoContent)
                     :<|> (AuthResult Token
                           -> UserID -> UserUpdate -> Handler NoContent))))
forall a b. a -> b -> a :<|> b
:<|> AuthResult Token -> Handler [User]
getAllUsersHandler
        (AuthResult Token -> Handler [User])
-> ((AuthResult Token -> UserID -> Handler FullUser)
    :<|> ((AuthResult Token -> UserID -> Handler NoContent)
          :<|> (AuthResult Token
                -> UserID -> UserUpdate -> Handler NoContent)))
-> (AuthResult Token -> Handler [User])
   :<|> ((AuthResult Token -> UserID -> Handler FullUser)
         :<|> ((AuthResult Token -> UserID -> Handler NoContent)
               :<|> (AuthResult Token
                     -> UserID -> UserUpdate -> Handler NoContent)))
forall a b. a -> b -> a :<|> b
:<|> AuthResult Token -> UserID -> Handler FullUser
getUserHandler
        (AuthResult Token -> UserID -> Handler FullUser)
-> ((AuthResult Token -> UserID -> Handler NoContent)
    :<|> (AuthResult Token
          -> UserID -> UserUpdate -> Handler NoContent))
-> (AuthResult Token -> UserID -> Handler FullUser)
   :<|> ((AuthResult Token -> UserID -> Handler NoContent)
         :<|> (AuthResult Token
               -> UserID -> UserUpdate -> Handler NoContent))
forall a b. a -> b -> a :<|> b
:<|> AuthResult Token -> UserID -> Handler NoContent
deleteUserHandler
        (AuthResult Token -> UserID -> Handler NoContent)
-> (AuthResult Token -> UserID -> UserUpdate -> Handler NoContent)
-> (AuthResult Token -> UserID -> Handler NoContent)
   :<|> (AuthResult Token
         -> UserID -> UserUpdate -> Handler NoContent)
forall a b. a -> b -> a :<|> b
:<|> AuthResult Token -> UserID -> UserUpdate -> Handler NoContent
patchUserHandler

-- | Adds a new user to the system, if the logged in User is `Admin` or `SuperAdmin`.
--   If a groupID is given, the new user will be added
--   to this group as a `Member`.
registerHandler
    :: AuthResult Auth.Token -> Auth.UserRegisterData -> Handler User.UserID
registerHandler :: AuthResult Token -> UserRegisterData -> Handler UserID
registerHandler (Authenticated Token
token) regData :: UserRegisterData
regData@(Auth.UserRegisterData Text
_ Text
_ Text
_ Maybe GroupID
mGroupID) = do
    Connection
conn <- Handler Connection
tryGetDBConnection
    case Maybe GroupID
mGroupID of
        Maybe GroupID
Nothing ->
            Connection -> Token -> Handler UserID -> Handler UserID
forall a. Connection -> Token -> Handler a -> Handler a
ifSuperOrAnyAdminDo
                Connection
conn
                Token
token
                (Connection -> UserRegisterData -> Handler UserID
addNewUser Connection
conn UserRegisterData
regData)
        Just GroupID
groupID ->
            Connection -> Token -> GroupID -> Handler UserID -> Handler UserID
forall a. Connection -> Token -> GroupID -> Handler a -> Handler a
ifSuperOrAdminDo
                Connection
conn
                Token
token
                GroupID
groupID
                ( Connection -> UserRegisterData -> Handler UserID
addNewUser Connection
conn UserRegisterData
regData
                    Handler UserID -> (UserID -> Handler UserID) -> Handler UserID
forall a b. Handler a -> (a -> Handler b) -> Handler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UserID
userID ->
                        Connection -> UserID -> GroupID -> Role -> Handler ()
addRoleInGroup Connection
conn UserID
userID GroupID
groupID Role
User.Member
                            Handler () -> Handler UserID -> Handler UserID
forall a b. Handler a -> Handler b -> Handler b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UserID -> Handler UserID
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return UserID
userID
                )
  where
    addNewUser :: Connection -> Auth.UserRegisterData -> Handler User.UserID
    addNewUser :: Connection -> UserRegisterData -> Handler UserID
addNewUser Connection
conn (Auth.UserRegisterData {Maybe GroupID
Text
registerName :: Text
registerEmail :: Text
registerPassword :: Text
groupID :: Maybe GroupID
groupID :: UserRegisterData -> Maybe GroupID
registerPassword :: UserRegisterData -> Text
registerEmail :: UserRegisterData -> Text
registerName :: UserRegisterData -> Text
..}) = do
        Either SessionError (Maybe User)
eUser <- IO (Either SessionError (Maybe User))
-> Handler (Either SessionError (Maybe User))
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError (Maybe User))
 -> Handler (Either SessionError (Maybe User)))
-> IO (Either SessionError (Maybe User))
-> Handler (Either SessionError (Maybe User))
forall a b. (a -> b) -> a -> b
$ Session (Maybe User)
-> Connection -> IO (Either SessionError (Maybe User))
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run (Text -> Session (Maybe User)
Sessions.getUserByEmail Text
registerEmail) Connection
conn
        case Either SessionError (Maybe User)
eUser of
            Right Maybe User
Nothing -> do
                PasswordHash Text
hashedText <- IO (PasswordHash Argon2) -> Handler (PasswordHash Argon2)
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PasswordHash Argon2) -> Handler (PasswordHash Argon2))
-> IO (PasswordHash Argon2) -> Handler (PasswordHash Argon2)
forall a b. (a -> b) -> a -> b
$ Password -> IO (PasswordHash Argon2)
forall (m :: * -> *).
MonadIO m =>
Password -> m (PasswordHash Argon2)
hashPassword (Password -> IO (PasswordHash Argon2))
-> Password -> IO (PasswordHash Argon2)
forall a b. (a -> b) -> a -> b
$ Text -> Password
mkPassword Text
registerPassword
                Either SessionError UserID
eAction <-
                    IO (Either SessionError UserID)
-> Handler (Either SessionError UserID)
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError UserID)
 -> Handler (Either SessionError UserID))
-> IO (Either SessionError UserID)
-> Handler (Either SessionError UserID)
forall a b. (a -> b) -> a -> b
$
                        Session UserID -> Connection -> IO (Either SessionError UserID)
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run
                            ( UserCreate -> Session UserID
Sessions.putUser
                                ( Text -> Text -> Text -> UserCreate
User.UserCreate
                                    Text
registerName
                                    Text
registerEmail
                                    Text
hashedText
                                )
                            )
                            Connection
conn
                case Either SessionError UserID
eAction of
                    Left SessionError
_ -> ServerError -> Handler UserID
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errUserCreationFailed
                    Right UserID
userID -> UserID -> Handler UserID
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return UserID
userID
            Right (Just User
_) -> ServerError -> Handler UserID
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errEmailAlreadyUsed
            Left SessionError
_ -> ServerError -> Handler UserID
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
registerHandler AuthResult Token
_ UserRegisterData
_ = ServerError -> Handler UserID
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn

meHandler :: AuthResult Auth.Token -> Handler User.FullUser
meHandler :: AuthResult Token -> Handler FullUser
meHandler auth :: AuthResult Token
auth@(Authenticated Auth.Token {Bool
UserID
subject :: UserID
isSuperadmin :: Bool
isSuperadmin :: Token -> Bool
subject :: Token -> UserID
..}) = AuthResult Token -> UserID -> Handler FullUser
getUserHandler AuthResult Token
auth UserID
subject
meHandler AuthResult Token
_ = ServerError -> Handler FullUser
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn

updateMyPasswordHandler :: AuthResult Auth.Token -> Text -> Handler NoContent
updateMyPasswordHandler :: AuthResult Token -> Text -> Handler NoContent
updateMyPasswordHandler (Authenticated Auth.Token {Bool
UserID
isSuperadmin :: Token -> Bool
subject :: Token -> UserID
subject :: UserID
isSuperadmin :: Bool
..}) Text
newPassword = do
    Connection
conn <- Handler Connection
tryGetDBConnection
    PasswordHash Text
hashedText <- IO (PasswordHash Argon2) -> Handler (PasswordHash Argon2)
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PasswordHash Argon2) -> Handler (PasswordHash Argon2))
-> IO (PasswordHash Argon2) -> Handler (PasswordHash Argon2)
forall a b. (a -> b) -> a -> b
$ Password -> IO (PasswordHash Argon2)
forall (m :: * -> *).
MonadIO m =>
Password -> m (PasswordHash Argon2)
hashPassword (Password -> IO (PasswordHash Argon2))
-> Password -> IO (PasswordHash Argon2)
forall a b. (a -> b) -> a -> b
$ Text -> Password
mkPassword Text
newPassword
    Either SessionError ()
eAction <-
        IO (Either SessionError ()) -> Handler (Either SessionError ())
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError ()) -> Handler (Either SessionError ()))
-> IO (Either SessionError ()) -> Handler (Either SessionError ())
forall a b. (a -> b) -> a -> b
$ Session () -> Connection -> IO (Either SessionError ())
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run (UserID -> Text -> Session ()
Sessions.updateUserPWHash UserID
subject Text
hashedText) Connection
conn
    case Either SessionError ()
eAction of
        Left SessionError
_ -> ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
        Right ()
_ -> NoContent -> Handler NoContent
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return NoContent
NoContent
updateMyPasswordHandler AuthResult Token
_ Text
_ = ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn

-- | Returns a list of all users to anyone thats logged in.
getAllUsersHandler :: AuthResult Auth.Token -> Handler [User.User]
getAllUsersHandler :: AuthResult Token -> Handler [User]
getAllUsersHandler (Authenticated Token
_) = do
    Connection
conn <- Handler Connection
tryGetDBConnection
    Either SessionError [User]
eUsers <- IO (Either SessionError [User])
-> Handler (Either SessionError [User])
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError [User])
 -> Handler (Either SessionError [User]))
-> IO (Either SessionError [User])
-> Handler (Either SessionError [User])
forall a b. (a -> b) -> a -> b
$ Session [User] -> Connection -> IO (Either SessionError [User])
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run Session [User]
Sessions.getAllUsers Connection
conn
    case Either SessionError [User]
eUsers of
        Left SessionError
_ -> ServerError -> Handler [User]
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
        Right [User]
users -> [User] -> Handler [User]
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return [User]
users
getAllUsersHandler AuthResult Token
_ = ServerError -> Handler [User]
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn

getUserHandler
    :: AuthResult Auth.Token -> User.UserID -> Handler User.FullUser
getUserHandler :: AuthResult Token -> UserID -> Handler FullUser
getUserHandler (Authenticated Auth.Token {Bool
UserID
isSuperadmin :: Token -> Bool
subject :: Token -> UserID
subject :: UserID
isSuperadmin :: Bool
..}) UserID
requestedUserID = do
    if Bool
isSuperadmin Bool -> Bool -> Bool
|| UserID
subject UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
== UserID
requestedUserID
        then do
            Connection
conn <- Handler Connection
tryGetDBConnection
            Either SessionError (Maybe User)
eAction <- IO (Either SessionError (Maybe User))
-> Handler (Either SessionError (Maybe User))
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError (Maybe User))
 -> Handler (Either SessionError (Maybe User)))
-> IO (Either SessionError (Maybe User))
-> Handler (Either SessionError (Maybe User))
forall a b. (a -> b) -> a -> b
$ Session (Maybe User)
-> Connection -> IO (Either SessionError (Maybe User))
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run (UserID -> Session (Maybe User)
Sessions.getUserByID UserID
requestedUserID) Connection
conn
            case Either SessionError (Maybe User)
eAction of
                Left SessionError
_ -> ServerError -> Handler FullUser
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
                Right Maybe User
Nothing -> ServerError -> Handler FullUser
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ServerError -> Handler FullUser)
-> ServerError -> Handler FullUser
forall a b. (a -> b) -> a -> b
$ ServerError
err404 {errBody = "user not found."}
                Right (Just User.User {Text
UserID
userID :: UserID
userName :: Text
userEmail :: Text
userEmail :: User -> Text
userName :: User -> Text
userID :: User -> UserID
..}) -> do
                    Either SessionError Bool
eIsSuper <- IO (Either SessionError Bool) -> Handler (Either SessionError Bool)
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError Bool)
 -> Handler (Either SessionError Bool))
-> IO (Either SessionError Bool)
-> Handler (Either SessionError Bool)
forall a b. (a -> b) -> a -> b
$ Session Bool -> Connection -> IO (Either SessionError Bool)
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run (UserID -> Session Bool
Sessions.checkSuperadmin UserID
requestedUserID) Connection
conn
                    case Either SessionError Bool
eIsSuper of
                        Left SessionError
_ -> ServerError -> Handler FullUser
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
                        Right Bool
isSuper -> do
                            Either SessionError [(GroupID, Text, Maybe Role)]
eAction' <- IO (Either SessionError [(GroupID, Text, Maybe Role)])
-> Handler (Either SessionError [(GroupID, Text, Maybe Role)])
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError [(GroupID, Text, Maybe Role)])
 -> Handler (Either SessionError [(GroupID, Text, Maybe Role)]))
-> IO (Either SessionError [(GroupID, Text, Maybe Role)])
-> Handler (Either SessionError [(GroupID, Text, Maybe Role)])
forall a b. (a -> b) -> a -> b
$ Session [(GroupID, Text, Maybe Role)]
-> Connection
-> IO (Either SessionError [(GroupID, Text, Maybe Role)])
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run (UserID -> Session [(GroupID, Text, Maybe Role)]
Sessions.getAllUserRoles UserID
requestedUserID) Connection
conn
                            case Either SessionError [(GroupID, Text, Maybe Role)]
eAction' of
                                Left SessionError
_ -> ServerError -> Handler FullUser
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
                                Right [(GroupID, Text, Maybe Role)]
roles ->
                                    let roles' :: [GroupRole]
roles' = [GroupID -> Text -> Role -> GroupRole
User.GroupRole GroupID
group Text
name Role
role | (GroupID
group, Text
name, Just Role
role) <- [(GroupID, Text, Maybe Role)]
roles]
                                     in FullUser -> Handler FullUser
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return (FullUser -> Handler FullUser) -> FullUser -> Handler FullUser
forall a b. (a -> b) -> a -> b
$ UserID -> Text -> Text -> Bool -> [GroupRole] -> FullUser
User.FullUser UserID
requestedUserID Text
userName Text
userEmail Bool
isSuper [GroupRole]
roles'
        else ServerError -> Handler FullUser
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errSuperAdminOnly
getUserHandler AuthResult Token
_ UserID
_ = ServerError -> Handler FullUser
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn

deleteUserHandler
    :: AuthResult Auth.Token -> User.UserID -> Handler NoContent
deleteUserHandler :: AuthResult Token -> UserID -> Handler NoContent
deleteUserHandler (Authenticated Auth.Token {Bool
UserID
isSuperadmin :: Token -> Bool
subject :: Token -> UserID
subject :: UserID
isSuperadmin :: Bool
..}) UserID
requestedUserID =
    if Bool
isSuperadmin
        then do
            Connection
conn <- Handler Connection
tryGetDBConnection
            Either SessionError ()
eAction <- IO (Either SessionError ()) -> Handler (Either SessionError ())
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError ()) -> Handler (Either SessionError ()))
-> IO (Either SessionError ()) -> Handler (Either SessionError ())
forall a b. (a -> b) -> a -> b
$ Session () -> Connection -> IO (Either SessionError ())
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run (UserID -> Session ()
Sessions.deleteUser UserID
requestedUserID) Connection
conn
            case Either SessionError ()
eAction of
                Left SessionError
_ -> ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
                Right ()
_ -> NoContent -> Handler NoContent
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return NoContent
NoContent
        else ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errSuperAdminOnly
deleteUserHandler AuthResult Token
_ UserID
_ = ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn

patchUserHandler
    :: AuthResult Auth.Token -> User.UserID -> Auth.UserUpdate -> Handler NoContent
patchUserHandler :: AuthResult Token -> UserID -> UserUpdate -> Handler NoContent
patchUserHandler (Authenticated Auth.Token {Bool
UserID
isSuperadmin :: Token -> Bool
subject :: Token -> UserID
subject :: UserID
isSuperadmin :: Bool
..}) UserID
userID (Auth.UserUpdate {Maybe Text
newName :: Maybe Text
newEmail :: Maybe Text
newEmail :: UserUpdate -> Maybe Text
newName :: UserUpdate -> Maybe Text
..}) = do
    Connection
conn <- Handler Connection
tryGetDBConnection
    if Bool
isSuperadmin Bool -> Bool -> Bool
|| UserID
subject UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
== UserID
userID
        then case Maybe Text
newEmail of
            Maybe Text
Nothing -> Connection -> Handler NoContent
patchUser Connection
conn
            Just Text
newEmail' -> do
                -- check if email is already used for some account
                Either SessionError (Maybe User)
eUser <- IO (Either SessionError (Maybe User))
-> Handler (Either SessionError (Maybe User))
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError (Maybe User))
 -> Handler (Either SessionError (Maybe User)))
-> IO (Either SessionError (Maybe User))
-> Handler (Either SessionError (Maybe User))
forall a b. (a -> b) -> a -> b
$ Session (Maybe User)
-> Connection -> IO (Either SessionError (Maybe User))
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run (Text -> Session (Maybe User)
Sessions.getUserByEmail Text
newEmail') Connection
conn
                case Either SessionError (Maybe User)
eUser of
                    Left SessionError
_ -> ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
                    Right Maybe User
Nothing -> Connection -> Handler NoContent
patchUser Connection
conn
                    Right (Just User
user)
                        | User -> UserID
User.userID User
user UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
== UserID
userID -> Connection -> Handler NoContent
patchUser Connection
conn
                        | Bool
otherwise -> ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errEmailAlreadyUsed
        else ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errSuperAdminOnly
  where
    patchUser :: Connection -> Handler NoContent
    patchUser :: Connection -> Handler NoContent
patchUser Connection
conn = do
        Connection -> Maybe Text -> (Text -> Session ()) -> Handler ()
forall a. Connection -> Maybe a -> (a -> Session ()) -> Handler ()
updateEntry Connection
conn Maybe Text
newName ((Text -> Session ()) -> Handler ())
-> (Text -> Session ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ UserID -> Text -> Session ()
Sessions.updateUserName UserID
userID
        Connection -> Maybe Text -> (Text -> Session ()) -> Handler ()
forall a. Connection -> Maybe a -> (a -> Session ()) -> Handler ()
updateEntry Connection
conn Maybe Text
newEmail ((Text -> Session ()) -> Handler ())
-> (Text -> Session ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ UserID -> Text -> Session ()
Sessions.updateUserEmail UserID
userID
        NoContent -> Handler NoContent
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return NoContent
NoContent

    updateEntry :: Connection -> Maybe a -> (a -> Session.Session ()) -> Handler ()
    updateEntry :: forall a. Connection -> Maybe a -> (a -> Session ()) -> Handler ()
updateEntry Connection
_ Maybe a
Nothing a -> Session ()
_ = () -> Handler ()
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    updateEntry Connection
conn (Just a
val) a -> Session ()
upd = do
        Either SessionError ()
eAction <- IO (Either SessionError ()) -> Handler (Either SessionError ())
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError ()) -> Handler (Either SessionError ()))
-> IO (Either SessionError ()) -> Handler (Either SessionError ())
forall a b. (a -> b) -> a -> b
$ Session () -> Connection -> IO (Either SessionError ())
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run (a -> Session ()
upd a
val) Connection
conn
        case Either SessionError ()
eAction of
            Left SessionError
_ -> ServerError -> Handler ()
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
            Right ()
_ -> () -> Handler ()
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
patchUserHandler AuthResult Token
_ UserID
_ UserUpdate
_ = ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn