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
  24 data TeamArgs = TeamArgs
  25   { team_node_id :: Int } deriving (Generic, GQLType)
  26
  27 data TeamMember = TeamMember
  28  { username         :: Text
  29  , shared_folder_id :: Int
  30  } deriving (Generic, GQLType)
  31
  32 data TeamDeleteMArgs = TeamDeleteMArgs
  33   { token :: Text
  34   , shared_folder_id :: Int
  35   , team_node_id     :: Int
  36   } deriving (Generic, GQLType)
  37
  38 type GqlM e env = Resolver QUERY e (GargM env GargError)
  39 type GqlM' e env a = ResolverM e (GargM env GargError) a
  40
  41 todo :: a
  42 todo = undefined
  43
  44 resolveTeam :: (HasConnectionPool env, HasConfig env, HasMail env) => TeamArgs -> GqlM e env [TeamMember]
  45 resolveTeam TeamArgs { team_node_id } = dbTeam team_node_id
  46
  47 dbTeam :: (HasConnectionPool env, HasConfig env, HasMail env) => Int -> GqlM e env [TeamMember]
  48 dbTeam nodeId = do
  49   let nId = NodeId nodeId
  50   res <- lift $ membersOf nId
  51   pure $ map toTeamMember res
  52   where
  53     toTeamMember :: (Text, NodeId) -> TeamMember
  54     toTeamMember (username, fId)= TeamMember {
  55       username,
  56       shared_folder_id = unNodeId fId
  57     }
  58
  59 -- TODO: list as argument
  60 deleteTeamMembership :: (HasConnectionPool env, HasConfig env, HasMail env, HasSettings env) => TeamDeleteMArgs -> GqlM' e env [Int]
  61 deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = do
  62   teamNode <- lift $ getNode $ NodeId team_node_id
  63   userNodes <- lift (getUsersWithNodeHyperdata $ uId teamNode)
  64   case userNodes of
  65     [] -> panic $ "[deleteTeamMembership] User with id " <> T.pack (show $ uId teamNode) <> " doesn't exist."
  66     (( _, node_u):_) -> do
  67       testAuthUser <- lift $ authUser (nId node_u) token
  68       case testAuthUser of
  69         Invalid -> panic "[deleteTeamMembership] failed to validate user"
  70         Valid -> do
  71           lift $ deleteMemberShip [(NodeId shared_folder_id, NodeId team_node_id)]
  72   where
  73     uId Node { _node_user_id } = _node_user_id
  74     nId Node { _node_id } = _node_id