Correct FrontendError for policy check failures

It also: * Amends tests for policy checks status code changes * Fix a bug in isNodeReadOnly * Adds a function to return all the nodes ids for the published nodes. Next we need to modify `findShared` & co to make sure that published notes will show somewhere in the users' tree.

Correct FrontendError for policy check failures
It also: * Amends tests for policy checks status code changes * Fix a bug in isNodeReadOnly * Adds a function to return all the nodes ids for the published nodes. Next we need to modify `findShared` & co to make sure that published notes will show somewhere in the users' tree.
cb49e82a · Alfredo Di Napoli · 2cf2292e · cb49e82a · cb49e82a · cb49e82a
Commit cb49e82a authored Oct 28, 2024 by Alfredo Di Napoli
19 changed files
--- a/gargantext.cabal
+++ b/gargantext.cabal
@@ -261,6 +261,7 @@ library
      Gargantext.Database.Query.Table.Node.Error
      Gargantext.Database.Query.Table.NodeNode
      Gargantext.Database.Query.Table.Node.UpdateOpaleye
+      Gargantext.Database.Query.Table.Node.User
      Gargantext.Database.Query.Table.User
      Gargantext.Database.Query.Tree.Root
      Gargantext.Database.Schema.Ngrams
@@ -446,7 +447,6 @@ library
      Gargantext.Database.Query.Table.Node.Document.Insert
      Gargantext.Database.Query.Table.Node.Select
      Gargantext.Database.Query.Table.Node.Update
-      Gargantext.Database.Query.Table.Node.User
      Gargantext.Database.Query.Table.NodeContext
      Gargantext.Database.Query.Table.NodeContext_NodeContext
      Gargantext.Database.Query.Table.NodeNgrams
@@ -732,6 +732,7 @@ common testDependencies
    , hspec ^>= 2.11.1
    , hspec-core
    , hspec-expectations >= 0.8 && < 0.9
+    , hspec-expectations-lifted < 0.11
    , hspec-wai
    , hspec-wai-json
    , http-api-data >= 0.5 && < 0.6

--- a/src/Gargantext/API/Admin/Auth.hs
+++ b/src/Gargantext/API/Admin/Auth.hs
@@ -193,7 +193,7 @@ withPolicy ur checks m mgr = case mgr of
    res <- runAccessPolicy ur checks
    case res of
      Allow     -> m
-      Deny err  -> throwError $ InternalServerError $ err
+      Deny err  -> throwError $ AccessPolicyError err
 -- FIXME(adn) the types are wrong.
 withNamedPolicyT :: forall env m routes.

