{-| Module : Gargantext.API.GraphQL.Team Description : Copyright : (c) CNRS, 2017 License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-} module Gargantext.API.GraphQL.Team where import Data.Morpheus.Types (GQLType, ResolverM) import Data.Text qualified as T import Gargantext.API.Admin.Auth.Types (AuthenticationError(..)) import Gargantext.API.Errors.Types import Gargantext.API.GraphQL.Types (GqlM) import Gargantext.API.GraphQL.Utils (authUser, AuthStatus (Invalid, Valid)) import Gargantext.API.Prelude (GargM) import Gargantext.Core.Config (HasJWTSettings) import Gargantext.Core.Types (NodeId(..), unNodeId) import Gargantext.Core.Types.Individu qualified as Individu import Gargantext.Database.Action.Share (membersOf, deleteMemberShip) import Gargantext.Database.Prelude import Gargantext.Database.Query.Table.Node (getNode) import Gargantext.Database.Query.Table.User (getUsersWithNodeHyperdata) import Gargantext.Database.Schema.Node (NodePoly(Node, _node_id), _node_user_id) import Gargantext.Database.Schema.User (UserLight(..)) import Gargantext.Prelude data TeamArgs = TeamArgs { team_node_id :: Int } deriving (Generic, GQLType) data Team = Team { team_owner_username :: Text , team_members :: [TeamMember] } deriving (Generic, GQLType) data TeamMember = TeamMember { username :: Text , shared_folder_id :: Int } deriving (Generic, GQLType) data TeamDeleteMArgs = TeamDeleteMArgs { token :: Text , shared_folder_id :: Int , team_node_id :: Int } deriving (Generic, GQLType) type GqlM' e env a = ResolverM e (GargM env BackendInternalError) a resolveTeam :: (IsDBEnvExtra env) => TeamArgs -> GqlM e env Team resolveTeam TeamArgs { team_node_id } = dbTeam team_node_id dbTeam :: (IsDBEnvExtra env) => Int -> GqlM e env Team dbTeam nodeId = do let nId = UnsafeMkNodeId nodeId lift $ runDBQuery $ do res <- membersOf nId teamNode <- getNode nId userNodes <- getUsersWithNodeHyperdata $ Individu.UserDBId $ uId teamNode let username = getUsername userNodes pure $ Team { team_owner_username = username , team_members = map toTeamMember res } where toTeamMember :: (Text, NodeId) -> TeamMember toTeamMember (username, fId)= TeamMember { username, shared_folder_id = unNodeId fId } uId Node { _node_user_id } = _node_user_id getUsername [] = panicTrace "[resolveTeam] Team creator doesn't exist" getUsername ((UserLight {userLight_username}, _):_) = userLight_username -- TODO: list as argument deleteTeamMembership :: (IsDBEnvExtra env, HasJWTSettings env) => TeamDeleteMArgs -> GqlM' e env [Int] deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = do userNodes <- lift $ runDBTx $ do teamNode <- getNode $ UnsafeMkNodeId team_node_id getUsersWithNodeHyperdata $ Individu.UserDBId $ uId teamNode case userNodes of [] -> panicTrace $ "[deleteTeamMembership] User with id " <> T.pack (show $ team_node_id) <> " doesn't exist." (( _, node_u):_) -> do testAuthUser <- lift $ authUser (nId node_u) token case testAuthUser of -- Invalid -> panicTrace "[deleteTeamMembership] failed to validate user" Invalid -> do lift $ throwError $ InternalAuthenticationError $ UserNotAuthorized (uId node_u) "This user is not team owner" Valid -> do lift $ runDBTx $ deleteMemberShip [(UnsafeMkNodeId shared_folder_id, UnsafeMkNodeId team_node_id)] where uId Node { _node_user_id } = _node_user_id nId Node { _node_id } = _node_id