src/Gargantext/API/GraphQL/Team.hs

   1 {-# LANGUAGE DeriveAnyClass #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3
   4 module Gargantext.API.GraphQL.Team where
   5
   6 import Gargantext.Prelude
   7 import GHC.Generics (Generic)
   8 import Data.Morpheus.Types (GQLType, Resolver, QUERY, ResolverM, lift)
   9 import Data.Text ( Text )
  10 import Gargantext.API.Admin.Types (HasSettings)
  11 import Gargantext.API.GraphQL.Utils (authUser, AuthStatus (Invalid, Valid))
  12 import Gargantext.API.Prelude (GargM, GargError)
  13 import Gargantext.Core.Types (NodeId(..), unNodeId)
  14 import qualified Gargantext.Core.Types.Individu as Individu
  15 import Gargantext.Database.Action.Share (membersOf, deleteMemberShip)
  16 import Gargantext.Database.Prelude (CmdCommon)
  17 import Gargantext.Database.Query.Table.Node (getNode)
  18 import Gargantext.Database.Query.Table.User (getUsersWithNodeHyperdata)
  19 import Gargantext.Database.Schema.Node (NodePoly(Node, _node_id), _node_user_id)
  20
  21 import qualified Data.Text as T
  22 import Gargantext.Database.Schema.User (UserLight(..))
  23
  24 data TeamArgs = TeamArgs
  25   { team_node_id :: Int } deriving (Generic, GQLType)
  26
  27 data Team = Team
  28  { team_owner_username :: Text
  29  , team_members         :: [TeamMember]
  30  } deriving (Generic, GQLType)
  31
  32 data TeamMember = TeamMember
  33  { username         :: Text
  34  , shared_folder_id :: Int
  35  } deriving (Generic, GQLType)
  36
  37 data TeamDeleteMArgs = TeamDeleteMArgs
  38   { token :: Text
  39   , shared_folder_id :: Int
  40   , team_node_id     :: Int
  41   } deriving (Generic, GQLType)
  42
  43 type GqlM e env = Resolver QUERY e (GargM env GargError)
  44 type GqlM' e env a = ResolverM e (GargM env GargError) a
  45
  46
  47 resolveTeam :: (CmdCommon env) => TeamArgs -> GqlM e env Team
  48 resolveTeam TeamArgs { team_node_id } = dbTeam team_node_id
  49
  50 dbTeam :: (CmdCommon env) =>
  51           Int -> GqlM e env Team
  52 dbTeam nodeId = do
  53   let nId = NodeId nodeId
  54   res <- lift $ membersOf nId
  55   teamNode <- lift $ getNode nId
  56   userNodes <- lift $ getUsersWithNodeHyperdata $ Individu.UserDBId $ uId teamNode
  57   let username = getUsername userNodes
  58   pure $ Team { team_owner_username = username
  59               , team_members = map toTeamMember res
  60               }
  61   where
  62     toTeamMember :: (Text, NodeId) -> TeamMember
  63     toTeamMember (username, fId)= TeamMember {
  64       username,
  65       shared_folder_id = unNodeId fId
  66     }
  67     uId Node { _node_user_id } = _node_user_id
  68     getUsername [] = panic "[resolveTeam] Team creator doesn't exist"
  69     getUsername ((UserLight {userLight_username}, _):_) = userLight_username
  70
  71 -- TODO: list as argument
  72 deleteTeamMembership :: (CmdCommon env, HasSettings env) =>
  73                         TeamDeleteMArgs -> GqlM' e env [Int]
  74 deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = do
  75   teamNode <- lift $ getNode $ NodeId team_node_id
  76   userNodes <- lift (getUsersWithNodeHyperdata $ Individu.UserDBId $ uId teamNode)
  77   case userNodes of
  78     [] -> panic $ "[deleteTeamMembership] User with id " <> T.pack (show $ uId teamNode) <> " doesn't exist."
  79     (( _, node_u):_) -> do
  80       testAuthUser <- lift $ authUser (nId node_u) token
  81       case testAuthUser of
  82         Invalid -> panic "[deleteTeamMembership] failed to validate user"
  83         Valid -> do
  84           lift $ deleteMemberShip [(NodeId shared_folder_id, NodeId team_node_id)]
  85   where
  86     uId Node { _node_user_id } = _node_user_id
  87     nId Node { _node_id } = _node_id