--- a/src/Gargantext/API/Auth/PolicyCheck.hs
+++ b/src/Gargantext/API/Auth/PolicyCheck.hs
@@ -16,6 +16,7 @@ module Gargantext.API.Auth.PolicyCheck (
  , nodeSuper
  , nodeUser
  , nodeChecks
+  , nodePublished
  , moveChecks
  , userMe
  , alwaysAllow
@@ -25,25 +26,26 @@ module Gargantext.API.Auth.PolicyCheck (
 import Control.Lens (view)
 import Data.BoolExpr (BoolExpr(..), Signed(..))
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
-import Gargantext.API.Errors.Types (BackendInternalError)
+import Gargantext.API.Errors.Types (AccessPolicyErrorReason(..))
 import Gargantext.Core.Config (GargConfig(..), HasConfig(hasConfig))
 import Gargantext.Core.Config.Types (SecretsConfig(..))
-import Gargantext.Core.Types (NodeId, UserId)
 import Gargantext.Core.Types.Individu (User(UserName))
+import Gargantext.Core.Types (NodeId, UserId)
 import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Database.Query.Tree (isDescendantOf, isOwnedBy, isSharedWith)
 import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Prelude
-import Servant (HasServer(..), ServerError, ServerT, err403, err500)
 import Servant.API.Routes (HasRoutes(getRoutes))
 import Servant.Auth.Server.Internal.AddSetCookie (AddSetCookieApi, AddSetCookies(..), Nat(S))
 import Servant.Client.Core (HasClient(..), Client)
 import Servant.Ekg (HasEndpoint(..))
+import Servant (HasServer(..), ServerT)
 import Servant.Server.Internal.Delayed (addParameterCheck)
 import Servant.Server.Internal.DelayedIO (DelayedIO(..))
 import Servant.Swagger qualified as Swagger
-import Gargantext.Database.Query.Table.NodeNode
+import Gargantext.API.Errors (BackendInternalError)
 -------------------------------------------------------------------------------
 -- Types
@@ -57,7 +59,7 @@ data AccessResult
  = -- | Grants access.
    Allow
    -- | Denies access with the given 'ServerError'.
-  | Deny ServerError
+  | Deny AccessPolicyErrorReason
 instance Semigroup AccessResult where
  Allow <> Allow        = Allow
@@ -81,6 +83,8 @@ data AccessCheck
    AC_node_descendant  !NodeId
    -- | Grants access if the input 'NodeId' is shared with the logged-in user.
  | AC_node_shared      !NodeId
+    -- | Grants access if the input 'NodeId' is shared with the logged-in user.
+  | AC_node_published   !NodeId
    -- | Grants access if the input 'NodeId' /is/ the logged-in user.
  | AC_user_node        !NodeId
    -- | Grants access if the logged-in user is the user.
@@ -116,12 +120,12 @@ accessPolicyManager = AccessPolicyManager (\ur ac -> interpretPolicy ur ac)
        -> do
          res <- interpretPolicy ur b1
          case res of
-            Allow  -> pure $ Deny err403
+            Allow  -> pure $ Deny invalidUserPermissions
            Deny _ -> pure Allow
      BTrue
        -> pure Allow
      BFalse
-        -> pure $ Deny err403
+        -> pure $ Deny invalidUserPermissions
      BConst (Positive b)
        -> check' ur b
      BConst (Negative b)
@@ -131,23 +135,38 @@ accessPolicyManager = AccessPolicyManager (\ur ac -> interpretPolicy ur ac)
 check' :: HasNodeError err => AuthenticatedUser -> AccessCheck -> DBCmd err AccessResult
 check' (AuthenticatedUser loggedUserNodeId loggedUserUserId) = \case
  AC_always_deny
-    -> pure $ Deny err500
+    -> pure $ Deny invalidUserPermissions
  AC_always_allow
    -> pure Allow
  AC_user_node requestedNodeId
    -> do ownedByMe <- requestedNodeId `isOwnedBy` loggedUserUserId
-          enforce err403 $ (loggedUserNodeId == requestedNodeId || ownedByMe)
+          enforce invalidUserPermissions $ (loggedUserNodeId == requestedNodeId || ownedByMe)
  AC_user requestedUserId
-    -> enforce err403 $ (loggedUserUserId == requestedUserId)
+    -> enforce invalidUserPermissions $ (loggedUserUserId == requestedUserId)
  AC_master_user _requestedNodeId
    -> do
      masterUsername <- _s_master_user . _gc_secrets <$> view hasConfig
      masterNodeId   <- getRootId (UserName masterUsername)
-      enforce err403 $ masterNodeId == loggedUserNodeId
+      enforce invalidUserPermissions $ masterNodeId == loggedUserNodeId
  AC_node_descendant nodeId
-    -> enforce err403 =<< nodeId `isDescendantOf` loggedUserNodeId
+    -> enforce nodeNotDescendant =<< nodeId `isDescendantOf` loggedUserNodeId
  AC_node_shared nodeId
-    -> enforce err403 =<< nodeId `isSharedWith` loggedUserNodeId
+    -> enforce nodeNotShared =<< nodeId `isSharedWith` loggedUserNodeId
+  AC_node_published nodeId
+    -> enforce nodeNotShared =<< isNodeReadOnly nodeId
+-------------------------------------------------------------------------------
+-- Errors
+-------------------------------------------------------------------------------
+nodeNotShared :: AccessPolicyErrorReason
+nodeNotShared = AccessPolicyErrorReason "Node is not shared with user."
+nodeNotDescendant :: AccessPolicyErrorReason
+nodeNotDescendant = AccessPolicyErrorReason "Node is not a direct descendant."
+invalidUserPermissions :: AccessPolicyErrorReason
+invalidUserPermissions = AccessPolicyErrorReason "User not authorized to perform the operation."
 -------------------------------------------------------------------------------
 -- Smart constructors of access checks
@@ -168,8 +187,15 @@ nodeDescendant = BConst . Positive . AC_node_descendant
 nodeShared :: NodeId -> BoolExpr AccessCheck
 nodeShared = BConst . Positive . AC_node_shared
+nodePublished :: NodeId -> BoolExpr AccessCheck
+nodePublished = BConst . Positive . AC_node_published
 nodeChecks :: NodeId -> BoolExpr AccessCheck
-nodeChecks nid = nodeUser nid `BOr` nodeSuper nid `BOr` nodeDescendant nid `BOr` nodeShared nid
+nodeChecks nid =
+  nodeUser nid  `BOr`
+  nodeSuper nid `BOr`
+  nodeDescendant nid `BOr`
+  nodeShared nid
 -- | A user can move a node from source to target only
 -- if:
@@ -228,5 +254,5 @@ instance (HasRoutes subApi) => HasRoutes (PolicyChecked subApi) where
 -- | If the given predicate holds then grant access, otherwise denies access
 -- with the given 'ServerError'.
-enforce :: Applicative m => ServerError -> Bool -> m AccessResult
+enforce :: Applicative m => AccessPolicyErrorReason -> Bool -> m AccessResult
 enforce errStatus p = pure $ if p then Allow else Deny errStatus
--- a/src/Gargantext/API/Errors.hs
+++ b/src/Gargantext/API/Errors.hs
@@ -79,6 +79,13 @@ backendErrorToFrontendError = \case
         $ FE_validation_error $ case prettyValidation validationError of
             Nothing -> "unknown_validation_error"
             Just v  -> T.pack v
+  AccessPolicyError accessPolicyError
+    -> case accessPolicyError of
+         AccessPolicyNodeError nodeError
+           -> nodeErrorToFrontendError nodeError
+         AccessPolicyErrorReason reason
+           -> mkFrontendErr' "A policy check failed"
+                $ FE_policy_check_error reason
 frontendErrorToGQLServerError :: FrontendError -> ServerError
 frontendErrorToGQLServerError fe@(FrontendError diag ty _) =
@@ -155,8 +162,8 @@ nodeErrorToFrontendError ne = case ne of
           -> mkFrontendErrShow $ FE_node_lookup_failed_username_not_found uname
         UserHasTooManyRoots uid roots
           -> mkFrontendErrShow $ FE_node_lookup_failed_user_too_many_roots uid roots
-         UserPublicFolderDoesNotExist uid
+         UserFolderDoesNotExist uid
-           -> mkFrontendErrShow $ FE_node_lookup_failed_user_no_public_folder uid
+           -> mkFrontendErrShow $ FE_node_lookup_failed_user_no_folder uid
  NotImplYet
    -> mkFrontendErrShow FE_node_not_implemented_yet
  NoContextFound contextId

--- a/src/Gargantext/API/Errors/Types.hs
+++ b/src/Gargantext/API/Errors/Types.hs
@@ -31,6 +31,7 @@ module Gargantext.API.Errors.Types (
  , BackendInternalError(..)
  , GraphQLError(..)
  , ToFrontendErrorData(..)
+  , AccessPolicyErrorReason(..)
  -- * Constructing frontend errors
  , mkFrontendErrNoDiagnostic
@@ -83,8 +84,15 @@ instance Exception e => Exception (WithStacktrace e) where
 -- | An internal error which can be emitted from the backend and later
 -- converted into a 'FrontendError', for later consumption.
+data AccessPolicyErrorReason
+  = AccessPolicyErrorReason !T.Text
+  | AccessPolicyNodeError !NodeError
+  deriving Show
+makePrisms ''AccessPolicyErrorReason
+instance HasNodeError AccessPolicyErrorReason where
+  _NodeError = _AccessPolicyNodeError
 data BackendInternalError
  = InternalAuthenticationError !AuthenticationError
@@ -94,6 +102,7 @@ data BackendInternalError
  | InternalTreeError           !TreeError
  | InternalUnexpectedError     !SomeException
  | InternalValidationError     !Validation
+  | AccessPolicyError           !AccessPolicyErrorReason
  deriving (Show, Typeable)
 makePrisms ''BackendInternalError
@@ -215,8 +224,8 @@ data instance ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_root
                                            }
  deriving (Show, Eq, Generic)
-data instance ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_public_folder =
+data instance ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_folder =
-  FE_node_lookup_failed_user_no_public_folder { nenpf_user_id :: UserId }
+  FE_node_lookup_failed_user_no_folder { nenpf_user_id :: UserId }
  deriving (Show, Eq, Generic)
 newtype instance ToFrontendErrorData 'EC_404__node_context_not_found =
@@ -259,6 +268,14 @@ data instance ToFrontendErrorData 'EC_400__validation_error =
  FE_validation_error { validation_error :: T.Text }
  deriving (Show, Eq, Generic)
+--
+-- policy check errors
+--
+data instance ToFrontendErrorData 'EC_403__policy_check_error =
+  FE_policy_check_error { policy_check_error :: T.Text }
+  deriving (Show, Eq, Generic)
 --
 -- authentication errors
 --
@@ -407,13 +424,13 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many
    netmr_roots   <- o .: "roots"
    pure FE_node_lookup_failed_user_too_many_roots{..}
-instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_public_folder) where
+instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_folder) where
-  toJSON (FE_node_lookup_failed_user_no_public_folder userId) =
+  toJSON (FE_node_lookup_failed_user_no_folder userId) =
    object [ "user_id" .= toJSON userId ]
-instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_public_folder) where
+instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_folder) where
-  parseJSON = withObject "FE_node_lookup_failed_user_no_public_folder" $ \o -> do
+  parseJSON = withObject "FE_node_lookup_failed_user_no_folder" $ \o -> do
    nenpf_user_id <- o .: "user_id"
-    pure FE_node_lookup_failed_user_no_public_folder{..}
+    pure FE_node_lookup_failed_user_no_folder{..}
 instance ToJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where
  toJSON (FE_node_context_not_found cId) = object [ "context_id" .= toJSON cId ]
@@ -479,6 +496,16 @@ instance FromJSON (ToFrontendErrorData 'EC_400__validation_error) where
  parseJSON (String txt) = pure $ FE_validation_error txt
  parseJSON ty           = typeMismatch "FE_validation_error" ty
+--
+-- policy check errors
+--
+instance ToJSON (ToFrontendErrorData 'EC_403__policy_check_error) where
+  toJSON (FE_policy_check_error val) = toJSON val
+instance FromJSON (ToFrontendErrorData 'EC_403__policy_check_error) where
+  parseJSON (String txt) = pure $ FE_policy_check_error txt
+  parseJSON ty           = typeMismatch "FE_policy_check_error" ty
 --
 -- authentication errors
 --
@@ -640,8 +667,8 @@ instance FromJSON FrontendError where
      EC_400__node_lookup_failed_user_too_many_roots -> do
        (fe_data :: ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_roots) <- o .: "data"
        pure FrontendError{..}
-      EC_404__node_lookup_failed_user_no_public_folder -> do
+      EC_404__node_lookup_failed_user_no_folder -> do
-        (fe_data :: ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_public_folder) <- o .: "data"
+        (fe_data :: ToFrontendErrorData 'EC_404__node_lookup_failed_user_no_folder) <- o .: "data"
        pure FrontendError{..}
      EC_500__node_not_implemented_yet -> do
        (fe_data :: ToFrontendErrorData 'EC_500__node_not_implemented_yet) <- o .: "data"
@@ -676,6 +703,11 @@ instance FromJSON FrontendError where
        (fe_data :: ToFrontendErrorData 'EC_400__validation_error) <- o .: "data"
        pure FrontendError{..}
+      -- policy check error
+      EC_403__policy_check_error -> do
+        (fe_data :: ToFrontendErrorData 'EC_403__policy_check_error) <- o .: "data"
+        pure FrontendError{..}
      -- authentication errors
      EC_403__login_failed_error -> do
        (fe_data :: ToFrontendErrorData 'EC_403__login_failed_error) <- o .: "data"

--- a/src/Gargantext/API/Errors/Types/Backend.hs
+++ b/src/Gargantext/API/Errors/Types/Backend.hs
@@ -23,7 +23,7 @@ data BackendErrorCode
  | EC_400__node_lookup_failed_user_too_many_roots
  | EC_404__node_lookup_failed_user_not_found
  | EC_404__node_lookup_failed_username_not_found
-  | EC_404__node_lookup_failed_user_no_public_folder
+  | EC_404__node_lookup_failed_user_no_folder
  | EC_404__node_corpus_not_found
  | EC_500__node_not_implemented_yet
  | EC_404__node_context_not_found
@@ -36,6 +36,8 @@ data BackendErrorCode
  | EC_403__node_is_read_only
  -- validation errors
  | EC_400__validation_error
+  -- policy check errors
+  | EC_403__policy_check_error
  -- authentication errors
  | EC_403__login_failed_error
  | EC_403__login_failed_invalid_username_or_password

--- a/src/Gargantext/API/GraphQL/PolicyCheck.hs
+++ b/src/Gargantext/API/GraphQL/PolicyCheck.hs
@@ -22,5 +22,5 @@ withPolicy ur mgr checks m = case mgr of
    res <- lift $ runAccessPolicy ur checks
    case res of
      Allow     -> m
-      Deny err  -> lift $ throwError $ InternalServerError $ err
+      Deny err  -> lift $ throwError $ AccessPolicyError err
--- a/src/Gargantext/Database/Query/Table/Node.hs
+++ b/src/Gargantext/Database/Query/Table/Node.hs
@@ -33,6 +33,7 @@ module Gargantext.Database.Query.Table.Node
  , getOrMkList
  , getParentId
  , getUserRootPublicNode
+  , getUserRootPrivateNode
  , selectNode
  -- * Queries that returns multiple nodes
@@ -418,13 +419,24 @@ getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
 getUserRootPublicNode :: (HasNodeError err, HasDBid NodeType)
                      => UserId
                      -> DBCmd err (Node HyperdataFolder)
-getUserRootPublicNode userId = do
+getUserRootPublicNode = get_user_root_node_folder NodeFolderPublic
+getUserRootPrivateNode :: (HasNodeError err, HasDBid NodeType)
+                       => UserId
+                       -> DBCmd err (Node HyperdataFolder)
+getUserRootPrivateNode = get_user_root_node_folder NodeFolderPrivate
+get_user_root_node_folder :: (HasNodeError err, HasDBid NodeType)
+                          => NodeType
+                          -> UserId
+                          -> DBCmd err (Node HyperdataFolder)
+get_user_root_node_folder nty userId = do
  result <- runOpaQuery $ do
    n <- queryNodeTable
-    where_ $ (n ^. node_typename .== sqlInt4 (toDBid NodeFolderPublic)) .&&
+    where_ $ (n ^. node_typename .== sqlInt4 (toDBid nty)) .&&
             (n ^. node_user_id  .== sqlInt4 (_UserId userId))
    pure n
  case result of
-    []      -> nodeError $ NodeLookupFailed $ UserPublicFolderDoesNotExist userId
+    []      -> nodeError $ NodeLookupFailed $ UserFolderDoesNotExist userId
    [n]     -> pure n
    folders -> nodeError $ NodeLookupFailed $ UserHasTooManyRoots userId (map _node_id folders)
--- a/src/Gargantext/Database/Query/Table/Node/Error.hs
+++ b/src/Gargantext/Database/Query/Table/Node/Error.hs
@@ -57,7 +57,7 @@ data NodeLookupError
  | UserDoesNotExist     UserId
  | UserNameDoesNotExist Username
  | UserHasTooManyRoots UserId [NodeId]
-  | UserPublicFolderDoesNotExist UserId
+  | UserFolderDoesNotExist UserId
  deriving (Show, Eq, Generic)
 instance ToJSON NodeLookupError
@@ -69,7 +69,7 @@ renderNodeLookupFailed = \case
  UserDoesNotExist uid -> "user with id " <> T.pack (show uid) <> " couldn't be found."
  UserNameDoesNotExist uname -> "user with username '" <> uname <> "' couldn't be found."
  UserHasTooManyRoots uid roots -> "user with id " <> T.pack (show uid) <> " has too many roots: [" <> T.intercalate "," (map (T.pack . show) roots)
-  UserPublicFolderDoesNotExist uid -> "no public folder was found for user with id " <> T.pack (show uid)
+  UserFolderDoesNotExist uid -> "no requested folder was found for user with id " <> T.pack (show uid)
 ------------------------------------------------------------------------
 data NodeError = NoListFound ListId

--- a/src/Gargantext/Database/Query/Table/Node/User.hs
+++ b/src/Gargantext/Database/Query/Table/Node/User.hs
@@ -10,17 +10,22 @@ Portability : POSIX
 -}
 module Gargantext.Database.Query.Table.Node.User
+  ( getNodeUser
+  , getUserByName
+  )
  where
-import Gargantext.Core ( HasDBid )
+import Data.Text qualified as T
-import Gargantext.Core.Types (Name)
+import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser(..) )
-import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser(..), defaultHyperdataUser )
+import Gargantext.Database.Admin.Types.Node (Node, NodeId(..), pgNodeId)
-import Gargantext.Database.Admin.Types.Node (Node, NodeId(..), UserId, NodeType(..), pgNodeId)
 import Gargantext.Database.Prelude (DBCmd, runOpaQuery)
-import Gargantext.Database.Query.Table.Node ( node, selectNode )
+import Gargantext.Database.Query.Table.Node ( selectNode )
-import Gargantext.Database.Schema.Node ( NodeWrite ) -- (Node(..))
 import Gargantext.Prelude
 import Opaleye (limit)
+import Gargantext.Database.Schema.Node (queryNodeTable, node_name)
+import Opaleye.Operators
+import Opaleye.SqlTypes
+import Gargantext.Database.Query.Table.Node.Error
 getNodeUser :: NodeId -> DBCmd err (Node HyperdataUser)
@@ -28,9 +33,12 @@ getNodeUser nId = do
    fromMaybe (panicTrace $ "Node does not exist: " <> (show nId)) . headMay
             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
-nodeUserW :: HasDBid NodeType => Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite
+getUserByName :: HasNodeError err => T.Text -> DBCmd err (Node HyperdataUser)
-nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
+getUserByName username = do
-  where
+  result <- runOpaQuery $ do
-    name = maybe "User" identity maybeName
+    n <- queryNodeTable
-    user = maybe defaultHyperdataUser identity maybeHyperdata
+    where_ $ (n ^. node_name .== sqlStrictText username)
+    pure n
+  case result of
+    [n]  -> pure n
+    _    -> nodeError $ NodeLookupFailed $ UserNameDoesNotExist username
--- a/src/Gargantext/Database/Query/Table/NodeNode.hs
+++ b/src/Gargantext/Database/Query/Table/NodeNode.hs
@@ -31,6 +31,7 @@ module Gargantext.Database.Query.Table.NodeNode
  , selectDocs
  , selectDocsDates
  , selectPublicNodes
+  , publishedNodeIds
  -- * Destructive operations
  , deleteNodeNode
@@ -257,6 +258,15 @@ 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
+  where
+    do_query :: DBCmd err [NodeNode]
+    do_query = runOpaQuery $ do
+      n <- queryNodeNodeTable
+      where_ $ (n ^. nn_category .== sqlInt4 (toDBid NNC_read_only_publish))
+      pure n
 -- | 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.
@@ -296,7 +306,7 @@ isNodeReadOnly targetNode = (== [Only True])
     , toDBid NodeFolderPublic
     , toDBid NNC_read_only_publish
     , targetNode
-     , toDBid NNC_read_only_publish
+     , toDBid NodeFolderPublic
     )
  where

--- a/src/Gargantext/Database/Query/Tree.hs
+++ b/src/Gargantext/Database/Query/Tree.hs
@@ -180,8 +180,8 @@ findShared :: HasTreeError err
           => RootId -> NodeType -> [NodeType] -> UpdateTree err
           -> DBCmd err [DbTreeNode]
 findShared r nt nts fun = do
-  foldersSharedId <- findNodesId r [nt]
+  foldersSharedId     <- findNodesId r [nt]
-  trees           <- mapM (updateTree nts fun) foldersSharedId
+  trees               <- mapM (updateTree nts fun) foldersSharedId
  pure $ concat trees
 -- | Find shared folders with "direct" access, i.e. when fetching only

--- a/test/Test/API.hs
+++ b/test/Test/API.hs
@@ -13,7 +13,7 @@ import qualified Test.API.Private as Private
 import qualified Test.API.UpdateList as UpdateList
 tests :: NotificationsConfig -> D.Dispatcher -> Spec
-tests nc dispatcher = describe "API" $ do
+tests nc dispatcher = describe "Gargantext API" $ do
  Auth.tests
  Private.tests
  GraphQL.tests

--- a/test/Test/API/Prelude.hs
+++ b/test/Test/API/Prelude.hs
@@ -5,10 +5,13 @@ module Test.API.Prelude
  , newPrivateFolderForUser
  , newPublicFolderForUser
  , getRootPublicFolderIdForUser
+  , getRootPrivateFolderIdForUser
+  , myUserNodeId
  , checkEither
  , shouldFailWith
  ) where
+import Data.Aeson qualified as JSON
 import Data.Text qualified as T
 import Gargantext.API.Errors
 import Gargantext.Core.Types.Individu
@@ -17,6 +20,7 @@ import Gargantext.Core.Types (NodeType(..))
 import Gargantext.Database.Action.User
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus
 import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Query.Table.Node.User (getUserByName)
 import Gargantext.Database.Query.Tree.Root
 import Gargantext.Database.Schema.Node (_node_id)
 import Gargantext.Prelude hiding (get)
@@ -24,7 +28,6 @@ import Prelude (fail)
 import Servant.Client.Core
 import Test.Database.Types
 import Test.Tasty.HUnit (Assertion, (@?=))
-import qualified Data.Aeson as JSON
 checkEither :: (Show a, Monad m) => m (Either a b) -> m b
 checkEither = fmap (either (\x -> panicTrace $ "checkEither:" <> T.pack (show x)) identity)
@@ -57,6 +60,14 @@ getRootPublicFolderIdForUser :: TestEnv -> User -> IO NodeId
 getRootPublicFolderIdForUser env uname = flip runReaderT env $ runTestMonad $ do
  _node_id <$> (getUserId uname >>= getUserRootPublicNode)
+getRootPrivateFolderIdForUser :: TestEnv -> User -> IO NodeId
+getRootPrivateFolderIdForUser env uname = flip runReaderT env $ runTestMonad $ do
+  _node_id <$> (getUserId uname >>= getUserRootPrivateNode)
+myUserNodeId :: TestEnv -> T.Text -> IO NodeId
+myUserNodeId env uname = flip runReaderT env $ runTestMonad $ do
+  _node_id <$> getUserByName uname
 shouldFailWith :: Show a => Either ClientError a -> BackendErrorCode -> Assertion
 action `shouldFailWith` backendError = case action of
  Right{} -> fail "Expected action to fail, but it didn't."

--- a/test/Test/API/Private.hs
+++ b/test/Test/API/Private.hs
@@ -7,20 +7,22 @@ module Test.API.Private (
    tests
  ) where
+import Gargantext.API.Errors
 import Gargantext.API.Routes.Named.Node
 import Gargantext.API.Routes.Named.Private
+import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu
-import Gargantext.Core.Types (Node)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
 import Gargantext.Prelude hiding (get)
 import Network.HTTP.Client hiding (Proxy)
 import Servant.Auth.Client ()
 import Servant.Client
 import Servant.Client.Generic (genericClient)
+import Test.API.Prelude
 import Test.API.Private.Move  qualified as Move
 import Test.API.Private.Share qualified as Share
 import Test.API.Private.Table qualified as Table
-import Test.API.Routes (mkUrl)
+import Test.API.Routes
 import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
 import Test.Hspec
 import Test.Hspec.Wai hiding (pendingWith)
@@ -28,19 +30,22 @@ import Test.Hspec.Wai.Internal (withApplication)
 import Test.Hspec.Wai.JSON (json)
 import Test.Utils (protected, shouldRespondWithFragment, withValidLogin)
-privateTests :: SpecWith (SpecContext a)
+nodeTests :: Spec
-privateTests =
+nodeTests = sequential $ aroundAll withTestDBAndPort $ do
-  describe "Private API" $ do
+  describe "Prelude" $ do
    baseUrl <- runIO $ parseBaseUrl "http://localhost"
    manager <- runIO $ newManager defaultManagerSettings
    let unauthenticatedClientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port })
+    it "setup DB triggers" $ \SpecContext{..} -> do
+      setupEnvironment _sctx_env
+      -- Let's create the Alice user.
+      void $ createAliceAndBob _sctx_env
    describe "GET /api/v1.0/user" $ do
      -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
-      it "doesn't allow someone with an invalid token to show the results" $ \(SpecContext testEnv port _ _) -> do
+      it "doesn't allow someone with an invalid token to show the results" $ \(SpecContext _testEnv port _ _) -> do
-        void $ createAliceAndBob testEnv
        let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM))
            admin_user_api_get = (getRootsEp . rootsEp $ gargAdminClient :: ClientM [Node HyperdataUser])
