{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Server.HandlerUtil
    ( ifSuperOrAdminDo
    , ifSuperOrGroupMemberDo
    , ifSuperOrAnyAdminDo
    , tryGetDBConnection
    , addRoleInGroup
    , checkPermission
    , getGroupOfDocument
    , errDatabaseConnectionFailed
    , errDatabaseAccessFailed
    , errNoMemberOfThisGroup
    , errNoAdminInAnyGroup
    , errNoAdminOfThisGroup
    , errSuperAdminOnly
    , errNotLoggedIn
    , errUserCreationFailed
    , errUserNotFound
    , errEmailAlreadyUsed
    , errDocumentDoesNotExist
    , errNoPermission
    , errWrongLoginCredentials
    , errLoginFailed
    ) where

import Control.Monad.IO.Class (MonadIO (liftIO))
import Database (getConnection)
import Docs.Document (DocumentID)
import Hasql.Connection (Connection)
import Hasql.Session (run)
import Servant
import qualified Server.Auth as Auth
import qualified UserManagement.DocumentPermission as Permission
import qualified UserManagement.Group as Group
import qualified UserManagement.Sessions as Sessions
import qualified UserManagement.User as User

-- | Checks if User is SuperAdmin or Admin in the given group.
--   If so, it calls the given callback Handler;
--   Otherwise, it throws a 403 error.
ifSuperOrAdminDo
    :: Connection -> Auth.Token -> Group.GroupID -> Handler a -> Handler a
ifSuperOrAdminDo :: forall a. Connection -> Token -> GroupID -> Handler a -> Handler a
ifSuperOrAdminDo Connection
conn (Auth.Token {Bool
UserID
subject :: UserID
isSuperadmin :: Bool
isSuperadmin :: Token -> Bool
subject :: Token -> UserID
..}) GroupID
groupID Handler a
callback =
    if Bool
isSuperadmin
        then Handler a
callback
        else do
            Either SessionError (Maybe Role)
emRole <- 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)
run (UserID -> GroupID -> Session (Maybe Role)
Sessions.getUserRoleInGroup UserID
subject GroupID
groupID) Connection
conn
            case Either SessionError (Maybe Role)
emRole of
                Left SessionError
_ -> ServerError -> Handler a
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
                Right Maybe Role
Nothing ->
                    ServerError -> Handler a
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNoAdminOfThisGroup
                Right (Just Role
role) ->
                    if Role
role Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
User.Admin
                        then Handler a
callback
                        else ServerError -> Handler a
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNoAdminOfThisGroup

-- | Checks if user is Member (or Admin) in specified group or Superadmin.
--   If so, it calls the given callback Handler;
--   Otherwise, it throws a 403 error.
ifSuperOrGroupMemberDo
    :: Connection -> Auth.Token -> Group.GroupID -> Handler a -> Handler a
ifSuperOrGroupMemberDo :: forall a. Connection -> Token -> GroupID -> Handler a -> Handler a
ifSuperOrGroupMemberDo Connection
conn (Auth.Token {Bool
UserID
isSuperadmin :: Token -> Bool
subject :: Token -> UserID
subject :: UserID
isSuperadmin :: Bool
..}) GroupID
groupID Handler a
callback = do
    if Bool
isSuperadmin
        then Handler a
callback
        else do
            Either SessionError Bool
eMembership <- 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)
run (UserID -> GroupID -> Session Bool
Sessions.checkGroupMembership UserID
subject GroupID
groupID) Connection
conn
            case Either SessionError Bool
eMembership of
                Left SessionError
_ -> ServerError -> Handler a
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
                Right Bool
False -> ServerError -> Handler a
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNoMemberOfThisGroup
                Right Bool
True -> Handler a
callback

-- | Checks if user is SuperAdmin or Admin in ANY Group.
--   If so, it calss the given callback Handler;
--   Otherwise, it throws a 403 error.
ifSuperOrAnyAdminDo :: Connection -> Auth.Token -> Handler a -> Handler a
ifSuperOrAnyAdminDo :: forall a. Connection -> Token -> Handler a -> Handler a
ifSuperOrAnyAdminDo Connection
conn (Auth.Token {Bool
UserID
isSuperadmin :: Token -> Bool
subject :: Token -> UserID
subject :: UserID
isSuperadmin :: Bool
..}) Handler a
callback =
    if Bool
isSuperadmin
        then Handler a
