Database.Query.Tree refactoring

This commit refactors a bit the internal of the
`Gargantext.Database.Query.Tree` module so that it removes a lot of
repetitive boilerplate and paves the way to more interesting features.

It also:

* Adds the `isUserNode` boolean query
* Adjust source and target in publishNode and unpublishNode
* Pass the currently-logged-in user to tree API functions

src/Gargantext/API/Auth/PolicyCheck.hs

@@ -195,7 +195,8 @@ nodeChecks nid =
   nodeUser nid  `BOr`
   nodeSuper nid `BOr`
   nodeDescendant nid `BOr`
-  nodeShared nid
+  nodeShared nid `BOr`
+  nodePublished nid
 
 -- | A user can move a node from source to target only
 -- if:

src/Gargantext/API/GraphQL/TreeFirstLevel.hs

@@ -15,7 +15,7 @@ Portability : POSIX
 module Gargantext.API.GraphQL.TreeFirstLevel where
 
 import Data.Morpheus.Types (GQLType)
-import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser )
+import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser(..) )
 import Gargantext.API.Auth.PolicyCheck (AccessPolicyManager, nodeChecks)
 import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
 import Gargantext.API.GraphQL.Types ( GqlM )
@@ -71,13 +71,13 @@ resolveTree :: (CmdCommon env)
             -> TreeArgs
             -> GqlM e env (TreeFirstLevel (GqlM e env))
 resolveTree autUser mgr TreeArgs { root_id } =
-  withPolicy autUser mgr (nodeChecks $ UnsafeMkNodeId root_id) $ dbTree root_id
+  withPolicy autUser mgr (nodeChecks $ UnsafeMkNodeId root_id) $ dbTree (_auth_user_id autUser) root_id
 
 dbTree :: (CmdCommon env) =>
-          Int -> GqlM e env (TreeFirstLevel (GqlM e env))
-dbTree root_id = do
+          NN.UserId -> Int -> GqlM e env (TreeFirstLevel (GqlM e env))
+dbTree loggedInUserId root_id = do
   let rId = UnsafeMkNodeId root_id
-  t <- lift $ T.tree T.TreeFirstLevel rId allNodeTypes
+  t <- lift $ T.tree loggedInUserId T.TreeFirstLevel rId allNodeTypes
   n <- lift $ getNode $ UnsafeMkNodeId root_id
   let pId = toParentId n
   pure $ toTree rId pId t

src/Gargantext/API/Node.hs

@@ -167,8 +167,8 @@ treeAPI :: IsGargServer env BackendInternalError m
         -> Named.NodeTreeAPI (AsServerT m)
 treeAPI authenticatedUser nodeId mgr =
   withNamedPolicyT authenticatedUser (nodeChecks nodeId) (Named.NodeTreeAPI
-    { nodeTreeEp   = tree TreeAdvanced nodeId
-    , firstLevelEp = tree TreeFirstLevel nodeId
+    { nodeTreeEp   = tree (_auth_user_id authenticatedUser) TreeAdvanced nodeId
+    , firstLevelEp = tree (_auth_user_id authenticatedUser) TreeFirstLevel nodeId
     }) mgr
 
 treeFlatAPI :: IsGargServer env err m
@@ -177,7 +177,7 @@ treeFlatAPI :: IsGargServer env err m
             -> Named.TreeFlatAPI (AsServerT m)
 treeFlatAPI authenticatedUser rootId =
   withNamedAccess authenticatedUser (PathNode rootId) $
-    Named.TreeFlatAPI { getNodesEp = tree_flat rootId }
+    Named.TreeFlatAPI { getNodesEp = tree_flat (_auth_user_id authenticatedUser) rootId }
 
 ------------------------------------------------------------------------
 -- | TODO Check if the name is less than 255 char

src/Gargantext/Core/Text/List/Social/Find.hs

@@ -23,14 +23,17 @@ import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Tree
 import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Prelude
+import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Schema.Node
 
 ------------------------------------------------------------------------
 findListsId :: (HasNodeError err, HasTreeError err)
             => User -> NodeMode -> DBCmd err [NodeId]
 findListsId u mode = do
   rootId <- getRootId u
+  userNode <- getNode rootId
   ns <- map (view dt_nodeId) <$> filter ((== toDBid NodeList) . (view dt_typeId))
-                             <$> findNodes' rootId mode
+                             <$> findNodes' (_node_user_id userNode) rootId mode
   pure ns
 
 
@@ -39,17 +42,19 @@ findListsId u mode = do
 -- | Shared is for Shared with me but I am not the owner of it
 -- | Private is for all Lists I have created
 findNodes' :: (HasTreeError err, HasNodeError err)
-          => RootId
+          => UserId
+          -> RootId
           -> NodeMode
           -> DBCmd err [DbTreeNode]
-findNodes' r Private = do
-  pv <- (findNodes r Private $ [NodeFolderPrivate]          <> commonNodes)
-  sh <- (findNodes' r Shared)
+findNodes' loggedInUserId r Private = do
+  pv <- (findNodes loggedInUserId r Private $ [NodeFolderPrivate]          <> commonNodes)
+  sh <- (findNodes' loggedInUserId r Shared)
   pure $ pv <> sh
-findNodes' r Shared       = findNodes r Shared  $ [NodeFolderShared, NodeTeam] <> commonNodes
-findNodes' r SharedDirect = findNodes r Shared  $ [NodeFolderShared, NodeTeam] <> commonNodes
-findNodes' r Public       = findNodes r Public  $ [NodeFolderPublic ]          <> commonNodes
-findNodes' r PublicDirect = findNodes r Public  $ [NodeFolderPublic ]          <> commonNodes
+findNodes' loggedInUserId r Shared       = findNodes loggedInUserId r Shared  $ [NodeFolderShared, NodeTeam] <> commonNodes
+findNodes' loggedInUserId r SharedDirect = findNodes loggedInUserId r Shared  $ [NodeFolderShared, NodeTeam] <> commonNodes
+findNodes' loggedInUserId r Public       = findNodes loggedInUserId r Public  $ [NodeFolderPublic ]          <> commonNodes
+findNodes' loggedInUserId r PublicDirect = findNodes loggedInUserId r Public  $ [NodeFolderPublic ]          <> commonNodes
+findNodes' _loggedInUserId _ Published    = pure [] -- FIXME(adn) What's the right behaviour here?
 
 commonNodes:: [NodeType]
 commonNodes = [NodeFolder, NodeCorpus, NodeList, NodeFolderShared, NodeTeam]

src/Gargantext/Core/Types/Main.hs

@@ -38,6 +38,9 @@ data NodeTree = NodeTree { _nt_name      :: Text
                          , _nt_id        :: NodeId
                          } deriving (Show, Read, Generic)
 
+instance Eq NodeTree where
+  (==) d1 d2 = _nt_id d1 == _nt_id d2
+
 $(deriveJSON (unPrefix "_nt_") ''NodeTree)
 instance ToSchema NodeTree where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_nt_")

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

@@ -36,6 +36,9 @@ module Gargantext.Database.Query.Table.Node
   , getUserRootPrivateNode
   , selectNode
 
+  -- * Boolean queries
+  , isUserNode
+
   -- * Queries that returns multiple nodes
   , getChildrenByType
   , getClosestChildrenByType
@@ -440,3 +443,14 @@ get_user_root_node_folder nty userId = do
     []      -> nodeError $ NodeLookupFailed $ UserFolderDoesNotExist userId
     [n]     -> pure n
     folders -> nodeError $ NodeLookupFailed $ UserHasTooManyRoots userId (map _node_id folders)
+
+-- | An input 'NodeId' identifies a user node if its typename is 'NodeUser' and it has no parent_id.
+isUserNode :: HasDBid NodeType => NodeId -> DBCmd err Bool
+isUserNode userNodeId = (== [PGS.Only True])
+  <$> runPGSQuery [sql|
+    SELECT EXISTS (
+        SELECT 1
+        FROM nodes
+        WHERE n.id = ? AND n.typename = ? AND n.parent_id = NULL
+    )
+|] (userNodeId, toDBid NodeUser)

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

@@ -23,6 +23,7 @@ module Gargantext.Database.Query.Table.NodeNode
   -- * Types
   , SourceId(..)
   , TargetId(..)
+  , OwnerId(..)
 
   -- * Queries
   , getNodeNode
@@ -258,14 +259,16 @@ selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb
                   => DBCmd err [(Node a, Maybe Int)]
 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 
-publishedNodeIds :: DBCmd err [NodeId]
-publishedNodeIds = map (_nn_node1_id) <$> do_query
+publishedNodeIds :: DBCmd err [(SourceId, TargetId, OwnerId)]
+publishedNodeIds = map (\(owner, nn) -> (SourceId $ _nn_node2_id nn, TargetId $ _nn_node1_id nn, OwnerId owner)) <$> do_query
   where
-    do_query :: DBCmd err [NodeNode]
+    do_query :: DBCmd err [(NodeId, NodeNode)]
     do_query = runOpaQuery $ do
-      n <- queryNodeNodeTable
-      where_ $ (n ^. nn_category .== sqlInt4 (toDBid NNC_read_only_publish))
-      pure n
+      n  <- queryNodeTable
+      nn <- queryNodeNodeTable
+      where_ $ (nn ^. nn_category .== sqlInt4 (toDBid NNC_read_only_publish))
+      where_ $ (n ^. node_id .== nn ^. nn_node1_id)
+      pure (n ^. node_parent_id, nn)
 
 -- | A 'Node' is read-only if there exist a match in the node_nodes directory
 -- where the source is a public folder. Certain category of nodes (like private/shared folders, etc)
@@ -349,23 +352,35 @@ node_NodeNode = proc () -> do
   returnA -< (n, view nn_node2_id <$> nn)
 
 newtype SourceId = SourceId NodeId
+  deriving (Show, Eq, Ord)
 newtype TargetId = TargetId NodeId
+  deriving (Show, Eq, Ord)
+newtype OwnerId = OwnerId NodeId
+  deriving (Show, Eq, Ord)
 
 shareNode :: SourceId -> TargetId -> DBCmd err Int
 shareNode (SourceId sourceId) (TargetId targetId) =
   insertNodeNode [ NodeNode sourceId targetId Nothing Nothing ]
 
 -- | Publishes a node, i.e. it creates a relationship between
--- the input node and the target public folder. It fails if
--- the 'TargetId' doesn't refer to a 'NodeFolderPublic'. Use
--- 'getUserRootPublicNode' to acquire the 'TargetId'.
+-- the input node and the target public folder.
+-- /NOTE/: Even though the semantic of the relationships it
+-- source -> target, by historical reason we store this in the
+-- node_node table backwards, i.e. the public folder first as
+-- the 'node1_id', and the shared node as the target, so we
+-- honour this.
 publishNode :: SourceId -> TargetId -> DBCmd err ()
 publishNode (SourceId sourceId) (TargetId targetId) =
-  void $ insertNodeNode [ NodeNode sourceId targetId Nothing (Just NNC_read_only_publish) ]
+  void $ insertNodeNode [ NodeNode targetId sourceId Nothing (Just NNC_read_only_publish) ]
 
+-- /NOTE/: Even though the semantic of the relationships it
+-- source -> target, by historical reason we store this in the
+-- node_node table backwards, i.e. the public folder first as
+-- the 'node1_id', and the shared node as the target, so we
+-- honour this.
 unpublishNode :: SourceId -> TargetId -> DBCmd err ()
 unpublishNode (SourceId sourceId) (TargetId targetId) =
-  void $ deleteNodeNode sourceId targetId
+  void $ deleteNodeNode targetId sourceId
 
 -- | Pair two nodes together. Typically used to pair
 -- together

test/Test/API/Setup.hs

@@ -35,7 +35,7 @@ import Gargantext.Database.Action.User.New
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Trigger.Init
 import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Admin.Types.Node hiding (DEBUG)
 import Gargantext.Database.Prelude ()
 import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..))