@@ -72,8 +77,10 @@ privateTests =
      it "forbids 'alice' to see others node private info" $ \(SpecContext _testEnv port app _) -> do
        withApplication app $ do
-          withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
+          withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
-            protected token "GET" (mkUrl port "/node/1") "" `shouldRespondWith` 403
+            liftIO $ do
+              res <- runClientM (get_node token (UnsafeMkNodeId 1)) clientEnv
+              res `shouldFailWith` EC_403__policy_check_error
    describe "GET /api/v1.0/tree" $ do
      it "unauthorised users shouldn't see anything" $ \(SpecContext _testEnv port app _) -> do
@@ -88,16 +95,16 @@ privateTests =
      it "forbids 'alice' to see others node private info" $ \(SpecContext _testEnv port app _) -> do
        withApplication app $ do
-          withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
+          withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
-            protected token "GET" (mkUrl port "/tree/1") "" `shouldRespondWith` 403
+            liftIO $ do
+              res <- runClientM (get_tree token (UnsafeMkNodeId 1)) clientEnv
+              res `shouldFailWith` EC_403__policy_check_error
 tests :: Spec
 tests = do
-  sequential $ aroundAll withTestDBAndPort $ do
+  describe "Private API" $ do
-    describe "Prelude" $ do
+    nodeTests
-      it "setup DB triggers" $ \SpecContext{..} -> setupEnvironment _sctx_env
-    privateTests
  describe "Share API" $ do
    Share.tests
  describe "Table API" $ do

