]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Action/Share.hs
Merge branch 'dev' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext...
[gargantext.git] / 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 module Gargantext.Database.Action.Share
13 where
14
15 import Control.Lens (view)
16 import Gargantext.Core.Types.Individu (User(..))
17 import Gargantext.Database.Action.Flow.Utils (getUserId)
18 import Gargantext.Database.Admin.Config (hasNodeType)
19 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny(..))
20 import Gargantext.Database.Admin.Types.Node (NodeId)
21 import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
22 import Gargantext.Database.Prelude (Cmd)
23 import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
24 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
25 import Gargantext.Database.Query.Table.NodeNode (insertNodeNode, deleteNodeNode)
26 import Gargantext.Database.Query.Tree.Root (getRootId)
27 import Gargantext.Database.Schema.Node
28 import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
29 import Gargantext.Prelude
30
31 ------------------------------------------------------------------------
32 shareNodeWith :: HasNodeError err
33 => NodeId
34 -> User
35 -> Cmd err Int64
36 shareNodeWith n u = do
37 nodeToCheck <- getNode n
38 userIdCheck <- getUserId u
39 if not (hasNodeType nodeToCheck NodeTeam)
40 then panic "Can share node Team only"
41 else if (view node_userId nodeToCheck == userIdCheck)
42 then panic "Can share to others only"
43 else do
44 folderSharedId <- getFolderSharedId u
45 insertNodeNode [NodeNode folderSharedId n Nothing Nothing]
46 ------------------------------------------------------------------------
47
48 getFolderSharedId :: User -> Cmd err NodeId
49 getFolderSharedId u = do
50 rootId <- getRootId u
51 s <- getNodesWith rootId HyperdataAny (Just NodeFolderShared) Nothing Nothing
52 case head s of
53 Nothing -> panic "No folder shared found"
54 Just f -> pure (_node_id f)
55
56 type TeamId = NodeId
57
58 delFolderTeam :: User -> TeamId -> Cmd err Int
59 delFolderTeam u nId = do
60 folderSharedId <- getFolderSharedId u
61 deleteNodeNode folderSharedId nId
62
63