callback
        else do
            -- Check if User is Admin in ANY group
            Either SessionError [(GroupID, Text, Maybe Role)]
eRoles <- 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)
run (UserID -> Session [(GroupID, Text, Maybe Role)]
Sessions.getAllUserRoles UserID
subject) Connection
conn
            case Either SessionError [(GroupID, Text, Maybe Role)]
eRoles of
                Left SessionError
_ -> ServerError -> Handler a
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
                Right [] -> ServerError -> Handler a
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNoAdminInAnyGroup
                Right [(GroupID, Text, Maybe Role)]
roles ->
                    if ((GroupID, Text, Maybe Role) -> Bool)
-> [(GroupID, Text, Maybe Role)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(GroupID
_, Text
_, Maybe Role
mr) -> Maybe Role
mr Maybe Role -> Maybe Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role -> Maybe Role
forall a. a -> Maybe a
Just Role
User.Admin) [(GroupID, Text, Maybe Role)]
roles
                        then Handler a
callback
                        else ServerError -> Handler a
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errNoAdminInAnyGroup

-- | Gets DB Connection and throws 500 error if it fails
tryGetDBConnection :: Handler Connection
tryGetDBConnection :: Handler Connection
tryGetDBConnection = do
    Either ConnectionError Connection
eConn <- IO (Either ConnectionError Connection)
-> Handler (Either ConnectionError Connection)
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either ConnectionError Connection)
getConnection
    case Either ConnectionError Connection
eConn of
        Left ConnectionError
_ -> ServerError -> Handler Connection
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseConnectionFailed
        Right Connection
conn -> Connection -> Handler Connection
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn

-- | Adds given role in group to User
addRoleInGroup
    :: Connection -> User.UserID -> Group.GroupID -> User.Role -> Handler ()
addRoleInGroup :: Connection -> UserID -> GroupID -> Role -> Handler ()
addRoleInGroup Connection
conn UserID
userID GroupID
groupID Role
role = 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)
run (UserID -> GroupID -> Role -> Session ()
Sessions.addRole UserID
userID GroupID
groupID Role
role) Connection
conn
    case Either SessionError ()
eResult of
        Right () -> () -> Handler ()
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Left SessionError
_ -> ServerError -> Handler ()
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errFailedToSetRole

-- | Check if User is Member (or Admin) of the group that owns the specified document
--   or return external Permission. Members will always get `Editor` permission.
-- Nothing            -> both paths failed (no permission)
-- Just Permission -> User has given access rights
checkPermission
    :: Connection
    -> User.UserID
    -> DocumentID
    -> Handler (Maybe Permission.Permission)
checkPermission :: Connection -> UserID -> DocumentID -> Handler (Maybe Permission)
checkPermission Connection
conn UserID
userID DocumentID
docID = do
    Either SessionError Bool
eIsMember <- 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)
run (UserID -> DocumentID -> Session Bool
Sessions.checkGroupPermission UserID
userID DocumentID
docID) Connection
conn
    case Either SessionError Bool
eIsMember of
        Left SessionError
_ -> ServerError -> Handler (Maybe Permission)
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
        Right Bool
True -> Maybe Permission -> Handler (Maybe Permission)
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Permission -> Handler (Maybe Permission))
-> Maybe Permission -> Handler (Maybe Permission)
forall a b. (a -> b) -> a -> b
$ Permission -> Maybe Permission
forall a. a -> Maybe a
Just Permission
Permission.Edit -- user is member of right group
        Right Bool
False -> do
            Either SessionError (Maybe Permission)
ePerm <- IO (Either SessionError (Maybe Permission))
-> Handler (Either SessionError (Maybe Permission))
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError (Maybe Permission))
 -> Handler (Either SessionError (Maybe Permission)))
-> IO (Either SessionError (Maybe Permission))
-> Handler (Either SessionError (Maybe Permission))
forall a b. (a -> b) -> a -> b
$ Session (Maybe Permission)
-> Connection -> IO (Either SessionError (Maybe Permission))
forall a. Session a -> Connection -> IO (Either SessionError a)
run (UserID -> DocumentID -> Session (Maybe Permission)
Sessions.getExternalPermission UserID
userID DocumentID
docID) Connection
conn
            case Either SessionError (Maybe Permission)
ePerm of
                Left SessionError
_ -> ServerError -> Handler (Maybe Permission)
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
                Right Maybe Permission
x -> Maybe Permission -> Handler (Maybe Permission)
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Permission
x