--- a/test/Test/API/Private/Move.hs
+++ b/test/Test/API/Private/Move.hs
@@ -6,42 +6,21 @@ module Test.API.Private.Move (
    tests
  ) where
-import Control.Lens
 import Gargantext.API.Errors
-import Gargantext.API.Routes.Named
-import Gargantext.API.Routes.Named.Node (moveAPI, moveNodeEp)
-import Gargantext.API.Routes.Named.Private
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Query.Table.NodeNode (SourceId(..), TargetId(..))
 import Gargantext.Prelude
-import Servant.Auth.Client qualified as SC
 import Servant.Client
-import Test.API.Prelude (newCorpusForUser, getRootPublicFolderIdForUser, checkEither, shouldFailWith)
+import Test.API.Prelude
 import Test.API.Routes
 import Test.API.Setup
-import Test.Hspec
+import Test.Hspec (Spec, it, aroundAll, describe, sequential)
 import Test.Hspec.Wai.Internal (withApplication)
+import Test.Hspec.Expectations.Lifted
+import Test.Tasty.HUnit (assertBool)
 import Test.Utils
-moveNodeFromTo :: SC.Token -> SourceId -> TargetId -> ClientM [NodeId]
-moveNodeFromTo token (SourceId sourceId) (TargetId targetId) = fmap (map UnsafeMkNodeId) $
-  clientRoutes & apiWithCustomErrorScheme
-               & ($ GES_new)
-               & backendAPI
-               & backendAPI'
-               & mkBackEndAPI
-               & gargAPIVersion
-               & gargPrivateAPI
-               & mkPrivateAPI
-               & ($ token)
-               & nodeEp
-               & nodeEndpointAPI
-               & ($ sourceId)
-               & moveAPI
-               & moveNodeEp
-               & ($ targetId)
 tests :: Spec
 tests = sequential $ aroundAll withTestDBAndPort $ do
  describe "Prelude" $ do
