Implement /publish endpoint

gargantext.cabal

@@ -156,6 +156,7 @@ library
       Gargantext.API.Routes.Named.Node
       Gargantext.API.Routes.Named.Private
       Gargantext.API.Routes.Named.Public
+      Gargantext.API.Routes.Named.Publish
       Gargantext.API.Routes.Named.Search
       Gargantext.API.Routes.Named.Share
       Gargantext.API.Routes.Named.Table

src/Gargantext/API/Auth/PolicyCheck.hs

@@ -20,6 +20,7 @@ module Gargantext.API.Auth.PolicyCheck (
   , nodePublishedRead
   , nodePublishedEdit
   , moveChecks
+  , publishChecks
   , userMe
   , alwaysAllow
   , alwaysDeny
@@ -256,6 +257,10 @@ moveChecks (SourceId sourceId) (TargetId targetId) =
   BAnd (nodeUser sourceId `BOr` nodeSuper sourceId)
        (nodeUser targetId `BOr` nodeUser targetId)
 
+publishChecks :: NodeId -> BoolExpr AccessCheck
+publishChecks nodeId =
+  (nodeUser nodeId `BOr` nodeSuper nodeId)
+
 alwaysAllow :: BoolExpr AccessCheck
 alwaysAllow = BConst . Positive $ AC_always_allow
 

src/Gargantext/API/Node.hs

@@ -31,7 +31,7 @@ module Gargantext.API.Node
 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 ( nodeReadChecks, nodeWriteChecks, moveChecks, AccessPolicyManager )
+import Gargantext.API.Auth.PolicyCheck ( nodeReadChecks, nodeWriteChecks, moveChecks, AccessPolicyManager, publishChecks )
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams.Types (TabType(..))
@@ -47,6 +47,7 @@ import Gargantext.API.Prelude ( GargM, GargServer, IsGargServer )
 import Gargantext.API.Routes.Named.File qualified as Named
 import Gargantext.API.Routes.Named.Node qualified as Named
 import Gargantext.API.Routes.Named.Private qualified as Named
+import Gargantext.API.Routes.Named.Publish qualified as Named
 import Gargantext.API.Routes.Named.Share qualified as Named
 import Gargantext.API.Search qualified as Search
 import Gargantext.API.Server.Named.Ngrams (apiNgramsTableCorpus)
@@ -62,7 +63,7 @@ import Gargantext.Database.Prelude (Cmd, JSONB)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Children (getChildren)
 import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
-import Gargantext.Database.Query.Table.Node.Update qualified as U (update, Update(..))
+import Gargantext.Database.Query.Table.Node.Update qualified as U (update, Update(..), publish)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Table.NodeContext (nodeContextsCategory, nodeContextsScore)
 import Gargantext.Database.Query.Table.NodeNode
@@ -248,6 +249,9 @@ genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
   , scoreAPI           = Named.ScoreAPI $ scoreApi targetNode
   , searchAPI          = Search.api targetNode
   , shareAPI           = Named.ShareNode $ Share.api userRootId targetNode
+  , unshareEp          = Share.unShare targetNode
+  , publishAPI         = withNamedPolicyT authenticatedUser (publishChecks targetNode) $
+                           Named.PublishAPI $ \Named.PublishRequest{pubrq_policy} -> U.publish loggedInUserId targetNode pubrq_policy
   ---- Pairing utilities
   , pairWithEp         = pairWith targetNode
   , pairsEp            = pairs targetNode
@@ -261,7 +265,6 @@ genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
   , moveAPI            = Named.MoveAPI $ \parentId ->
                            withPolicy authenticatedUser (moveChecks (SourceId targetNode) (TargetId parentId)) $
                              moveNode loggedInUserId targetNode parentId
-  , unshareEp          = Share.unShare targetNode
   , fileAPI            = Named.FileAPI $ fileApi targetNode
   , fileAsyncAPI       = fileAsyncApi authenticatedUser targetNode
   , dfwnAPI            = DFWN.api authenticatedUser targetNode

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

@@ -28,25 +28,26 @@ module Gargantext.API.Routes.Named.Node (
   , UpdateNodeParams(..)
   ) where
 
-import GHC.Generics
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Auth.PolicyCheck ( PolicyChecked )
 import Gargantext.API.Ngrams.Types (TabType(..))
+import Gargantext.API.Node.New.Types ( PostNode(..) )
+import Gargantext.API.Node.Types ( RenameNode(..), NodesToScore(..), NodesToCategory(..) )
+import Gargantext.API.Node.Update.Types ( UpdateNodeParams(..), Charts(..), Granularity(..), Method(..) )
 import Gargantext.API.Routes.Named.Document
 import Gargantext.API.Routes.Named.File
 import Gargantext.API.Routes.Named.FrameCalc
 import Gargantext.API.Routes.Named.Metrics
-import Gargantext.API.Routes.Named.Viz
+import Gargantext.API.Routes.Named.Publish (PublishAPI)
 import Gargantext.API.Routes.Named.Search
 import Gargantext.API.Routes.Named.Share as Share
 import Gargantext.API.Routes.Named.Table
-import Gargantext.API.Node.Types ( RenameNode(..), NodesToScore(..), NodesToCategory(..) )
-import Gargantext.API.Node.New.Types ( PostNode(..) )
-import Gargantext.API.Node.Update.Types ( UpdateNodeParams(..), Charts(..), Granularity(..), Method(..) )
+import Gargantext.API.Routes.Named.Viz
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Query
 import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
 import Gargantext.Database.Query.Facet.Types ( FacetDoc, OrderBy(..) )
+import GHC.Generics
 import Prelude
 import Servant
 
@@ -82,6 +83,7 @@ data NodeAPI a mode = NodeAPI
   , searchAPI          :: mode :- "search" :> NamedRoutes (SearchAPI SearchResult)
   , shareAPI           :: mode :- "share" :> NamedRoutes ShareNode
   , unshareEp          :: mode :- "unshare" :> NamedRoutes Share.UnshareNode
+  , publishAPI         :: mode :- "publish" :> (PolicyChecked (NamedRoutes PublishAPI))
   ---- Pairing utilities
   , pairWithEp         :: mode :- "pairwith" :> NamedRoutes PairWith
   , pairsEp            :: mode :- "pairs"    :> NamedRoutes Pairs

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

+{-# LANGUAGE TypeOperators #-}
+
+module Gargantext.API.Routes.Named.Publish (
+    PublishRequest(..)
+  , PublishAPI(..)
+  ) where
+
+import Data.Aeson as JS
+import Data.Swagger
+import Gargantext.Database.Query.Table.NodeNode (NodePublishPolicy)
+import GHC.Generics (Generic)
+import Prelude
+import Servant
+import Test.QuickCheck
+
+newtype PublishRequest = PublishRequest
+  { pubrq_policy :: NodePublishPolicy
+  } deriving (Show, Eq, Generic)
+
+instance ToSchema PublishRequest
+
+instance ToJSON PublishRequest where
+  toJSON (PublishRequest pol) =
+    JS.object [ "policy" JS..= toJSON pol ]
+
+instance FromJSON PublishRequest where
+  parseJSON = withObject "PublishRequest" $ \o -> do
+    pubrq_policy <- o JS..: "policy"
+    pure $ PublishRequest{..}
+
+instance Arbitrary PublishRequest where
+  arbitrary = PublishRequest <$> arbitraryBoundedEnum
+
+newtype PublishAPI mode = PublishAPI
+  { publishEp :: mode :- Summary "Publish a Corpus Node"
+                      :> ReqBody '[JSON] PublishRequest
+                      :> Delete '[JSON] Int
+  } deriving Generic

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

@@ -13,6 +13,7 @@ Portability : POSIX
 module Gargantext.Database.Query.Table.Node.Update (
     Update(..)
   , update
+  , publish
   )
   where
 
@@ -72,7 +73,7 @@ update loggedInUserId (Move sourceId targetId) = do
           -> -- both are not read-only, normal move
              move_db_update sourceId targetId
         (False, True)
-          -> publish_node (SourceId sourceId) (TargetId targetId) NPP_publish_no_edits_allowed
+          -> (:[]) <$> publish_node (SourceId sourceId) (TargetId targetId) NPP_publish_no_edits_allowed
         (True, False)
           -> -- the source is read only. If we are the owner we allow unpublishing.
              -- FIXME(adn) is this check enough?
@@ -92,7 +93,12 @@ update loggedInUserId (Move sourceId targetId) = do
 
       pure ids
 
-publish_node :: HasNodeError err => SourceId -> TargetId -> NodePublishPolicy -> Cmd err [Int]
+publish :: HasNodeError err => UserId -> NodeId -> NodePublishPolicy -> Cmd err Int
+publish loggedInUserId sourceId policy = do
+  targetId <- _node_id <$> getUserRootPublicNode loggedInUserId
+  publish_node (SourceId sourceId) (TargetId targetId) policy
+
+publish_node :: HasNodeError err => SourceId -> TargetId -> NodePublishPolicy -> Cmd err Int
 publish_node (SourceId sourceId) (TargetId targetId) policy = do
   sourceNode <- getNode sourceId
   targetNode <- getNode targetId
@@ -109,7 +115,7 @@ publish_node (SourceId sourceId) (TargetId targetId) policy = do
      -- way by disallowing further edits on the original node,
      -- including edits from the owner itself!
      publishNode policy (SourceId sourceId) (TargetId targetId)
-     pure [ _NodeId $ sourceId]
+     pure (_NodeId $ sourceId)
    _ -> nodeError (NodeIsReadOnly targetId "Target is read only, but not a public folder.")
 
 

test/Test/API/Private/Move.hs

@@ -139,5 +139,20 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
               res' <- runClientM (move_node token (SourceId fId'') (TargetId alicePublicFolderId)) clientEnv
               res' `shouldFailWith` EC_403__node_move_error
 
+      it "allows publishing via the /publish endpoint" $ \(SpecContext testEnv serverPort app _) -> do
+        withApplication app $ do
+          aliceCorpusId <- withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
+            liftIO $ do
+
+              cId <- newCorpusForUser testEnv "alice"
+              void $ runClientM (publish_node token cId NPP_publish_no_edits_allowed) clientEnv
+              pure cId
+          -- bob should be able to see it
+          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

test/Test/API/Routes.hs

@@ -22,6 +22,7 @@ module Test.API.Routes (
   , get_table_ngrams
   , get_tree
   , move_node
+  , publish_node
   , put_table_ngrams
   , update_node
   , delete_node
@@ -37,6 +38,7 @@ import Gargantext.API.Ngrams.Types ( NgramsTable, NgramsTablePatch, OrderBy, Tab
 import Gargantext.API.Routes.Named
 import Gargantext.API.Routes.Named.Node hiding (treeAPI)
 import Gargantext.API.Routes.Named.Private hiding (tableNgramsAPI)
+import Gargantext.API.Routes.Named.Publish (PublishRequest(..))
 import Gargantext.API.Routes.Named.Table
 import Gargantext.API.Routes.Named.Tree (nodeTreeEp)
 import Gargantext.API.Types () -- MimeUnrender instances
@@ -56,6 +58,7 @@ import Servant.Client (ClientM)
 import Servant.Client.Core (RunClient, HasClient(..), Request)
 import Servant.Client.Generic ( genericClient, AsClientT )
 import Servant.Job.Async
+import Gargantext.API.Routes.Named.Publish (PublishAPI(..))
 
 
 instance RunClient m => HasClient m WS.WebSocketPending where
@@ -290,3 +293,21 @@ delete_node (toServantToken -> token) nodeId =
                & nodeEndpointAPI
                & ($ nodeId)
                & deleteEp
+
+publish_node :: Token -> NodeId -> NodePublishPolicy -> ClientM NodeId
+publish_node (toServantToken -> token) sourceId policy = fmap UnsafeMkNodeId $
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & nodeEp
+               & nodeEndpointAPI
+               & ($ sourceId)
+               & publishAPI
+               & publishEp
+               & ($ PublishRequest policy)

test/Test/Offline/JSON.hs

@@ -6,15 +6,16 @@
 module Test.Offline.JSON (tests) where
 
 import Data.Aeson
-import Data.ByteString qualified as B
 import Data.ByteString.Lazy.Char8 qualified as C8
+import Data.ByteString qualified as B
 import Data.Either
 import Gargantext.API.Errors
 import Gargantext.API.Node.Corpus.Types
 import Gargantext.API.Node.Types
+import Gargantext.API.Routes.Named.Publish (PublishRequest)
 import Gargantext.API.Viz.Types
 import Gargantext.Core.Types.Phylo
-import qualified Gargantext.Core.Viz.Phylo as VizPhylo
+import Gargantext.Core.Viz.Phylo qualified as VizPhylo
 import Gargantext.Database.Admin.Types.Node
 import Paths_gargantext
 import Prelude
@@ -50,10 +51,11 @@ jsonFrontendErrorRoundtrip = conjoin $ map mk_prop [minBound .. maxBound]
 
 tests :: TestTree
 tests = testGroup "JSON" [
-    testProperty "NodeId roundtrips"        (jsonRoundtrip @NodeId)
-  , testProperty "RootId roundtrips"        (jsonRoundtrip @RootId)
-  , testProperty "Datafield roundtrips"     (jsonRoundtrip @Datafield)
-  , testProperty "WithQuery roundtrips"     (jsonRoundtrip @WithQuery)
+    testProperty "NodeId roundtrips"         (jsonRoundtrip @NodeId)
+  , testProperty "RootId roundtrips"         (jsonRoundtrip @RootId)
+  , testProperty "Datafield roundtrips"      (jsonRoundtrip @Datafield)
+  , testProperty "WithQuery roundtrips"      (jsonRoundtrip @WithQuery)
+  , testProperty "PublishRequest roundtrips" (jsonRoundtrip @PublishRequest)
   , testProperty "FrontendError roundtrips" jsonFrontendErrorRoundtrip
   , testProperty "BackendErrorCode roundtrips" (jsonEnumRoundtrip (Dict @_ @BackendErrorCode))
   , testProperty "NodeType roundtrips"      (jsonEnumRoundtrip (Dict @_ @NodeType))