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

module Server.Handlers.RoleHandlers
    ( RoleAPI
    , roleServer
    ) where

import Control.Monad.IO.Class
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.Group as Group
import qualified UserManagement.Sessions as Sessions
import qualified UserManagement.User as User
import Prelude hiding (readFile)

type RoleAPI =
    "roles"
        :> ( Auth AuthMethod Auth.Token
                :> Capture "groupID" Group.GroupID
                :> Capture "userId" User.UserID
                :> Get '[JSON] User.Role
                :<|> Auth AuthMethod Auth.Token
                    :> Capture "groupID" Group.GroupID
                    :> Capture "userId" User.UserID
                    :> ReqBody '[JSON] User.Role
                    :> Put '[JSON] NoContent
                :<|> Auth AuthMethod Auth.Token
                    :> Capture "groupID" Group.GroupID
                    :> Capture "userId" User.UserID
                    :> Delete '[JSON] NoContent
                :<|> Auth AuthMethod Auth.Token
                    :> "superadmin"
                    :> Capture "userId" User.UserID
                    :> Put '[JSON] NoContent
                :<|> Auth AuthMethod Auth.Token
                    :> "superadmin"
                    :> Capture "userId" User.UserID
                    :> Delete '[JSON] NoContent
           )

roleServer :: Server RoleAPI
roleServer :: Server RoleAPI
roleServer =
    AuthResult Token -> GroupID -> UserID -> Handler Role
getRoleHandler
        (AuthResult Token -> GroupID -> UserID -> Handler Role)
-> ((AuthResult Token
     -> GroupID -> UserID -> Role -> Handler NoContent)
    :<|> ((AuthResult Token -> GroupID -> UserID -> Handler NoContent)
          :<|> ((AuthResult Token -> UserID -> Handler NoContent)
                :<|> (AuthResult Token -> UserID -> Handler NoContent))))
-> (AuthResult Token -> GroupID -> UserID -> Handler Role)
   :<|> ((AuthResult Token
          -> GroupID -> UserID -> Role -> Handler NoContent)
         :<|> ((AuthResult Token -> GroupID -> UserID -> Handler NoContent)
               :<|> ((AuthResult Token -> UserID -> Handler NoContent)
                     :<|> (AuthResult Token -> UserID -> Handler NoContent))))
forall a b. a -> b -> a :<|> b
:<|> AuthResult Token -> GroupID -> UserID -> Role -> Handler NoContent
postRoleHandler
        (AuthResult Token
 -> GroupID -> UserID -> Role -> Handler NoContent)
-> ((AuthResult Token -> GroupID -> UserID -> Handler NoContent)
    :<|> ((AuthResult Token -> UserID -> Handler NoContent)
          :<|> (AuthResult Token -> UserID -> Handler NoContent)))
-> (AuthResult Token
    -> GroupID -> UserID -> Role -> Handler NoContent)
   :<|> ((AuthResult Token -> GroupID -> UserID -> Handler NoContent)
         :<|> ((AuthResult Token -> UserID -> Handler NoContent)
               :<|> (AuthResult Token -> UserID -> Handler NoContent)))
forall a b. a -> b -> a :<|> b
:<|> AuthResult Token -> GroupID -> UserID -> Handler NoContent
deleteRoleHandler
        (AuthResult Token -> GroupID -> UserID -> Handler NoContent)
-> ((AuthResult Token -> UserID -> Handler NoContent)
    :<|> (AuthResult Token -> UserID -> Handler NoContent))
-> (AuthResult Token -> GroupID -> UserID -> Handler NoContent)
   :<|> ((AuthResult Token -> UserID -> Handler NoContent)
         :<|> (AuthResult Token -> UserID -> Handler NoContent))
forall a b. a -> b -> a :<|> b
:<|> AuthResult Token -> UserID -> Handler NoContent
putSuperadminHandler
        (AuthResult Token -> UserID -> Handler NoContent)
-> (AuthResult Token -> UserID -> Handler NoContent)
-> (AuthResult Token -> UserID -> Handler NoContent)
   :<|> (AuthResult Token -> UserID -> Handler NoContent)
forall a b. a -> b -> a :<|> b
:<|> AuthResult Token -> UserID -> Handler NoContent
deleteSuperadminHandler

getRoleHandler
    :: AuthResult Auth.Token -> Group.GroupID -> User.UserID -> Handler User.Role
getRoleHandler :: AuthResult Token -> GroupID -> UserID -> Handler Role
getRoleHandler (Authenticated Token
token) GroupID
groupID UserID
userID = do
    Connection
conn <- Handler Connection
tryGetDBConnection
    Connection -> Token -> GroupID -> Handler Role -> Handler Role
forall a. Connection -> Token -> GroupID -> Handler a -> Handler a
ifSuperOrAdminDo Connection
conn Token
token GroupID
groupID (Connection -> Handler Role
getRole Connection
conn)
  where
    getRole :: Connection -> Handler User.Role
    getRole :: Connection -> Handler Role
getRole Connection
conn = do
        Either SessionError (Maybe Role)
eResult <-
            IO (Either SessionError (Maybe Role))
-> Handler (Either SessionError (Maybe Role))
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError (Maybe Role))
 -> Handler (Either SessionError (Maybe Role)))
