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.Prelude (GargM, GargError)
  11 import Gargantext.Database.Action.Share (membersOf, deleteMemberShip)
  12 import Gargantext.Core.Types (NodeId(..), unNodeId)
  13 import Gargantext.Database.Prelude (HasConnectionPool)
  14 import Gargantext.Database (HasConfig)
  15 import Gargantext.Core.Mail.Types (HasMail)
  16 import Gargantext.Database.Query.Table.Node (getNode)
  17 import Gargantext.API.GraphQL.Utils (authUser, AuthStatus (Invalid, Valid))
  18 import Gargantext.Database.Schema.Node (NodePoly(Node, _node_id), _node_user_id)
  19 import Gargantext.API.Admin.Types (HasSettings)
  20 import Gargantext.Database.Query.Table.User (getUsersWithNodeHyperdata)
  21
  22 import qualified Data.Text as T
  23 import Gargantext.Database.Schema.User (UserLight(..))
  24
  25 data TeamArgs = TeamArgs
  26   { team_node_id :: Int } deriving (Generic, GQLType)
  27
  28 data Team = Team
  29  { team_leader_username :: Text
  30  , team_members         :: [TeamMember]
  31  } deriving (Generic, GQLType)
  32
  33 data TeamMember = TeamMember
  34  { username         :: Text
  35  , shared_folder_id :: Int
  36  } deriving (Generic, GQLType)
  37
  38 data TeamDeleteMArgs = TeamDeleteMArgs
  39   { token :: Text
  40   , shared_folder_id :: Int
  41   , team_node_id     :: Int
  42   } deriving (Generic, GQLType)
  43
  44 type GqlM e env = Resolver QUERY e (GargM env GargError)
  45 type GqlM' e env a = ResolverM e (GargM env GargError) a
  46
  47
  48 resolveTeam :: (HasConnectionPool env, HasConfig env, HasMail env) => TeamArgs -> GqlM e env Team
  49 resolveTeam TeamArgs { team_node_id } = dbTeam team_node_id
  50
  51 dbTeam :: (HasConnectionPool env, HasConfig env, HasMail env) => 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 $ uId teamNode
  57   let username = getUsername userNodes
  58   pure $ Team { team_leader_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 :: (HasConnectionPool env, HasConfig env, HasMail env, HasSettings env) => TeamDeleteMArgs -> GqlM' e env [Int]
  73 deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = do
  74   teamNode <- lift $ getNode $ NodeId team_node_id
  75   userNodes <- lift (getUsersWithNodeHyperdata $ uId teamNode)
  76   case userNodes of
  77     [] -> panic $ "[deleteTeamMembership] User with id " <> T.pack (show $ uId teamNode) <> " doesn't exist."
  78     (( _, node_u):_) -> do
  79       testAuthUser <- lift $ authUser (nId node_u) token
  80       case testAuthUser of
  81         Invalid -> panic "[deleteTeamMembership] failed to validate user"
  82         Valid -> do
  83           lift $ deleteMemberShip [(NodeId shared_folder_id, NodeId team_node_id)]
  84   where
  85     uId Node { _node_user_id } = _node_user_id
  86     nId Node { _node_id } = _node_id