-- | Get the groupID of the group that owns the specified document
getGroupOfDocument :: Connection -> DocumentID -> Handler Group.GroupID
getGroupOfDocument :: Connection -> DocumentID -> Handler GroupID
getGroupOfDocument Connection
conn DocumentID
docID = do
    Either SessionError (Maybe GroupID)
emgroupID <- IO (Either SessionError (Maybe GroupID))
-> Handler (Either SessionError (Maybe GroupID))
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SessionError (Maybe GroupID))
 -> Handler (Either SessionError (Maybe GroupID)))
-> IO (Either SessionError (Maybe GroupID))
-> Handler (Either SessionError (Maybe GroupID))
forall a b. (a -> b) -> a -> b
$ Session (Maybe GroupID)
-> Connection -> IO (Either SessionError (Maybe GroupID))
forall a. Session a -> Connection -> IO (Either SessionError a)
run (DocumentID -> Session (Maybe GroupID)
Sessions.getDocumentGroupID DocumentID
docID) Connection
conn
    case Either SessionError (Maybe GroupID)
emgroupID of
        Left SessionError
_ -> ServerError -> Handler GroupID
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDatabaseAccessFailed
        Right Maybe GroupID
Nothing -> ServerError -> Handler GroupID
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
errDocumentDoesNotExist
        Right (Just GroupID
groupID) -> GroupID -> Handler GroupID
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return GroupID
groupID

-- Specific errors
errDatabaseConnectionFailed :: ServerError
errDatabaseConnectionFailed :: ServerError
errDatabaseConnectionFailed = ServerError
err500 {errBody = "\"Connection to database failed!\""}

errDatabaseAccessFailed :: ServerError
errDatabaseAccessFailed :: ServerError
errDatabaseAccessFailed = ServerError
err500 {errBody = "\"Database access failed!\""}

errFailedToSetRole :: ServerError
errFailedToSetRole :: ServerError
errFailedToSetRole = ServerError
err500 {errBody = "\"Failed to set role in Database!\""}

errNoMemberOfThisGroup :: ServerError
errNoMemberOfThisGroup :: ServerError
errNoMemberOfThisGroup =
    ServerError
err403
        { errBody = "\"You have to be Member of the group to perform this action!\""
        }

errNoAdminOfThisGroup :: ServerError
errNoAdminOfThisGroup :: ServerError
errNoAdminOfThisGroup =
    ServerError
err403
        { errBody = "\"You have to be Admin of the group to perform this action!\""
        }

errNoAdminInAnyGroup :: ServerError
errNoAdminInAnyGroup :: ServerError
errNoAdminInAnyGroup = ServerError
err403 {errBody = "\"You have to be an Admin to perform this action!\""}

errSuperAdminOnly :: ServerError
errSuperAdminOnly :: ServerError
errSuperAdminOnly =
    ServerError
err403 {errBody = "\"You have to be Superadmin to perform this action!\""}

errNotLoggedIn :: ServerError
errNotLoggedIn :: ServerError
errNotLoggedIn =
    ServerError
err401
        { errBody = "\"Not allowed! You need to be logged in to perform this action.\""
        }

errUserCreationFailed :: ServerError
errUserCreationFailed :: ServerError
errUserCreationFailed = ServerError
err500 {errBody = "\"User creation failed!\""}

errUserNotFound :: ServerError
errUserNotFound :: ServerError
errUserNotFound = ServerError
err404 {errBody = "\"User not member of this group.\""}

errEmailAlreadyUsed :: ServerError
errEmailAlreadyUsed :: ServerError
errEmailAlreadyUsed = ServerError
err409 {errBody = "\"Email is already in use.\""}

errDocumentDoesNotExist :: ServerError
errDocumentDoesNotExist :: ServerError
errDocumentDoesNotExist = ServerError
err404 {errBody = "\"Document not found.\""}

errNoPermission :: ServerError
errNoPermission :: ServerError
errNoPermission = ServerError
err403 {errBody = "\"Insufficient permission to perform this action.\""}

errWrongLoginCredentials :: ServerError
errWrongLoginCredentials :: ServerError
errWrongLoginCredentials = ServerError
err401 {errBody = "\"Incorrect login credentials.\""}

errLoginFailed :: ServerError
errLoginFailed :: ServerError
errLoginFailed = ServerError
err500 {errBody = "\"Login failed! Please try again!\""}