[FEAT|COLLAB] delete team node enabled preserving rights

src/Gargantext/API/Node.hs

@@ -48,16 +48,15 @@ import Gargantext.Core.Types (NodeTableResult)
 import Gargantext.Core.Types.Main (Tree, NodeTree, ListType)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
 import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
+import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Children (getChildren)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Table.Node.User
 import Gargantext.Database.Query.Tree (tree, TreeMode(..))
-import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
-import Gargantext.Database.Schema.Node (_node_typename)
 import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Prelude
 import Gargantext.Viz.Chart
@@ -66,12 +65,15 @@ import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
+import qualified Gargantext.Database.Action.Delete as Action (deleteNode)
 
 {-
 import qualified Gargantext.Text.List.Learn as Learn
 import qualified Data.Vector as Vec
 --}
 
+-- | Admin NodesAPI
+-- TODO
 type NodesAPI  = Delete '[JSON] Int
 
 -- | Delete Nodes
@@ -120,10 +122,10 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "children"  :> ChildrenApi a
 
              -- TODO gather it
-             :<|> "table"     :> TableApi
-             :<|> "ngrams"    :> TableNgramsApi
+             :<|> "table"      :> TableApi
+             :<|> "ngrams"     :> TableNgramsApi
 
-             :<|> "category"  :> CatApi
+             :<|> "category"   :> CatApi
              :<|> "search"     :> SearchDocsAPI
 
              -- Pairing utilities
@@ -133,11 +135,11 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "searchPair" :> SearchPairsAPI
 
              -- VIZ
-             :<|> "metrics" :> ScatterAPI
-             :<|> "chart"     :> ChartApi
-             :<|> "pie"       :> PieApi
-             :<|> "tree"      :> TreeApi
-             :<|> "phylo"     :> PhyloAPI
+             :<|> "metrics"    :> ScatterAPI
+             :<|> "chart"      :> ChartApi
+             :<|> "pie"        :> PieApi
+             :<|> "tree"       :> TreeApi
+             :<|> "phylo"      :> PhyloAPI
              -- :<|> "add"       :> NodeAddAPI
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
@@ -189,7 +191,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> postNode  uId id'
            :<|> postNodeAsyncAPI  uId id'
            :<|> putNode       id'
-           :<|> deleteNodeApi id'
+           :<|> Action.deleteNode (RootId $ NodeId uId) id'
            :<|> getChildren   id' p
 
            -- TODO gather it
@@ -213,12 +215,6 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            -- :<|> nodeAddAPI id'
            -- :<|> postUpload id'
 
-    deleteNodeApi id'' = do
-      node' <- getNode id''
-      if _node_typename node' == nodeTypeId NodeUser
-         then panic "not allowed"  -- TODO add proper Right Management Type
-         else deleteNode id''
-
 ------------------------------------------------------------------------
 data RenameNode = RenameNode { r_name :: Text }
   deriving (Generic)
@@ -306,7 +302,6 @@ type TreeApi = Summary " Tree API"
              -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
 
 ------------------------------------------------------------------------
-
 type TreeAPI   = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
 
 treeAPI :: NodeId -> GargServer TreeAPI

src/Gargantext/Database/Action/Delete.hs

+{-|
+Module      : Gargantext.Database.Action.Delete
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+TODO: right managements of nodes children of node Team
+-- TODO add proper Right Management Type
+
+TODO: NodeError
+
+-}
+
+module Gargantext.Database.Action.Delete
+  where
+
+import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Database.Action.Flow.Utils (getUserId)
+import Gargantext.Database.Admin.Config (hasNodeType)
+import Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
+import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Schema.Node
+import Gargantext.Prelude
+import qualified Gargantext.Database.Query.Table.Node as N (getNode, deleteNode)
+import Gargantext.Database.Action.Share (delFolderTeam)
+
+deleteNode :: HasNodeError err 
+           => User
+           -> NodeId
+           -> Cmd err Int
+deleteNode u nodeId = do
+  node' <- N.getNode nodeId
+  if hasNodeType node' NodeUser
+     then panic "Not allowed to delete NodeUser (yet)"
+     else if hasNodeType node' NodeTeam
+             then do
+                uId   <- getUserId u
+                if _node_userId node' == uId
+                   then N.deleteNode    nodeId
+                   else delFolderTeam u nodeId
+             else N.deleteNode nodeId
+
+

