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 Gargantext.Database.Action.Share (membersOf, deleteMemberShip)
  15 import Gargantext.Database.Prelude (CmdCommon)
  16 import Gargantext.Database.Query.Table.Node (getNode)
  17 import Gargantext.Database.Query.Table.User (getUsersWithNodeHyperdata)
  18 import Gargantext.Database.Schema.Node (NodePoly(Node, _node_id), _node_user_id)
  19
  20 import qualified Data.Text as T
  21 import Gargantext.Database.Schema.User (UserLight(..))
  22
  23 data TeamArgs = TeamArgs
  24   { team_node_id :: Int } deriving (Generic, GQLType)
  25
  26 data Team = Team
  27  { team_owner_username :: Text
  28  , team_members         :: [TeamMember]
  29  } deriving (Generic, GQLType)
  30
  31 data TeamMember = TeamMember
  32  { username         :: Text
  33  , shared_folder_id :: Int
  34  } deriving (Generic, GQLType)
  35
  36 data TeamDeleteMArgs = TeamDeleteMArgs
  37   { token :: Text
  38   , shared_folder_id :: Int
  39   , team_node_id     :: Int
  40   } deriving (Generic, GQLType)
  41
  42 type GqlM e env = Resolver QUERY e (GargM env GargError)
  43 type GqlM' e env a = ResolverM e (GargM env GargError) a
  44
  45
  46 resolveTeam :: (CmdCommon env) => TeamArgs -> GqlM e env Team
  47 resolveTeam TeamArgs { team_node_id } = dbTeam team_node_id
  48
  49 dbTeam :: (CmdCommon env) =>
  50           Int -> GqlM e env Team
  51 dbTeam nodeId = do
  52   let nId = NodeId nodeId
  53   res <- lift $ membersOf nId
  54   teamNode <- lift $ getNode nId
  55   userNodes <- lift $ getUsersWithNodeHyperdata $ uId teamNode
  56   let username = getUsername userNodes
  57   pure $ Team { team_owner_username = username
  58               , team_members = map toTeamMember res
  59               }
  60   where
  61     toTeamMember :: (Text, NodeId) -> TeamMember
  62     toTeamMember (username, fId)= TeamMember {
  63       username,
  64       shared_folder_id = unNodeId fId
  65     }
  66     uId Node { _node_user_id } = _node_user_id
  67     getUsername [] = panic "[resolveTeam] Team creator doesn't exist"
  68     getUsername ((UserLight {userLight_username}, _):_) = userLight_username
  69
  70 -- TODO: list as argument
  71 deleteTeamMembership :: (CmdCommon env, HasSettings env) =>
  72                         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