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