src/Gargantext/Database/Action/Share.hs

@@ -19,11 +19,10 @@ import Gargantext.Database.Admin.Config (hasNodeType)
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
 import Gargantext.Database.Prelude (Cmd)
-import Gargantext.Database.Query.Table.Node (getNode)
+import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
-import Gargantext.Database.Query.Table.NodeNode (insertNodeNode)
-import Gargantext.Database.Query.Tree
-import Gargantext.Database.Query.Tree.Root (getRoot)
+import Gargantext.Database.Query.Table.NodeNode (insertNodeNode, deleteNodeNode)
+import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
 import Gargantext.Prelude
@@ -41,10 +40,23 @@ shareNodeWith n u = do
     else if (view node_userId nodeToCheck == userIdCheck)
      then panic "Can share to others only"
      else do 
-       r <- map _node_id <$> getRoot u
-       s <- case head r of
-           Nothing -> panic "no root id"
-           Just r' -> findNodesId r' [NodeFolderShared]
-       insertNodeNode $ map (\s' -> NodeNode s' n Nothing Nothing) s
+       folderSharedId  <- getFolderSharedId u
+       insertNodeNode [NodeNode folderSharedId n Nothing Nothing]
 ------------------------------------------------------------------------
 
+getFolderSharedId :: User -> Cmd err NodeId
+getFolderSharedId u = do
+  rootId <- getRootId u
+  s <- getNodesWith rootId HyperdataAny (Just NodeFolderShared) Nothing Nothing
+  case head s of
+    Nothing -> panic "No folder shared found"
+    Just  f -> pure (_node_id f)
+
+type TeamId = NodeId
+
+delFolderTeam :: User -> TeamId -> Cmd err Int
+delFolderTeam u nId = do
+  folderSharedId <- getFolderSharedId u
+  deleteNodeNode folderSharedId nId
+
+

src/Gargantext/Database/Query/Table/Node.hs

@@ -152,6 +152,7 @@ getNodeWith nId _ = do
     Nothing -> nodeError (DoesNotExist nId)
     Just  r -> pure r
 
+
 ------------------------------------------------------------------------
 nodeContactW :: Maybe Name -> Maybe HyperdataContact
              -> AnnuaireId -> UserId -> NodeWrite

src/Gargantext/Database/Query/Table/NodeNode.hs

@@ -27,6 +27,7 @@ module Gargantext.Database.Query.Table.NodeNode
   , nodeNodesCategory
   , getNodeNode
   , insertNodeNode
+  , deleteNodeNode
   )
   where
 
@@ -80,7 +81,17 @@ insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn
                             (pgInt4   <$> y)
               ) ns
 
+------------------------------------------------------------------------
+type Node1_Id = NodeId
+type Node2_Id = NodeId
+
+deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
+deleteNodeNode n1 n2 = mkCmd $ \conn ->
+  fromIntegral <$> runDelete conn nodeNodeTable
+                 (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
+                                             .&& n2_id .== pgNodeId n2 )
 
+------------------------------------------------------------------------
 -- | Favorite management
 _nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
 _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)

src/Gargantext/Database/Query/Tree/Root.hs

@@ -40,6 +40,16 @@ import Opaleye (restrict, (.==), Query)
 import Opaleye.PGTypes (pgStrictText, pgInt4)
 
 
+getRootId :: User -> Cmd err NodeId
+getRootId u = do
+  maybeRoot <- head <$> getRoot u
+  case maybeRoot of
+    Nothing -> panic "no root id"
+    Just  r -> pure (_node_id r)
+
+getRoot :: User -> Cmd err [Node HyperdataUser]
+getRoot = runOpaQuery . selectRoot
+
 
 getOrMkRoot :: (HasNodeError err)
             => User
@@ -116,9 +126,6 @@ mkRoot user = do
          _   -> pure rs
        pure rs
 
-getRoot :: User -> Cmd err [Node HyperdataUser]
-getRoot = runOpaQuery . selectRoot
-
 selectRoot :: User -> Query NodeRead
 selectRoot (UserName username) = proc () -> do
     row   <- queryNodeTable -< ()