Share.hs 3.85 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11
{-|
Module      : Gargantext.Database.Action.Share
Description : 
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

12

13 14 15 16
module Gargantext.Database.Action.Share
  where

import Control.Lens (view)
17
import Gargantext.Database
18
import Gargantext.Core.Types.Individu (User(..))
19
import Gargantext.Database.Action.User (getUserId)
20
import Gargantext.Database.Admin.Config (hasNodeType, isInNodeTypes)
21
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny(..))
22
import Gargantext.Database.Admin.Types.Node
23
import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
24
import Gargantext.Database.Query.Table.Node.Error (HasNodeError, errorWith)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
25
import Gargantext.Database.Query.Table.NodeNode (deleteNodeNode)
26
import Gargantext.Database.Query.Tree.Root (getRootId)
27 28 29
import Gargantext.Database.Schema.Node
import Gargantext.Prelude

30
-- | TODO move in PhyloConfig of Gargantext
31
publicNodeTypes :: [NodeType]
32
publicNodeTypes = [NodeDashboard, NodeGraph, NodePhylo, NodeFile]
33 34 35

------------------------------------------------------------------------
data ShareNodeWith = ShareNodeWith_User { snwu_nodetype :: NodeType
36 37
                                        , snwu_user     :: User
                                        }
38
                   | ShareNodeWith_Node { snwn_nodetype :: NodeType
39
                                        , snwn_node_id  :: NodeId
40
                                        }
41 42
------------------------------------------------------------------------
shareNodeWith :: HasNodeError err
43 44
              => ShareNodeWith
              -> NodeId
45
              -> Cmd err Int
46
shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
47
  nodeToCheck <- getNode   n
48 49
  userIdCheck <- getUserId u
  if not (hasNodeType nodeToCheck NodeTeam)
50
    then errorWith "[G.D.A.S.shareNodeWith] Can share node Team only"
51
    else
52
      if (view node_user_id nodeToCheck == userIdCheck)
53
        then errorWith "[G.D.A.S.shareNodeWith] Can share to others only"
54 55
        else do
          folderSharedId  <- getFolderId u NodeFolderShared
56 57 58 59
          insertDB ([NodeNode { _nn_node1_id = folderSharedId
                              , _nn_node2_id = n
                              , _nn_score = Nothing
                              , _nn_category = Nothing }]:: [NodeNode])
60

61 62 63
shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
  nodeToCheck <- getNode n
  if not (isInNodeTypes nodeToCheck publicNodeTypes)
64 65
    then errorWith $ "[G.D.A.S.shareNodeWith] Can share this nodesTypes only: "
                   <> (cs $ show publicNodeTypes)
66 67 68
    else do
      folderToCheck <- getNode nId
      if hasNodeType folderToCheck NodeFolderPublic
69 70 71 72
         then insertDB ([NodeNode { _nn_node1_id = nId
                                  , _nn_node2_id = n
                                  , _nn_score = Nothing
                                  , _nn_category = Nothing }] :: [NodeNode])
73
         else errorWith "[G.D.A.S.shareNodeWith] Can share NodeWith NodeFolderPublic only"
74

75
shareNodeWith _ _ = errorWith "[G.D.A.S.shareNodeWith] Not implemented for this NodeType"
76

77
------------------------------------------------------------------------
78
getFolderId :: HasNodeError err => User -> NodeType -> Cmd err NodeId
79
getFolderId u nt = do
80
  rootId <- getRootId u
81
  s <- getNodesWith rootId HyperdataAny (Just nt) Nothing Nothing
82
  case head s of
83
    Nothing -> errorWith "[G.D.A.S.getFolderId] No folder shared found"
84 85
    Just  f -> pure (_node_id f)

86
------------------------------------------------------------------------
87 88
type TeamId = NodeId

89
delFolderTeam :: HasNodeError err => User -> TeamId -> Cmd err Int
90
delFolderTeam u nId = do
91
  folderSharedId <- getFolderId u NodeFolderShared
92 93
  deleteNodeNode folderSharedId nId

94 95 96 97
unPublish :: HasNodeError err
          => ParentId -> NodeId
          -> Cmd err Int
unPublish p n = deleteNodeNode p n
98