Enforce policy for published nodes for read/write

This commit splits the policy checks we do on node operations into
"read" checks and "write" checks, so that we can enforce different kind
of policies based on the state of a node (i.e. published or not).

src/Gargantext/API/Auth/PolicyCheck.hs

@@ -15,8 +15,10 @@ module Gargantext.API.Auth.PolicyCheck (
   , nodeDescendant
   , nodeSuper
   , nodeUser
-  , nodeChecks
-  , nodePublished
+  , nodeReadChecks
+  , nodeWriteChecks
+  , nodePublishedRead
+  , nodePublishedEdit
   , moveChecks
   , userMe
   , alwaysAllow
@@ -25,7 +27,9 @@ module Gargantext.API.Auth.PolicyCheck (
 
 import Control.Lens (view)
 import Data.BoolExpr (BoolExpr(..), Signed(..))
+import Data.Text qualified as T
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
+import Gargantext.API.Errors (BackendInternalError)
 import Gargantext.API.Errors.Types (AccessPolicyErrorReason(..))
 import Gargantext.Core.Config (GargConfig(..), HasConfig(hasConfig))
 import Gargantext.Core.Config.Types (SecretsConfig(..))
@@ -33,9 +37,11 @@ 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.Node (getNode)
 import Gargantext.Database.Query.Table.NodeNode
-import Gargantext.Database.Query.Tree (isDescendantOf, isOwnedBy, isSharedWith)
+import Gargantext.Database.Query.Tree (isDescendantOf, isOwnedBy, isSharedWith, lookupPublishPolicy)
 import Gargantext.Database.Query.Tree.Root (getRootId)
+import Gargantext.Database.Schema.Node (node_user_id)
 import Gargantext.Prelude
 import Servant.API.Routes (HasRoutes(getRoutes))
 import Servant.Auth.Server.Internal.AddSetCookie (AddSetCookieApi, AddSetCookies(..), Nat(S))
@@ -45,7 +51,6 @@ import Servant (HasServer(..), ServerT)
 import Servant.Server.Internal.Delayed (addParameterCheck)
 import Servant.Server.Internal.DelayedIO (DelayedIO(..))
 import Servant.Swagger qualified as Swagger
-import Gargantext.API.Errors (BackendInternalError)
 
 -------------------------------------------------------------------------------
 -- Types
@@ -60,6 +65,7 @@ data AccessResult
     Allow
     -- | Denies access with the given 'ServerError'.
   | Deny AccessPolicyErrorReason
+  deriving Show
 
 instance Semigroup AccessResult where
   Allow <> Allow        = Allow
@@ -83,8 +89,10 @@ 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 read access if the input 'NodeId' is published.
+  | AC_node_published_read   !NodeId
+    -- | Grants edit access if the input 'NodeId' is published.
+  | AC_node_published_edit   !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.
@@ -152,15 +160,38 @@ check' (AuthenticatedUser loggedUserNodeId loggedUserUserId) = \case
     -> enforce nodeNotDescendant =<< nodeId `isDescendantOf` loggedUserNodeId
   AC_node_shared nodeId
     -> enforce nodeNotShared =<< nodeId `isSharedWith` loggedUserNodeId
-  AC_node_published nodeId
+  AC_node_published_read nodeId
     -> enforce nodeNotShared =<< isNodeReadOnly nodeId
+  AC_node_published_edit nodeId
+    -> do
+      mb_pp <- lookupPublishPolicy nodeId
+      targetNode <- getNode nodeId
+      let allowedOrNot = do
+            case mb_pp of
+              Nothing -> pure Allow
+              Just NPP_publish_no_edits_allowed
+                -> throwError not_editable
+              Just NPP_publish_edits_only_owner_or_super
+                -> enforce (nodeNotShared' not_editable) (targetNode ^. node_user_id == loggedUserUserId)
+      case allowedOrNot of
+        Left err -> enforce (nodeNotShared' err) False
+        Right _  -> pure Allow
 
 -------------------------------------------------------------------------------
 -- Errors
 -------------------------------------------------------------------------------
 
 nodeNotShared :: AccessPolicyErrorReason
-nodeNotShared = AccessPolicyErrorReason "Node is not shared with user."
+nodeNotShared = nodeNotShared' not_shared_with_user
+
+not_shared_with_user :: T.Text
+not_shared_with_user = "Node is not published or shared with user."
+
+not_editable :: T.Text
+not_editable = "Node is published and not editable by anyone."
+
+nodeNotShared' :: T.Text -> AccessPolicyErrorReason
+nodeNotShared' = AccessPolicyErrorReason
 
 nodeNotDescendant :: AccessPolicyErrorReason
 nodeNotDescendant = AccessPolicyErrorReason "Node is not a direct descendant."
@@ -187,16 +218,34 @@ 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
+nodePublishedRead :: NodeId -> BoolExpr AccessCheck
+nodePublishedRead = BConst . Positive . AC_node_published_read
+
+nodePublishedEdit :: NodeId -> BoolExpr AccessCheck
+nodePublishedEdit = BConst . Positive . AC_node_published_edit
 
-nodeChecks :: NodeId -> BoolExpr AccessCheck
-nodeChecks nid =
+nodeReadChecks :: NodeId -> BoolExpr AccessCheck
+nodeReadChecks nid =
   nodeUser nid  `BOr`
   nodeSuper nid `BOr`
   nodeDescendant nid `BOr`
   nodeShared nid `BOr`
-  nodePublished nid
+  nodePublishedRead nid
+
+-- | A user can edit a node iff:
+-- * The node is not published or Is published, but using a policy that allows modifications
+-- /OR/
+-- * The user is the owner
+-- * The user is a super
+-- * The node has been shared with the user
+-- * The node is a discendant (adn: really needed?)
+nodeWriteChecks :: NodeId -> BoolExpr AccessCheck
+nodeWriteChecks nid =
+  (nodeUser nid  `BOr`
+   nodeSuper nid `BOr`
+   nodeDescendant nid `BOr`
+   nodeShared nid
+  ) `BAnd` nodePublishedEdit nid
 
 -- | A user can move a node from source to target only
 -- if:

src/Gargantext/API/GraphQL/Node.hs

@@ -18,7 +18,7 @@ import Data.Aeson ( Result(..), Value(..) )
 import Data.Aeson.KeyMap qualified as KM
 import Data.Morpheus.Types ( GQLType )
 import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser )
-import Gargantext.API.Auth.PolicyCheck ( nodeChecks, AccessPolicyManager )
+import Gargantext.API.Auth.PolicyCheck ( nodeReadChecks, AccessPolicyManager )
 import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
 import Gargantext.API.GraphQL.Types ( GqlM )
 import Gargantext.Core ( HasDBid(lookupDBid) )
@@ -63,7 +63,7 @@ resolveNodes
   -> NodeArgs
   -> GqlM e env [Node]
 resolveNodes autUser mgr NodeArgs { node_id } =
-  withPolicy autUser mgr (nodeChecks $ NN.UnsafeMkNodeId node_id) $ dbNodes node_id
+  withPolicy autUser mgr (nodeReadChecks $ NN.UnsafeMkNodeId node_id) $ dbNodes node_id
 
 resolveNodesCorpus
   :: (CmdCommon env)

src/Gargantext/API/GraphQL/TreeFirstLevel.hs

@@ -16,7 +16,7 @@ module Gargantext.API.GraphQL.TreeFirstLevel where
 
 import Data.Morpheus.Types (GQLType)
 import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser(..) )
-import Gargantext.API.Auth.PolicyCheck (AccessPolicyManager, nodeChecks)
+import Gargantext.API.Auth.PolicyCheck (AccessPolicyManager, nodeReadChecks)
 import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
 import Gargantext.API.GraphQL.Types ( GqlM )
 import Gargantext.Core (fromDBid)
@@ -71,7 +71,7 @@ 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 (_auth_user_id autUser) root_id
+  withPolicy autUser mgr (nodeReadChecks $ UnsafeMkNodeId root_id) $ dbTree (_auth_user_id autUser) root_id
 
 dbTree :: (CmdCommon env) =>
           NN.UserId -> Int -> GqlM e env (TreeFirstLevel (GqlM e env))

src/Gargantext/API/GraphQL/User.hs

@@ -67,7 +67,7 @@ resolveUsers
   -> GqlM e env [User (GqlM e env)]
 resolveUsers autUser mgr UserArgs { user_id } = do
   -- We are given the /node id/ of the logged-in user.
-  withPolicy autUser mgr (nodeChecks $ UnsafeMkNodeId user_id) $ dbUsers user_id
+  withPolicy autUser mgr (nodeReadChecks $ UnsafeMkNodeId user_id) $ dbUsers user_id
 
 -- | Inner function to fetch the user from DB.
 dbUsers :: (CmdCommon env)

src/Gargantext/API/Node.hs

@@ -28,10 +28,10 @@ Node API
 module Gargantext.API.Node
   where
 
-import Gargantext.API.Admin.Auth (withNamedAccess, withNamedPolicyT, withPolicy)
+import Gargantext.API.Admin.Auth (withNamedAccess, withNamedPolicyT, withPolicy, withPolicy)
 import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser (..), auth_node_id, auth_user_id)
 import Gargantext.API.Admin.EnvTypes (Env)
-import Gargantext.API.Auth.PolicyCheck ( nodeChecks, moveChecks, AccessPolicyManager )
+import Gargantext.API.Auth.PolicyCheck ( nodeReadChecks, nodeWriteChecks, moveChecks, AccessPolicyManager )
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams.Types (TabType(..))
@@ -166,7 +166,7 @@ treeAPI :: IsGargServer env BackendInternalError m
         -> AccessPolicyManager
         -> Named.NodeTreeAPI (AsServerT m)
 treeAPI authenticatedUser nodeId mgr =
-  withNamedPolicyT authenticatedUser (nodeChecks nodeId) (Named.NodeTreeAPI
+  withNamedPolicyT authenticatedUser (nodeReadChecks nodeId) (Named.NodeTreeAPI
     { nodeTreeEp   = tree (_auth_user_id authenticatedUser) TreeAdvanced nodeId
     , firstLevelEp = tree (_auth_user_id authenticatedUser) TreeFirstLevel nodeId
     }) mgr
@@ -227,15 +227,20 @@ genericNodeAPI' :: forall a proxy. ( HyperdataC a )
                 -> NodeId
                 -> Named.NodeAPI a (AsServerT (GargM Env BackendInternalError))
 genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
-  { nodeNodeAPI        = withNamedPolicyT authenticatedUser (nodeChecks targetNode) $
+  { nodeNodeAPI        = withNamedPolicyT authenticatedUser (nodeReadChecks targetNode) $
                            Named.NodeNodeAPI $ getNodeWith targetNode (Proxy :: Proxy a)
-  , renameAPI          = Named.RenameAPI   $ rename loggedInUserId targetNode
-  , postNodeAPI        = Named.PostNodeAPI $ postNode authenticatedUser targetNode
-  , postNodeAsyncAPI   = postNodeAsyncAPI authenticatedUser targetNode
+  , renameAPI          = withNamedPolicyT authenticatedUser (nodeWriteChecks targetNode) $
+                           Named.RenameAPI   $ rename loggedInUserId targetNode
+  , postNodeAPI        = withNamedPolicyT authenticatedUser (nodeWriteChecks targetNode) $
+                           Named.PostNodeAPI $ postNode authenticatedUser targetNode
+  , postNodeAsyncAPI   = withNamedPolicyT authenticatedUser (nodeWriteChecks targetNode) $
+                           postNodeAsyncAPI authenticatedUser targetNode
   , frameCalcUploadAPI = FrameCalcUpload.api authenticatedUser targetNode
   , putEp              = putNode targetNode
-  , updateAPI          = Update.api targetNode
-  , deleteEp           = Action.deleteNode userRootId targetNode
+  , updateAPI          = withNamedPolicyT authenticatedUser (nodeWriteChecks targetNode) $
+                           Update.api targetNode
+  , deleteEp           = withPolicy authenticatedUser (nodeWriteChecks targetNode) $
+                           Action.deleteNode userRootId targetNode
   , childrenAPI        = Named.ChildrenAPI $ getChildren targetNode (Proxy :: Proxy a)
   , tableAPI           = tableApi targetNode
   , tableNgramsAPI     = apiNgramsTableCorpus targetNode

src/Gargantext/API/Routes/Named/Node.hs

@@ -67,13 +67,13 @@ import Servant
 
 data NodeAPI a mode = NodeAPI
   { nodeNodeAPI        :: mode :- PolicyChecked (NamedRoutes (NodeNodeAPI a))
-  , renameAPI          :: mode :- "rename" :> NamedRoutes RenameAPI
-  , postNodeAPI        :: mode :- NamedRoutes PostNodeAPI -- TODO move to children POST
-  , postNodeAsyncAPI   :: mode :- NamedRoutes PostNodeAsyncAPI
+  , renameAPI          :: mode :- "rename" :> PolicyChecked (NamedRoutes RenameAPI)
+  , postNodeAPI        :: mode :- PolicyChecked (NamedRoutes PostNodeAPI) -- TODO move to children POST
+  , postNodeAsyncAPI   :: mode :- PolicyChecked (NamedRoutes PostNodeAsyncAPI)
   , frameCalcUploadAPI :: mode :- NamedRoutes FrameCalcAPI
   , putEp              :: mode :- ReqBody '[JSON] a :> Put '[JSON] Int
-  , updateAPI          :: mode :- "update" :> NamedRoutes UpdateAPI
-  , deleteEp           :: mode :- Delete '[JSON] Int
+  , updateAPI          :: mode :- "update" :> PolicyChecked (NamedRoutes UpdateAPI)
+  , deleteEp           :: mode :- PolicyChecked (Delete '[JSON] Int)
   , childrenAPI        :: mode :- "children"  :> NamedRoutes (ChildrenAPI a)
   , tableAPI           :: mode :- "table" :> NamedRoutes TableAPI
   , tableNgramsAPI     :: mode :- "ngrams" :> NamedRoutes TableNgramsAPI

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

@@ -27,6 +27,7 @@ module Gargantext.Database.Query.Table.NodeNode
 
   -- * Queries
   , getNodeNode
+  , getNodeNode2
   , isNodeReadOnly
   , selectDocNodes
   , selectDocs
@@ -85,6 +86,15 @@ getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
       restrict -< _nn_node1_id ns .== n'
       returnA -< ns
 
+getNodeNode2 :: NodeId -> DBCmd err (Maybe NodeNode)
+getNodeNode2 n = listToMaybe <$> runOpaQuery (selectNodeNode $ pgNodeId n)
+  where
+    selectNodeNode :: Column SqlInt4 -> Select NodeNodeRead
+    selectNodeNode n' = proc () -> do
+      ns <- queryNodeNodeTable -< ()
+      restrict -< _nn_node2_id ns .== n'
+      returnA -< ns
+
 ------------------------------------------------------------------------
 -- TODO (refactor with Children)
 {-
@@ -260,18 +270,24 @@ selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb
 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 
 publishedNodeIds :: DBCmd err [(SourceId, TargetId, OwnerId)]
-publishedNodeIds = map (\(owner, nn) -> (SourceId $ _nn_node2_id nn, TargetId $ _nn_node1_id nn, OwnerId owner)) <$> do_query
+publishedNodeIds =
+  map (\(owner, nn) -> (SourceId $ _nn_node2_id nn, TargetId $ _nn_node1_id nn, OwnerId owner)) <$> published_node_ids []
+
+published_node_ids :: [ NodeNodeRead -> Field SqlBool ] -> DBCmd err [(NodeId, NodeNode)]
+published_node_ids extraPreds = runOpaQuery $ do
+  n  <- queryNodeTable
+  nn <- queryNodeNodeTable
+  let isRO = ors [ (nn ^. nn_category .== sqlInt4 (toDBid $ NNC_publish ro))
+                 | ro <- [minBound .. maxBound]
+                 ]
+  where_ isRO
+  where_ $ (n ^. node_id .== nn ^. nn_node1_id)
+  where_ $ ands (map ($ nn) extraPreds)
+  pure (n ^. node_parent_id, nn)
   where
-    do_query :: DBCmd err [(NodeId, NodeNode)]
-    do_query = runOpaQuery $ do
-      n  <- queryNodeTable
-      nn <- queryNodeNodeTable
-      let isRO = ors [ (nn ^. nn_category .== sqlInt4 (toDBid $ NNC_publish ro))
-                     | ro <- [minBound .. maxBound]
-                     ]
-      where_ isRO
-      where_ $ (n ^. node_id .== nn ^. nn_node1_id)
-      pure (n ^. node_parent_id, nn)
+
+ands :: Foldable f => f (Field SqlBool) -> Field SqlBool
+ands = foldl' (.&&) (sqlBool True)
 
 -- | 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)

src/Gargantext/Database/Query/Tree.hs

@@ -41,6 +41,8 @@ module Gargantext.Database.Query.Tree
   , dbTree
   , updateTree
   , recursiveParents
+
+  , lookupPublishPolicy
   )
   where
 
@@ -60,12 +62,11 @@ import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (runPGSQuery, DBCmd)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node (getNode)
-import Gargantext.Database.Query.Table.NodeNode (getNodeNode, publishedNodeIds, SourceId (..), TargetId (..), OwnerId(..))
+import Gargantext.Database.Query.Table.Node (getUserRootPublicNode)
+import Gargantext.Database.Query.Table.NodeNode
 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
@@ -484,3 +485,38 @@ recursiveParents nodeId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId t
       [] -> allNodeTypes
       _  -> nodeTypes
 -----------------------------------------------------
+
+-- | Given an input 'NodeId', figures out if the node itself or
+-- a parent is published and, if yes, returns the original publish policy.
+-- NOTE(adn) This query is not very optimised, and once it starts to become slow,
+-- we need to rewrite it as a plain PG query to make it fast.
+lookupPublishPolicy :: HasNodeError err => NodeId -> DBCmd err (Maybe NodePublishPolicy)
+lookupPublishPolicy targetId = do
+  -- Optimisation: if the 'targetId' ends up being one of the published \"root\" node_node,
+  -- short-circuit.
+  mb_nn <- getNodeNode2 targetId
+  case lookupPublish mb_nn of
+    Just pol -> pure $ Just pol
+    Nothing -> do
+      isRO <- isNodeReadOnly targetId
+      case isRO of
+        False -> pure Nothing
+        True  -> do
+          -- General case: find all the recursive parents for the target id, and for each of them
+          -- check if they are read only; if yes, grab their 'NodePublishPolicy'
+          allParents <- recursiveParents targetId []
+          go Nothing allParents
+  where
+
+    lookupPublish mb_nn = mb_nn >>= \nn -> nn L.^? (nn_category . _Just . _NNC_publish)
+
+    go !acc [] = pure acc
+    go !acc (x:xs) = do
+      isRO <- isNodeReadOnly (_dt_nodeId x)
+      case isRO of
+        True  -> do
+          mb_nn <- getNodeNode2 (_dt_nodeId x)
+          case lookupPublish mb_nn of
+            Just pol -> pure $ Just pol
+            Nothing  -> go acc xs
+        False -> go acc xs

src/Gargantext/Database/Schema/NodeNode.hs

@@ -34,9 +34,13 @@ module Gargantext.Database.Schema.NodeNode (
   , nn_score
   , nn_category
 
+  -- * Prisms
+  , _NNC_publish
+
   , nodeNodeTable
   ) where
 
+import Control.Lens.TH
 import Gargantext.Core (HasDBid(..))
 import Gargantext.Core.Types
 import Gargantext.Database.Schema.Prelude
@@ -96,6 +100,7 @@ type NodeNode = NodeNodePoly NodeId NodeId (Maybe Double) (Maybe NodeNodeCategor
 
 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
 makeLenses ''NodeNodePoly
+makePrisms ''NodeNodeCategory
 
 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
 nodeNodeTable  =

test/Test/API/Private/Move.hs

@@ -80,5 +80,17 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
               checkEither $ runClientM (get_tree token bobNodeId) clientEnv
             containsNode aliceCorpusId tree `shouldBe` True
 
+      it "shouldn't allow Alice to modify a (strictly) published node even if owner" $ \(SpecContext testEnv serverPort app _) -> do
+        withApplication app $ do
+          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
+
+              -- Trying to delete a strictly published node should fail
+              res <- runClientM (delete_node token cId) clientEnv
+              res `shouldFailWith` EC_403__policy_check_error
+
 containsNode :: NodeId -> Tree NodeTree -> Bool
 containsNode target (TreeN r c) = _nt_id r == target || any (containsNode target) c

test/Test/API/Routes.hs

@@ -24,6 +24,7 @@ module Test.API.Routes (
   , move_node
   , put_table_ngrams
   , update_node
+  , delete_node
   ) where
 
 import Data.Text.Encoding qualified as TE
@@ -271,3 +272,21 @@ move_node (toServantToken -> token) (SourceId sourceId) (TargetId targetId) = fm
                & moveAPI
                & moveNodeEp
                & ($ targetId)
+
+delete_node :: Token
+            -> NodeId
+            -> ClientM Int
+delete_node (toServantToken -> token) nodeId =
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & nodeEp
+               & nodeEndpointAPI
+               & ($ nodeId)
+               & deleteEp

test/Test/Database/Operations.hs

@@ -74,6 +74,7 @@ tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
       it "Correctly detects if a node is read only"  testIsReadOnlyWorks
       it "Publishes the root and its first level children"  testPublishRecursiveFirstLevel
       it "Publishes the root and its recursive children"  testPublishRecursiveNLevel
+      it "Publishes in a lenient way but it's still considered read-only"  testPublishLenientWorks
 
 nodeStoryTests :: Spec
 nodeStoryTests = sequential $

test/Test/Database/Operations/PublishNode.hs

@@ -32,6 +32,9 @@ import Test.Tasty.HUnit
 publishStrict :: SourceId -> TargetId -> DBCmd err ()
 publishStrict = publishNode NPP_publish_no_edits_allowed
 
+publishLenient :: SourceId -> TargetId -> DBCmd err ()
+publishLenient = publishNode NPP_publish_edits_only_owner_or_super
+
 testGetUserRootPublicNode :: TestEnv -> Assertion
 testGetUserRootPublicNode testEnv = do
   [aliceId, _bobId] <- createAliceAndBob testEnv
@@ -93,3 +96,13 @@ testPublishRecursiveNLevel testEnv = do
     isNodeReadOnly aliceFolderId    >>= liftIO . (@?= True)
     isNodeReadOnly aliceSubFolderId >>= liftIO . (@?= True)
     isNodeReadOnly corpusId         >>= liftIO . (@?= True)
+
+testPublishLenientWorks :: TestEnv -> Assertion
+testPublishLenientWorks testEnv = do
+  alicePrivateFolderId <- newPrivateFolderForUser testEnv "alice"
+  alicePublicFolderId  <- newPublicFolderForUser testEnv "alice"
+  flip runReaderT testEnv $ runTestMonad $ do
+    aliceUserId <- getUserId (UserName "alice")
+    corpusId    <- insertDefaultNode NodeCorpus alicePrivateFolderId aliceUserId
+    publishLenient (SourceId corpusId) (TargetId alicePublicFolderId)
+    isNodeReadOnly corpusId >>= liftIO . (@?= True)