Restrict what can be published to only corpus nodes

src/Gargantext/API/Errors.hs

@@ -174,6 +174,8 @@ nodeErrorToFrontendError ne = case ne of
     -> mkFrontendErrShow $ FE_node_generic_exception (T.pack $ displayException err)
   NodeIsReadOnly nodeId reason
     -> mkFrontendErrShow $ FE_node_is_read_only nodeId reason
+  MoveError sourceId targetId reason
+    -> mkFrontendErrShow $ FE_node_move_error sourceId targetId reason
 
   -- backward-compatibility shims, to remove eventually.
   DoesNotExist nid

src/Gargantext/API/Errors/Types.hs

@@ -260,6 +260,10 @@ data instance ToFrontendErrorData 'EC_403__node_is_read_only =
   FE_node_is_read_only { niro_node_id :: NodeId, niro_reason :: T.Text }
   deriving (Show, Eq, Generic)
 
+data instance ToFrontendErrorData 'EC_403__node_move_error =
+  FE_node_move_error { nme_source_id :: !NodeId, nme_target_id :: !NodeId, nme_reason :: !T.Text }
+  deriving (Show, Eq, Generic)
+
 --
 -- validation errors
 --
@@ -486,6 +490,16 @@ instance FromJSON (ToFrontendErrorData 'EC_403__node_is_read_only) where
     niro_reason  <- o .: "reason"
     pure FE_node_is_read_only{..}
 
+instance ToJSON (ToFrontendErrorData 'EC_403__node_move_error) where
+  toJSON FE_node_move_error{..} =
+    object [ "source_id" .= toJSON nme_source_id, "target_id" .= toJSON nme_target_id, "reason" .= toJSON nme_reason ]
+instance FromJSON (ToFrontendErrorData 'EC_403__node_move_error) where
+  parseJSON = withObject "FE_node_move_error" $ \o -> do
+    nme_source_id <- o .: "source_id"
+    nme_target_id <- o .: "target_id"
+    nme_reason  <- o .: "reason"
+    pure FE_node_move_error{..}
+
 --
 -- validation errors
 --
@@ -697,6 +711,9 @@ instance FromJSON FrontendError where
       EC_403__node_is_read_only -> do
         (fe_data :: ToFrontendErrorData 'EC_403__node_is_read_only) <- o .: "data"
         pure FrontendError{..}
+      EC_403__node_move_error -> do
+        (fe_data :: ToFrontendErrorData 'EC_403__node_move_error) <- o .: "data"
+        pure FrontendError{..}
 
       -- validation error
       EC_400__validation_error -> do

src/Gargantext/API/Errors/Types/Backend.hs

@@ -34,6 +34,7 @@ data BackendErrorCode
   | EC_500__node_generic_exception
   | EC_400__node_needs_configuration
   | EC_403__node_is_read_only
+  | EC_403__node_move_error
   -- validation errors
   | EC_400__validation_error
   -- policy check errors

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

@@ -84,6 +84,7 @@ data NodeError = NoListFound ListId
                -- Left for backward compatibility, but we should remove them.
                | DoesNotExist NodeId
                | NodeIsReadOnly NodeId T.Text
+               | MoveError NodeId NodeId T.Text
 
 instance Prelude.Show NodeError
   where
@@ -99,6 +100,7 @@ instance Prelude.Show NodeError
     show (NodeError e)      = "NodeError: " <> displayException e
     show (DoesNotExist n)   = "Node does not exist (" <> show n <> ")"
     show (NodeIsReadOnly n reason) = "Node " <> show n <> " is read only, edits not allowed. Reason: " <> T.unpack reason
+    show (MoveError s t reason) = "Moving " <> show s <> " to " <> show t <> " failed: " <> T.unpack reason
 
 instance ToJSON NodeError where
   toJSON (DoesNotExist n) =

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

+{-# LANGUAGE LambdaCase #-}
 {-|
 Module      : Gargantext.Database.Node.Update
 Description : Update Node in Database (Postgres)
@@ -78,6 +79,7 @@ update loggedInUserId u@(Move sourceId targetId) = do
              do case fromDBid $ _node_typename targetNode of
                  NodeFolderPublic
                    -> do
+                   check_publish_source_type_allowed (SourceId sourceId) (TargetId targetId) (fromDBid $ _node_typename sourceNode)
                    -- See issue #400, by default we publish in a \"strict\"
                    -- way by disallowing further edits on the original node,
                    -- including edits from the owner itself!
@@ -104,6 +106,13 @@ update loggedInUserId u@(Move sourceId targetId) = do
 
       pure ids
 
+-- Issue #400, for now we support only publishing corpus nodes
+check_publish_source_type_allowed :: HasNodeError err => SourceId -> TargetId -> NodeType -> Cmd err ()
+check_publish_source_type_allowed (SourceId nId) (TargetId tId) = \case
+  NodeCorpus   -> pure ()
+  NodeCorpusV3 -> pure ()
+  _            -> nodeError (MoveError nId tId "At the moment only corpus nodes can be published.")
+
 -- TODO-ACCESS
 update' :: Update -> DBCmd err [Int]
 update' (Rename nId name) = map unOnly <$> runPGSQuery "UPDATE nodes SET name=? where id=? returning id" (DT.take 255 name, nId)

test/Test/API/Prelude.hs

@@ -4,6 +4,7 @@ module Test.API.Prelude
   ( newCorpusForUser
   , newPrivateFolderForUser
   , newPublicFolderForUser
+  , newFolderForUser
   , getRootPublicFolderIdForUser
   , getRootPrivateFolderIdForUser
   , myUserNodeId
@@ -40,6 +41,12 @@ newCorpusForUser env uname = flip runReaderT env $ runTestMonad $ do
   (corpusId:_) <- mk (Just corpusName) (Nothing :: Maybe HyperdataCorpus) parentId uid
   pure corpusId
 
+newFolderForUser :: TestEnv -> T.Text -> T.Text -> IO NodeId
+newFolderForUser env uname folderName = flip runReaderT env $ runTestMonad $ do
+  uid      <- getUserId (UserName uname)
+  parentId <- getRootId (UserName uname)
+  insertNode NodeFolder (Just folderName) Nothing parentId uid
+
 -- | Generate a 'Node' where we can append more data into, a bit reminiscent to the
 -- \"Private\" root node we use in the real Gargantext.
 newPrivateFolderForUser :: TestEnv -> T.Text -> IO NodeId

test/Test/API/Private/Move.hs

@@ -92,5 +92,19 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
               res <- runClientM (delete_node token cId) clientEnv
               res `shouldFailWith` EC_403__policy_check_error
 
+      it "shouldn't allow publishing things which are not a node corpus" $ \(SpecContext testEnv serverPort app _) -> do
+        withApplication app $ do
+          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
+            liftIO $ do
+              fId   <- newFolderForUser testEnv "alice" "my-test-folder"
+              fId'' <- newPrivateFolderForUser testEnv "alice"
+              alicePublicFolderId  <- getRootPublicFolderIdForUser testEnv (UserName "alice")
+
+              res <- runClientM (move_node token (SourceId fId) (TargetId alicePublicFolderId)) clientEnv
+              res `shouldFailWith` EC_403__node_move_error
+
+              res' <- runClientM (move_node token (SourceId fId'') (TargetId alicePublicFolderId)) clientEnv
+              res' `shouldFailWith` EC_403__node_move_error
+
 containsNode :: NodeId -> Tree NodeTree -> Bool
 containsNode target (TreeN r c) = _nt_id r == target || any (containsNode target) c

test/Test/Instances.hs

@@ -293,6 +293,10 @@ genFrontendErr be = do
     Errors.EC_403__node_is_read_only
       -> do nId <- arbitrary
             pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_is_read_only nId "generic reason"
+    Errors.EC_403__node_move_error
+      -> do sId <- arbitrary
+            tId <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_move_error sId tId "generic reason"
 
     -- validation error
     Errors.EC_400__validation_error