Start adding move within shared folder tests

hie.yaml

@@ -42,6 +42,9 @@ cradle:
     - path: "./bin/gargantext-cli/CLI/Phylo/Profile.hs"
       component: "gargantext:exe:gargantext"
 
+    - path: "./bin/gargantext-cli/CLI/Server.hs"
+      component: "gargantext:exe:gargantext"
+
     - path: "./bin/gargantext-cli/CLI/Server/Routes.hs"
       component: "gargantext:exe:gargantext"
 
@@ -51,13 +54,10 @@ cradle:
     - path: "./bin/gargantext-cli/CLI/Upgrade.hs"
       component: "gargantext:exe:gargantext"
 
-    - path: "./bin/gargantext-cli/Paths_gargantext.hs"
-      component: "gargantext:exe:gargantext"
-
-    - path: "./bin/gargantext-server/Main.hs"
+    - path: "./bin/gargantext-cli/CLI/Worker.hs"
       component: "gargantext:exe:gargantext"
 
-    - path: "./bin/gargantext-server/Paths_gargantext.hs"
+    - path: "./bin/gargantext-cli/Paths_gargantext.hs"
       component: "gargantext:exe:gargantext"
 
     - path: "./test"

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

@@ -36,6 +36,7 @@ module Gargantext.Database.Query.Table.Node
   , getParentId
   , getUserRootPublicNode
   , getUserRootPrivateNode
+  , getUserRootShareNode
   , selectNode
 
   -- * Boolean queries
@@ -463,6 +464,11 @@ getUserRootPrivateNode :: (HasNodeError err, HasDBid NodeType)
                        -> DBCmd err (Node HyperdataFolder)
 getUserRootPrivateNode = get_user_root_node_folder NodeFolderPrivate
 
+getUserRootShareNode :: (HasNodeError err, HasDBid NodeType)
+                     => UserId
+                     -> DBCmd err (Node HyperdataFolder)
+getUserRootShareNode = get_user_root_node_folder NodeFolderShared
+
 get_user_root_node_folder :: (HasNodeError err, HasDBid NodeType)
                           => NodeType
                           -> UserId

test/Test/API/Prelude.hs

@@ -4,13 +4,20 @@ module Test.API.Prelude
   ( newCorpusForUser
   , newPrivateFolderForUser
   , newPublicFolderForUser
+  , newShareFolderForUser
   , newFolderForUser
   , addFolderForUser
   , getRootPublicFolderIdForUser
   , getRootPrivateFolderIdForUser
+  , getRootShareFolderIdForUser
+  , newTeamWithOwner
   , myUserNodeId
   , checkEither
   , shouldFailWith
+
+  -- User fixtures
+  , alice
+  , bob
   ) where
 
 import Data.Aeson qualified as JSON
@@ -62,26 +69,28 @@ addFolderForUser :: TestEnv
 addFolderForUser env ur folderName parentId = flip runReaderT env $ runTestMonad $ do
   newFolderForUser' ur folderName parentId
 
-newFolderForUser :: TestEnv -> T.Text -> T.Text -> IO NodeId
+newFolderForUser :: TestEnv -> User -> T.Text -> IO NodeId
 newFolderForUser env uname folderName = flip runReaderT env $ runTestMonad $ do
-  parentId <- getRootId (UserName uname)
-  newFolderForUser' (UserName uname) folderName parentId
+  parentId <- getRootId uname
+  newFolderForUser' uname folderName parentId
 
 -- | 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
-newPrivateFolderForUser env uname = flip runReaderT env $ runTestMonad $ do
-  uid      <- getUserId (UserName uname)
-  parentId <- getRootId (UserName uname)
-  let nodeName = "NodeFolderPrivate"
-  insertNode NodeFolderPrivate (Just nodeName) Nothing parentId uid
+newPrivateFolderForUser :: TestEnv -> User -> IO NodeId
+newPrivateFolderForUser env ur = newFolder env ur NodeFolderPrivate
 
-newPublicFolderForUser :: TestEnv -> T.Text -> IO NodeId
-newPublicFolderForUser env uname = flip runReaderT env $ runTestMonad $ do
-  uid      <- getUserId (UserName uname)
-  parentId <- getRootId (UserName uname)
-  let nodeName = "NodeFolderPublic"
-  insertNode NodeFolderPublic (Just nodeName) Nothing parentId uid
+newPublicFolderForUser :: TestEnv -> User -> IO NodeId
+newPublicFolderForUser env ur = newFolder env ur NodeFolderPublic
+
+newShareFolderForUser :: TestEnv -> User -> IO NodeId
+newShareFolderForUser env ur = newFolder env ur NodeFolderShared
+
+newFolder :: TestEnv -> User -> NodeType -> IO NodeId
+newFolder env ur nt = flip runReaderT env $ runTestMonad $ do
+  let nodeName = show nt
+  uid      <- getUserId ur
+  parentId <- getRootId ur
+  insertNode nt (Just nodeName) Nothing parentId uid
 
 getRootPublicFolderIdForUser :: TestEnv -> User -> IO NodeId
 getRootPublicFolderIdForUser env uname = flip runReaderT env $ runTestMonad $ do
@@ -91,6 +100,16 @@ getRootPrivateFolderIdForUser :: TestEnv -> User -> IO NodeId
 getRootPrivateFolderIdForUser env uname = flip runReaderT env $ runTestMonad $ do
   _node_id <$> (getUserId uname >>= getUserRootPrivateNode)
 
+getRootShareFolderIdForUser :: TestEnv -> User -> IO NodeId
+getRootShareFolderIdForUser env uname = flip runReaderT env $ runTestMonad $ do
+  _node_id <$> (getUserId uname >>= getUserRootShareNode)
+
+newTeamWithOwner :: TestEnv -> User -> T.Text -> IO NodeId
+newTeamWithOwner env uname teamName = flip runReaderT env $ runTestMonad $ do
+  uid      <- getUserId uname
+  parentId <- liftIO $ getRootShareFolderIdForUser env uname
+  insertNode NodeTeam (Just teamName) Nothing parentId uid
+
 myUserNodeId :: TestEnv -> T.Text -> IO NodeId
 myUserNodeId env uname = flip runReaderT env $ runTestMonad $ do
   _node_id <$> getUserByName uname
@@ -104,3 +123,9 @@ action `shouldFailWith` backendError = case action of
     | otherwise
     -> fail $ "FailureResponse didn't have FrontendError: " <> show fr
   _xs -> fail $ "Unexpected ClientError: " <> show _xs
+
+alice :: User
+alice = UserName "alice"
+
+bob :: User
+bob = UserName "bob"

test/Test/API/Private/Move.hs

@@ -36,9 +36,22 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
         it "should allow moving one folder into another" $ \(SpecContext testEnv serverPort app _) -> do
           withApplication app $ do
             withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> liftIO $ do
-              aliceRoot <- getRootPrivateFolderIdForUser testEnv (UserName "alice")
-              child1    <- addFolderForUser testEnv (UserName "alice") "child1" aliceRoot
-              child2    <- addFolderForUser testEnv (UserName "alice") "child2" aliceRoot
+              aliceRoot <- getRootPrivateFolderIdForUser testEnv alice
+              child1    <- addFolderForUser testEnv alice "child1" aliceRoot
+              child2    <- addFolderForUser testEnv alice "child2" aliceRoot
+              -- Test that moving child1 into child2 works.
+              res <- checkEither $ runClientM (move_node token (SourceId child2) (TargetId child1)) clientEnv
+              res `shouldBe` [child2]
+
+      describe "share to share moves" $ do
+        it "should allow moving one folder into another (as team owner)" $ \(SpecContext testEnv serverPort app _) -> do
+          withApplication app $ do
+            withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> liftIO $ do
+              -- Let's create (once) the shared team folder
+              void $ newShareFolderForUser testEnv alice
+              teamNode  <- newTeamWithOwner testEnv alice "Alice's Team"
+              child1    <- addFolderForUser testEnv alice "child1" teamNode
+              child2    <- addFolderForUser testEnv alice "child2" teamNode
               -- Test that moving child1 into child2 works.
               res <- checkEither $ runClientM (move_node token (SourceId child2) (TargetId child1)) clientEnv
               res `shouldBe` [child2]
@@ -50,7 +63,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
           withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
             liftIO $ do
               cId <- newCorpusForUser testEnv "alice"
-              bobPublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "bob")
+              bobPublicFolderId <- getRootPublicFolderIdForUser testEnv bob
               res <- runClientM (move_node token (SourceId cId) (TargetId bobPublicFolderId)) clientEnv
               res `shouldFailWith` EC_403__policy_check_error
 
@@ -59,7 +72,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
           withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
             nodes <- liftIO $ do
               cId <- newCorpusForUser testEnv "alice"
-              alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice")
+              alicePublicFolderId <- getRootPublicFolderIdForUser testEnv alice
               checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
             liftIO $ length nodes `shouldBe` 1
 
@@ -68,8 +81,8 @@ tests = sequential $ aroundAll withTestDBAndPort $ 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")
+              alicePublicFolderId  <- getRootPublicFolderIdForUser testEnv alice
+              alicePrivateFolderId <- getRootPrivateFolderIdForUser testEnv 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
@@ -79,7 +92,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
           aliceCorpusId <- withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
             liftIO $ do
               cId <- newCorpusForUser testEnv "alice"
-              alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice")
+              alicePublicFolderId <- getRootPublicFolderIdForUser testEnv alice
               _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
 
               -- Check that we can see the folder
@@ -99,7 +112,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
           aliceCorpusId <- withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
             liftIO $ do
               cId <- newCorpusForUser testEnv "alice"
-              alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice")
+              alicePublicFolderId <- getRootPublicFolderIdForUser testEnv alice
               _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
 
               -- Check that we can see the folder
@@ -117,7 +130,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
           -- Now alice moves the node back to her private folder, effectively unpublishing it.
           withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
             liftIO $ do
-              alicePrivateFolderId <- getRootPrivateFolderIdForUser testEnv (UserName "alice")
+              alicePrivateFolderId <- getRootPrivateFolderIdForUser testEnv alice
               void $ checkEither $ runClientM (move_node token (SourceId aliceCorpusId) (TargetId alicePrivateFolderId)) clientEnv
 
           withValidLogin serverPort "bob" (GargPassword "bob") $ \clientEnv token -> do
@@ -132,7 +145,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
           withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
             liftIO $ do
               cId <- newCorpusForUser testEnv "alice"
-              alicePublicFolderId  <- getRootPublicFolderIdForUser testEnv (UserName "alice")
+              alicePublicFolderId  <- getRootPublicFolderIdForUser testEnv alice
               _     <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
 
               -- Trying to delete a strictly published node should fail
@@ -143,9 +156,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ 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")
+              fId   <- newFolderForUser testEnv alice "my-test-folder"
+              fId'' <- newPrivateFolderForUser testEnv alice
+              alicePublicFolderId  <- getRootPublicFolderIdForUser testEnv alice
 
               res <- runClientM (move_node token (SourceId fId) (TargetId alicePublicFolderId)) clientEnv
               res `shouldFailWith` EC_403__node_move_error

test/Test/API/Private/Remote.hs

@@ -84,7 +84,7 @@ tests = sequential $ aroundAll withTwoServerInstances $ do
       it "forbids transferring certain node types" $ \(SpecContext testEnv1 server1Port app1 (_testEnv2, _app2, server2Port)) -> do
         withApplication app1 $ do
           withValidLogin server1Port "alice" (GargPassword "alice") $ \aliceClientEnv aliceToken -> do
-            folderId <- liftIO $ newPrivateFolderForUser testEnv1 "alice"
+            folderId <- liftIO $ newPrivateFolderForUser testEnv1 alice
             withValidLogin server2Port "bob" (GargPassword "bob") $ \_bobClientEnv bobToken -> do
               liftIO $ do
                 let rq = RemoteExportRequest { _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"

test/Test/API/UpdateList.hs

@@ -66,7 +66,7 @@ import Paths_gargantext (getDataFileName)
 import qualified Prelude
 import Servant.Client.Streaming
 import System.FilePath
-import Test.API.Prelude (checkEither, newCorpusForUser, newPrivateFolderForUser)
+import Test.API.Prelude (checkEither, newCorpusForUser, newPrivateFolderForUser, alice)
 import Test.API.Routes (mkUrl, gqlUrl, get_table_ngrams, put_table_ngrams, toServantToken, clientRoutes, get_table, update_node, add_form_to_list, add_tsv_to_list)
 import Test.API.Setup (withTestDBAndPort, dbEnvSetup, SpecContext (..))
 import Test.Database.Types
@@ -349,7 +349,7 @@ createDocsList :: FilePath
                -> Token
                -> WaiSession () CorpusId
 createDocsList testDataPath testEnv port clientEnv token = do
-  folderId <- liftIO $ newPrivateFolderForUser testEnv "alice"
+  folderId <- liftIO $ newPrivateFolderForUser testEnv alice
   ([corpusId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build folderId)) [aesonQQ|{"pn_typename":"NodeCorpus","pn_name":"TestCorpus"}|]
   -- Import the docsList with only two documents, both containing a \"fortran\" term.
   simpleDocs <- liftIO (TIO.readFile =<< getDataFileName testDataPath)

test/Test/Database/Operations/PublishNode.hs

@@ -24,7 +24,7 @@ import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Database.Schema.Node (NodePoly(..))
-import Test.API.Prelude (newPrivateFolderForUser, newPublicFolderForUser)
+import Test.API.Prelude (newPrivateFolderForUser, newPublicFolderForUser, alice)
 import Test.Database.Types
 import Test.Tasty.HUnit
 
@@ -43,8 +43,8 @@ testGetUserRootPublicNode testEnv = do
 
 testIsReadOnlyWorks :: TestEnv -> Assertion
 testIsReadOnlyWorks testEnv = do
-  alicePrivateFolderId <- newPrivateFolderForUser testEnv "alice"
-  alicePublicFolderId  <- newPublicFolderForUser testEnv "alice"
+  alicePrivateFolderId <- newPrivateFolderForUser testEnv alice
+  alicePublicFolderId  <- newPublicFolderForUser testEnv alice
   flip runReaderT testEnv $ runTestMonad $ do
     -- Create a corpus, by default is not read only
     aliceUserId <- getUserId (UserName "alice")
@@ -64,8 +64,8 @@ testIsReadOnlyWorks testEnv = do
 -- then all the children (up to the first level) are also marked read-only.
 testPublishRecursiveFirstLevel :: TestEnv -> Assertion
 testPublishRecursiveFirstLevel testEnv = do
-  alicePrivateFolderId <- newPrivateFolderForUser testEnv "alice"
-  alicePublicFolderId  <- newPublicFolderForUser testEnv "alice"
+  alicePrivateFolderId <- newPrivateFolderForUser testEnv alice
+  alicePublicFolderId  <- newPublicFolderForUser testEnv alice
   flip runReaderT testEnv $ runTestMonad $ do
     -- Create a corpus, by default is not read only
     aliceUserId    <- getUserId (UserName "alice")
@@ -81,8 +81,8 @@ testPublishRecursiveFirstLevel testEnv = do
 -- then all the children of the children are also marked read-only.
 testPublishRecursiveNLevel :: TestEnv -> Assertion
 testPublishRecursiveNLevel testEnv = do
-  alicePrivateFolderId <- newPrivateFolderForUser testEnv "alice"
-  alicePublicFolderId  <- newPublicFolderForUser testEnv "alice"
+  alicePrivateFolderId <- newPrivateFolderForUser testEnv alice
+  alicePublicFolderId  <- newPublicFolderForUser testEnv alice
   flip runReaderT testEnv $ runTestMonad $ do
     -- Create a corpus, by default is not read only
     aliceUserId    <- getUserId (UserName "alice")
@@ -98,8 +98,8 @@ testPublishRecursiveNLevel testEnv = do
 
 testPublishLenientWorks :: TestEnv -> Assertion
 testPublishLenientWorks testEnv = do
-  alicePrivateFolderId <- newPrivateFolderForUser testEnv "alice"
-  alicePublicFolderId  <- newPublicFolderForUser testEnv "alice"
+  alicePrivateFolderId <- newPrivateFolderForUser testEnv alice
+  alicePublicFolderId  <- newPublicFolderForUser testEnv alice
   flip runReaderT testEnv $ runTestMonad $ do
     aliceUserId <- getUserId (UserName "alice")
     corpusId    <- insertDefaultNode NodeCorpus alicePrivateFolderId aliceUserId