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