-> IO (Either SessionError (Maybe Role))
-> Handler (Either SessionError (Maybe Role))
forall a b. (a -> b) -> a -> b
$ Session (Maybe Role)
-> Connection -> IO (Either SessionError (Maybe Role))
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run (UserID -> GroupID -> Session (Maybe Role)
Sessions.getUserRoleInGroup UserID
userID GroupID
groupID) Connection
conn
        case Either SessionError (Maybe Role)
eResult of
            Left SessionError
_ -> ServerError -> Handler Role
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
            Right (Just Role
role) -> Role -> Handler Role
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return Role
role
            Right Maybe Role
Nothing -> ServerError -> Handler Role
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errUserNotFound
getRoleHandler AuthResult Token
_ GroupID
_ UserID
_ = ServerError -> Handler Role
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn

postRoleHandler
    :: AuthResult Auth.Token
    -> Group.GroupID
    -> User.UserID
    -> User.Role
    -> Handler NoContent
postRoleHandler :: AuthResult Token -> GroupID -> UserID -> Role -> Handler NoContent
postRoleHandler (Authenticated Token
token) GroupID
groupID UserID
userID Role
userRole = do
    Connection
conn <- Handler Connection
tryGetDBConnection
    Connection
-> Token -> GroupID -> Handler NoContent -> Handler NoContent
forall a. Connection -> Token -> GroupID -> Handler a -> Handler a
ifSuperOrAdminDo Connection
conn Token
token GroupID
groupID (Connection -> Handler NoContent
postRole Connection
conn)
  where
    postRole :: Connection -> Handler NoContent
    postRole :: Connection -> Handler NoContent
postRole Connection
conn = do
        Either SessionError (Maybe Role)
eResult <-
            IO (Either SessionError (Maybe Role))
-> Handler (Either SessionError (Maybe Role))
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError (Maybe Role))
 -> Handler (Either SessionError (Maybe Role)))
-> IO (Either SessionError (Maybe Role))
-> Handler (Either SessionError (Maybe Role))
forall a b. (a -> b) -> a -> b
$ Session (Maybe Role)
-> Connection -> IO (Either SessionError (Maybe Role))
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run (UserID -> GroupID -> Session (Maybe Role)
Sessions.getUserRoleInGroup UserID
userID GroupID
groupID) Connection
conn
        case Either SessionError (Maybe Role)
eResult 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 (Just Role
role) ->
                if Role
role Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
userRole
                    then NoContent -> Handler NoContent
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return NoContent
NoContent
                    else 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 (UserID -> GroupID -> Role -> Session ()
Sessions.updateUserRoleInGroup UserID
userID GroupID
groupID Role
userRole) 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
            Right Maybe Role
Nothing -> 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 (UserID -> GroupID -> Role -> Session ()
Sessions.addRole UserID
userID GroupID
groupID Role
userRole) 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
postRoleHandler AuthResult Token
_ GroupID
_ UserID
_ Role
_ = ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn

deleteRoleHandler
    :: AuthResult Auth.Token -> Group.GroupID -> User.UserID -> Handler NoContent
deleteRoleHandler :: AuthResult Token -> GroupID -> UserID -> Handler NoContent
deleteRoleHandler (Authenticated Token
token) GroupID
groupID UserID
userID = do
    Connection
conn <- Handler Connection
tryGetDBConnection
    Connection
-> Token -> GroupID -> Handler NoContent -> Handler NoContent
forall a. Connection -> Token -> GroupID -> Handler a -> Handler a
ifSuperOrAdminDo Connection
conn Token
token GroupID
groupID (Connection -> Handler NoContent
deleteRole Connection
conn)
  where
    deleteRole :: Connection -> Handler NoContent
    deleteRole :: Connection -> Handler NoContent
deleteRole Connection
conn = do
        Either SessionError ()
eResult <-
            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 -> GroupID -> Session ()
Sessions.removeUserFromGroup UserID
userID GroupID
groupID) Connection
conn
        case Either SessionError ()
eResult 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
deleteRoleHandler AuthResult Token
_ GroupID
_ UserID
_ = ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn

putSuperadminHandler
    :: AuthResult Auth.Token -> User.UserID -> Handler NoContent
putSuperadminHandler :: AuthResult Token -> UserID -> Handler NoContent
putSuperadminHandler (Authenticated Auth.Token {Bool
UserID
subject :: UserID
isSuperadmin :: Bool
isSuperadmin :: Token -> Bool
subject :: Token -> UserID
..}) UserID
userID =
    if Bool
isSuperadmin
        then do
            Connection
conn <- Handler Connection
tryGetDBConnection
            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
userID) Connection
conn
            case Either SessionError Bool
eIsSuper 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 Bool
True -> NoContent -> Handler NoContent
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return NoContent
NoContent -- user already is SuperAdmin
                Right Bool
False -> 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 (UserID -> Session ()
Sessions.addSuperadmin UserID
userID) 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
putSuperadminHandler AuthResult Token
_ UserID
_ = ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn

deleteSuperadminHandler
    :: AuthResult Auth.Token -> User.UserID -> Handler NoContent
deleteSuperadminHandler :: AuthResult Token -> UserID -> Handler NoContent
deleteSuperadminHandler (Authenticated Auth.Token {Bool
UserID
isSuperadmin :: Token -> Bool
subject :: Token -> UserID
subject :: UserID
isSuperadmin :: Bool
..}) UserID
userID =
    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.removeSuperadmin UserID
userID) 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
deleteSuperadminHandler AuthResult Token
_ UserID
_ = ServerError -> Handler NoContent
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNotLoggedIn