Properly display published folders in trees

It also:

* Removes UserNodePublic from typesWhiteList in isNodeReadOnly

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

@@ -28,6 +28,7 @@ module Gargantext.Database.Query.Table.Node
   , getClosestParentIdByType'
   , getCorporaWithParentId
   , getNode
+  , getParent
   , getNodeWith
   , getNodeWithType
   , getOrMkList
@@ -302,6 +303,14 @@ getNode nId = do
     Nothing -> nodeError (DoesNotExist nId)
     Just  r -> pure r
 
+-- | Get the parent of a given 'Node', failing if this was called
+-- on a root node.
+getParent :: HasNodeError err => Node a -> DBCmd err (Node Value)
+getParent n = do
+  case n ^. node_parent_id of
+    Nothing  -> nodeError NoRootFound
+    Just nId -> getNode nId
+
 getNodeWith :: (HasNodeError err, JSONB a)
             => NodeId -> proxy a -> DBCmd err (Node a)
 getNodeWith nId _ = do

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

@@ -14,8 +14,8 @@ commentary with @some markup@.
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE LambdaCase             #-}
 {-# LANGUAGE QuasiQuotes            #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TypeApplications       #-}
 
 module Gargantext.Database.Query.Table.NodeNode
   ( module Gargantext.Database.Schema.NodeNode
@@ -58,14 +58,14 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, h
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( Hyperdata )
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (DBCmd, mkCmd, runPGSQuery, runCountOpaQuery, runOpaQuery)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.Node (getNode)
 import Gargantext.Database.Schema.Ngrams ()
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.NodeNode
 import Gargantext.Prelude
 import Opaleye
 import Opaleye qualified as O
---import qualified Data.List as L
---import qualified Prelude
 
 queryNodeNodeTable :: Select NodeNodeRead
 queryNodeNodeTable = selectTable nodeNodeTable
@@ -273,68 +273,56 @@ publishedNodeIds = map (\(owner, nn) -> (SourceId $ _nn_node2_id nn, TargetId $
 -- | 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)
 -- are automatically read-only.
-isNodeReadOnly :: HasDBid NodeType => NodeId -> DBCmd err Bool
-isNodeReadOnly targetNode = (== [Only True])
-  <$> runPGSQuery [sql|
-      BEGIN;
-      SET TRANSACTION READ ONLY;
-      COMMIT;
-
-      WITH RECURSIVE ParentNodes AS (
-        -- Base case: Start from the given node ID
-        SELECT id, parent_id
-        FROM nodes
-        WHERE id = ?
-
-        UNION ALL
-
-        -- Recursive case: Traverse to parent nodes
-        SELECT n.id, n.parent_id
-        FROM nodes n
-        JOIN ParentNodes pn ON n.id = pn.parent_id
-    )
-    SELECT EXISTS (
-        SELECT 1
-        FROM ParentNodes pn
-        JOIN nodes_nodes nn ON pn.id = nn.node1_id OR pn.id = nn.node2_id
-        JOIN nodes n ON (nn.node1_id = n.id OR nn.node2_id = n.id)
-        WHERE n.typename = ? AND nn.category = ?
-    ) OR EXISTS (
-           SELECT 1
-           FROM nodes
-           WHERE id = ? AND typename = ? -- if the target is a public folder, it's automatically considered read-only
-    ) AS is_read_only;
-
-  |] ( targetNode
-     , toDBid NodeFolderPublic
-     , toDBid NNC_read_only_publish
-     , targetNode
-     , toDBid NodeFolderPublic
-     )
-
+isNodeReadOnly :: (HasNodeError err, HasDBid NodeType) => NodeId -> DBCmd err Bool
+isNodeReadOnly targetNodeId = do
+  targetNode <- getNode targetNodeId
+  case targetNode ^. node_typename `elem` map toDBid typesWhiteList of
+    True  -> pure True
+    False -> is_read_only_query
   where
-    -- NOTE(and) whitelisting?
-    _typesWhiteList :: [ NodeType ]
-    _typesWhiteList = [
-        NodeFolder
-      , NodeCorpus
-      , NodeCorpusV3
-      , NodeTexts
-      , NodeDocument
-      , NodeAnnuaire
-      , NodeContact
-      , NodeGraph
-      , NodePhylo
-      , NodeDashboard
-      , NodeList
-      , NodeModel
-      , NodeListCooc
-      , Notes
-      , Calc
-      , NodeFrameVisio
-      , NodeFrameNotebook
-      , NodeFile
-      ]
+    -- Certain kind of nodes are by default read-only and can in principle be visualised by other users
+    -- without harm. This would be the case for a user node which might contained published corpuses.
+    typesWhiteList :: [ NodeType ]
+    typesWhiteList = [ NodeFolderPublic ]
+
+    is_read_only_query = (== [Only True])
+      <$> runPGSQuery [sql|
+          BEGIN;
+          SET TRANSACTION READ ONLY;
+          COMMIT;
+
+          WITH RECURSIVE ParentNodes AS (
+            -- Base case: Start from the given node ID
+            SELECT id, parent_id
+            FROM nodes
+            WHERE id = ?
+
+            UNION ALL
+
+            -- Recursive case: Traverse to parent nodes
+            SELECT n.id, n.parent_id
+            FROM nodes n
+            JOIN ParentNodes pn ON n.id = pn.parent_id
+        )
+        SELECT EXISTS (
+            SELECT 1
+            FROM ParentNodes pn
+            JOIN nodes_nodes nn ON pn.id = nn.node1_id OR pn.id = nn.node2_id
+            JOIN nodes n ON (nn.node1_id = n.id OR nn.node2_id = n.id)
+            WHERE n.typename = ? AND nn.category = ?
+        ) OR EXISTS (
+               SELECT 1
+               FROM nodes
+               WHERE id = ? AND typename = ? -- if the target is a public folder, it's automatically considered read-only
+        ) AS is_read_only;
+
+      |] ( targetNodeId
+         , toDBid NodeFolderPublic
+         , toDBid NNC_read_only_publish
+         , targetNodeId
+         , toDBid NodeFolderPublic
+         )
+
 
 queryWithType :: HasDBid NodeType
               => NodeType

src/Gargantext/Database/Query/Tree.hs

@@ -65,6 +65,7 @@ import Gargantext.Database.Query.Tree.Error
 import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (to)
+import Gargantext.Database.Query.Table.Node (getUserRootPublicNode)
 
 ------------------------------------------------------------------------
 data DbTreeNode = DbTreeNode { _dt_nodeId   :: NodeId
@@ -121,7 +122,7 @@ tree_first_level :: (HasTreeError err, HasNodeError err)
                  -> [NodeType]
                  -> DBCmd err (Tree NodeTree)
 tree_first_level loggedInUserId r types = do
-  trees <- tree_find_modes loggedInUserId [ Private, PublicDirect, SharedDirect ] r types
+  trees <- tree_find_modes loggedInUserId [ Private, PublicDirect, SharedDirect, Published ] r types
   either treeError pure (toTree . toSubtreeParent r $ trees)
 
 -- | Fetch tree in a flattened form
@@ -195,29 +196,37 @@ findPublished :: (HasTreeError err, HasNodeError err)
               -> RootId
               -> [NodeType]
               -> DBCmd err [DbTreeNode]
-findPublished loggedInUserId r nt = do
-  allPublishedRootFolders <- publishedNodeIds
+findPublished loggedInUserId _r nt = do
+  -- Get the public folder for the /currently logged in user/. This will be the node where we
+  -- want to attach all the /public nodes/ of the users that are publishing something.
+  loggedInUserPublicFolder <- getUserRootPublicNode loggedInUserId
+  -- Get all the published nodes, but filter out those owned by the currently logged in user, because
+  -- those will be listed /only for the owner/ as part of the 'Public' 'find_nodes' query.
+  allPublishedRootFolders  <- filter (notOwnedByMe loggedInUserPublicFolder) <$> publishedNodeIds
   trees <- forM allPublishedRootFolders $ \(SourceId _sharedNodeId, TargetId publicFolderId, OwnerId publicFolderOwnerId) -> do
-    case publicFolderOwnerId == r of
-      True -> pure [] -- do not list our own published nodes, as they will already show up in the public folder.
-      False -> do
-        publicNode <- getNode publicFolderId
-        -- Get the full subtree reacheable from the source id
-        sharedSubTree <- findNodes loggedInUserId publicFolderOwnerId Public nt
-        -- Now we need to artificially attach this subtree to a node which will show up in
-        -- the final tree as being owned by the logged-in user, but clearly showing as provenance
-        -- the public folder id.
-
-        let publishedNode = DbTreeNode {
-                _dt_nodeId   = publicNode ^. node_id
-              , _dt_typeId   = publicNode ^. node_typename
-              , _dt_parentId = Just r
-              , _dt_name     = publicNode ^. node_name
-              }
-
-        let detachedTree = publishedNode : (sharedSubTree & over L._head (\dt -> dt { _dt_parentId = Just $ _dt_nodeId publishedNode }))
-        pure detachedTree
+    publicNode     <- getNode publicFolderId
+    let publicNodeId = publicNode ^. node_id
+    -- Fetch the user node which is sharing this folder.
+    sharerUserNode <- getNode publicFolderOwnerId
+    -- Get the full subtree reacheable from the source id
+    sharedSubTree <- findNodes (sharerUserNode ^. node_user_id) publicFolderOwnerId Public nt
+    -- Now we need to artificially attach this subtree to a node which will show up in
+    -- the final tree as being owned by the logged-in user, but clearly showing as provenance
+    -- the public folder id.
+
+    let sharerDbTreeNode = DbTreeNode {
+            _dt_nodeId   = publicNodeId
+          , _dt_typeId   = publicNode ^. node_typename
+          , _dt_parentId = Just (loggedInUserPublicFolder ^. node_id)
+          , _dt_name     = sharerUserNode ^. node_name
+          }
+
+    let detachedTree = sharerDbTreeNode : (sharedSubTree & over L._head (\dt -> dt { _dt_parentId = Just publicNodeId }))
+    pure $ detachedTree
   pure $ mconcat trees
+  where
+    notOwnedByMe :: Node a -> (SourceId, TargetId, OwnerId) -> Bool
+    notOwnedByMe myPublicFolder (_, TargetId folderId, _) = myPublicFolder ^. node_id /= folderId
 
 ------------------------------------------------------------------------
 -- | Collaborative Nodes in the Tree