src/Gargantext/Database/Action/Share.hs

   1 {-|
   2 Module      : Gargantext.Database.Action.Share
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12
  13 {-# LANGUAGE Arrows                 #-}
  14
  15 module Gargantext.Database.Action.Share
  16   where
  17
  18 import Control.Arrow (returnA)
  19 import Control.Lens (view, (^.))
  20 import Data.Text (Text)
  21 import Gargantext.Core.Types.Individu (User(..))
  22 import Gargantext.Database
  23 import Gargantext.Database.Action.User (getUserId)
  24 import Gargantext.Database.Admin.Config (hasNodeType, isInNodeTypes)
  25 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny(..))
  26 import Gargantext.Database.Admin.Types.Node
  27 import Gargantext.Database.Query.Join (leftJoin3')
  28 import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
  29 import Gargantext.Database.Query.Table.Node.Error (HasNodeError, errorWith)
  30 import Gargantext.Database.Query.Table.NodeNode (deleteNodeNode, queryNodeNodeTable)
  31 import Gargantext.Database.Query.Table.User
  32 import Gargantext.Database.Query.Tree.Root (getRootId)
  33 import Gargantext.Database.Schema.Node
  34 import Gargantext.Prelude
  35 import Opaleye hiding (not)
  36 import qualified Opaleye as O
  37
  38 -- | TODO move in PhyloConfig of Gargantext
  39 publicNodeTypes :: [NodeType]
  40 publicNodeTypes = [NodeDashboard, NodeGraph, NodePhylo, NodeFile]
  41
  42 ------------------------------------------------------------------------
  43 data ShareNodeWith = ShareNodeWith_User { snwu_nodetype :: NodeType
  44                                         , snwu_user     :: User
  45                                         }
  46                    | ShareNodeWith_Node { snwn_nodetype :: NodeType
  47                                         , snwn_node_id  :: NodeId
  48                                         }
  49 ------------------------------------------------------------------------
  50 deleteMemberShip :: HasNodeError err => [(SharedFolderId, TeamNodeId)] -> Cmd err [Int]
  51 deleteMemberShip xs = mapM (\(s,t) -> deleteNodeNode s t) xs
  52
  53 ------------------------------------------------------------------------
  54
  55 type SharedFolderId = NodeId
  56 type TeamNodeId     = NodeId
  57
  58 -- List members of a Team
  59 -- Result gives the username and its SharedFolderId that has to be eventually
  60 -- used for the membership
  61 membersOf :: HasNodeError err
  62           => TeamNodeId -> Cmd err [(Text, SharedFolderId)]
  63 membersOf nId = runOpaQuery (membersOfQuery nId)
  64
  65
  66 membersOfQuery :: TeamNodeId
  67                -> SelectArr () (Column (Nullable SqlText), Column (Nullable SqlInt4))
  68 membersOfQuery (NodeId teamId) = proc () -> do
  69   (nn, (n, u)) <- nodeNode_node_User -< ()
  70   restrict -< nn^.nn_node2_id .== sqlInt4 teamId
  71   returnA -< (user_username u, n^.node_id)
  72
  73
  74 nodeNode_node_User :: O.Select (NodeNodeRead, (NodeReadNull, UserReadNull))
  75 nodeNode_node_User = leftJoin3' queryNodeNodeTable
  76                                queryNodeTable
  77                                queryUserTable
  78                                cond12
  79                                cond23
  80   where
  81     cond12 :: (NodeNodeRead, (NodeRead, UserReadNull)) -> Column SqlBool
  82     cond12 (nn, (n, _u)) = (nn^.nn_node1_id  .== n^.node_id)
  83     cond23 :: (NodeRead, UserRead) -> Column SqlBool
  84     cond23 (n, u) = (n^.node_user_id .== user_id u)
  85
  86
  87
  88 ------------------------------------------------------------------------
  89 -- To Share a Node Team with a user, use this function
  90 -- basically used with the invitation to a team
  91 shareNodeWith :: HasNodeError err
  92               => ShareNodeWith
  93               -> NodeId
  94               -> Cmd err Int
  95 shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
  96   nodeToCheck <- getNode   n
  97   userIdCheck <- getUserId u
  98   if not (hasNodeType nodeToCheck NodeTeam)
  99     then errorWith "[G.D.A.S.shareNodeWith] Can share node Team only"
 100     else
 101       if (view node_user_id nodeToCheck == userIdCheck)
 102         then errorWith "[G.D.A.S.shareNodeWith] Can share to others only"
 103         else do
 104           folderSharedId  <- getFolderId u NodeFolderShared
 105           insertDB ([NodeNode { _nn_node1_id = folderSharedId
 106                               , _nn_node2_id = n
 107                               , _nn_score = Nothing
 108                               , _nn_category = Nothing }]:: [NodeNode])
 109
 110 shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
 111   nodeToCheck <- getNode n
 112   if not (isInNodeTypes nodeToCheck publicNodeTypes)
 113     then errorWith $ "[G.D.A.S.shareNodeWith] Can share this nodesTypes only: "
 114                    <> (cs $ show publicNodeTypes)
 115     else do
 116       folderToCheck <- getNode nId
 117       if hasNodeType folderToCheck NodeFolderPublic
 118          then insertDB ([NodeNode { _nn_node1_id = nId
 119                                   , _nn_node2_id = n
 120                                   , _nn_score = Nothing
 121                                   , _nn_category = Nothing }] :: [NodeNode])
 122          else errorWith "[G.D.A.S.shareNodeWith] Can share NodeWith NodeFolderPublic only"
 123
 124 shareNodeWith _ _ = errorWith "[G.D.A.S.shareNodeWith] Not implemented for this NodeType"
 125
 126 ------------------------------------------------------------------------
 127 getFolderId :: HasNodeError err => User -> NodeType -> Cmd err NodeId
 128 getFolderId u nt = do
 129   rootId <- getRootId u
 130   s <- getNodesWith rootId HyperdataAny (Just nt) Nothing Nothing
 131   case head s of
 132     Nothing -> errorWith "[G.D.A.S.getFolderId] No folder shared found"
 133     Just  f -> pure (_node_id f)
 134
 135 ------------------------------------------------------------------------
 136 type TeamId = NodeId
 137
 138 delFolderTeam :: HasNodeError err => User -> TeamId -> Cmd err Int
 139 delFolderTeam u nId = do
 140   folderSharedId <- getFolderId u NodeFolderShared
 141   deleteNodeNode folderSharedId nId
 142
 143 unPublish :: HasNodeError err
 144           => ParentId -> NodeId
 145           -> Cmd err Int
 146 unPublish p n = deleteNodeNode p n
 147