@@ -58,8 +37,8 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
            liftIO $ do
              cId <- newCorpusForUser testEnv "alice"
              bobPublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "bob")
-              res <- runClientM (moveNodeFromTo (toServantToken token) (SourceId bobPublicFolderId) (TargetId cId)) clientEnv
+              res <- runClientM (move_node token (SourceId cId) (TargetId bobPublicFolderId)) clientEnv
-              res `shouldFailWith` EC_500__internal_server_error
+              res `shouldFailWith` EC_403__policy_check_error
      it "should allow moving a corpus node into Alice Public folder" $ \(SpecContext testEnv serverPort app _) -> do
        withApplication app $ do
@@ -67,5 +46,39 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
            nodes <- liftIO $ do
              cId <- newCorpusForUser testEnv "alice"
              alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice")
-              checkEither $ runClientM (moveNodeFromTo (toServantToken token) (SourceId alicePublicFolderId) (TargetId cId)) clientEnv
+              checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
            liftIO $ length nodes `shouldBe` 1
+      it "should allow Alice to unpublish a corpus" $ \(SpecContext testEnv serverPort app _) -> do
+        withApplication app $ do
+          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
+            nodes <- liftIO $ do
+              cId <- newCorpusForUser testEnv "alice"
+              alicePublicFolderId  <- getRootPublicFolderIdForUser testEnv (UserName "alice")
+              alicePrivateFolderId <- getRootPrivateFolderIdForUser testEnv (UserName "alice")
+              _     <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
+              checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePrivateFolderId)) clientEnv
+            length nodes `shouldBe` 1
+      it "should allow Bob to see Alice's published corpuses" $ \(SpecContext testEnv serverPort app _) -> do
+        withApplication app $ do
+          aliceCorpusId <- withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
+            liftIO $ do
+              cId <- newCorpusForUser testEnv "alice"
+              alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice")
+              _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
+              -- Check that we can see the folder
+              aliceNodeId <- myUserNodeId testEnv "alice"
+              tree <- checkEither $ runClientM (get_tree token aliceNodeId) clientEnv
+              assertBool "alice can't see her own corpus" (containsNode cId tree)
+              pure cId
+          withValidLogin serverPort "bob" (GargPassword "bob") $ \clientEnv token -> do
+            tree <- liftIO $ do
+              bobNodeId <- myUserNodeId testEnv "bob"
+              checkEither $ runClientM (get_tree token bobNodeId) clientEnv
+            containsNode aliceCorpusId tree `shouldBe` True
+containsNode :: NodeId -> Tree NodeTree -> Bool
+containsNode target (TreeN r c) = _nt_id r == target || any (containsNode target) c
--- a/test/Test/API/Routes.hs
+++ b/test/Test/API/Routes.hs
-{-# LANGUAGE InstanceSigs    #-}
+{-# LANGUAGE InstanceSigs         #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ViewPatterns         #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{--| Collection of ready-to-use servant-client functions to use in all our specs. -}
-module Test.API.Routes where
+module Test.API.Routes (
+  -- * Constants and helpers
+    curApi
+  , mkUrl
+  , gqlUrl
+  , toServantToken
+  , clientRoutes
+  -- * Servant client functions
+  , auth_api
+  , get_children
+  , get_node
+  , get_table
+  , get_table_ngrams
+  , get_tree
+  , move_node
+  , put_table_ngrams
+  , update_node
+  ) where
 import Data.Text.Encoding qualified as TE
 import Fmt (Builder, (+|), (|+))
@@ -13,16 +34,17 @@ import Gargantext.API.Errors
 import Gargantext.API.HashedResponse (HashedResponse)
 import Gargantext.API.Ngrams.Types ( NgramsTable, NgramsTablePatch, OrderBy, TabType, Versioned, VersionedWithCount )
 import Gargantext.API.Routes.Named
-import Gargantext.API.Routes.Named.Node
+import Gargantext.API.Routes.Named.Node hiding (treeAPI)
 import Gargantext.API.Routes.Named.Private hiding (tableNgramsAPI)
 import Gargantext.API.Routes.Named.Table
+import Gargantext.API.Routes.Named.Tree (nodeTreeEp)
 import Gargantext.API.Types () -- MimeUnrender instances
 import Gargantext.Core.Text.Corpus.Query (RawQuery)
-import Gargantext.Core.Types (ListId, NodeId, NodeType, NodeTableResult)
+import Gargantext.Core.Types
-import Gargantext.Core.Types.Main (ListType)
 import Gargantext.Core.Types.Query (Limit, MaxSize, MinSize, Offset)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Query.Facet qualified as Facet
+import Gargantext.Database.Query.Table.NodeNode (SourceId(..), TargetId(..))
 import Gargantext.Prelude
 import Network.HTTP.Types qualified as H
 import Network.Wai.Handler.Warp (Port)
@@ -41,12 +63,11 @@ instance RunClient m => HasClient m WS.WebSocketPending where
  clientWithRoute :: Proxy m -> Proxy WS.WebSocketPending -> Request -> Client m WS.WebSocketPending
  clientWithRoute _pm Proxy _req _httpMethod = do
    panicTrace "[WebSocket client] this is not implemented!"
-    return ()
  hoistClientMonad _ _ f cl = \meth -> f (cl meth)
-- This is for requests made by http.client directly to hand-crafted URLs    
+-- This is for requests made by http.client directly to hand-crafted URLs.
 curApi :: Builder
 curApi = "v1.0"
@@ -77,6 +98,25 @@ auth_api = clientRoutes & apiWithCustomErrorScheme
 toServantToken :: Token -> S.Token
 toServantToken = S.Token . TE.encodeUtf8
+get_node :: Token
+         -> NodeId
+         -> ClientM (Node HyperdataAny)
+get_node (toServantToken -> token) nodeId =
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & nodeEp
+               & nodeEndpointAPI
+               & ($ nodeId)
+               & nodeNodeAPI
+               & getNodeEp
 update_node :: Token
            -> NodeId
            -> UpdateNodeParams
@@ -198,3 +238,36 @@ get_children (toServantToken -> token) nodeId =
               & childrenAPI
               & summaryChildrenEp
+get_tree :: Token -> NodeId -> ClientM (Tree NodeTree)
+get_tree (toServantToken -> token) nId = do
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & treeAPI
+               & ($ nId)
+               & nodeTreeEp
+               & ($ [])
+move_node :: Token -> SourceId -> TargetId -> ClientM [NodeId]
+move_node (toServantToken -> token) (SourceId sourceId) (TargetId targetId) = fmap (map UnsafeMkNodeId) $
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & nodeEp
+               & nodeEndpointAPI
+               & ($ sourceId)
+               & moveAPI
+               & moveNodeEp
+               & ($ targetId)
--- a/test/Test/API/Setup.hs
+++ b/test/Test/API/Setup.hs
@@ -6,6 +6,7 @@ module Test.API.Setup (
  , withTestDBAndPort
  , withTestDBAndNotifications
  , withBackendServerAndProxy
+  , testWithApplicationOnPort
  , setupEnvironment
  , createAliceAndBob
  ) where

--- a/test/Test/Instances.hs
+++ b/test/Test/Instances.hs
@@ -266,9 +266,9 @@ genFrontendErr be = do
      -> do userId <- arbitrary
            roots  <- arbitrary
            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_user_too_many_roots userId roots)
-    Errors.EC_404__node_lookup_failed_user_no_public_folder
+    Errors.EC_404__node_lookup_failed_user_no_folder
      -> do userId <- arbitrary
-            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_user_no_public_folder userId)
+            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_user_no_folder userId)
    Errors.EC_404__node_context_not_found
      -> do contextId <- arbitrary
            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_context_not_found contextId)
@@ -300,6 +300,10 @@ genFrontendErr be = do
            chain <- listOf1 genValChain
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_validation_error (T.pack $ fromMaybe "unknown_validation_error" $ prettyValidation $ Validation chain)
+    -- policy check error
+    Errors.EC_403__policy_check_error
+      -> pure $ Errors.mkFrontendErr' txt $ Errors.FE_policy_check_error (T.pack "failed policy check.")
    -- authentication error
    Errors.EC_403__login_failed_error
      -> do nid <- arbitrary