Skip to content

haskell-gargantext
haskell-gargantext
Commit aa1dfda3 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli
Browse files
Options

Merge branch 'adinapoli/issue-455' into 'dev' 

Relax a bit moveChecks to account for shared nodes

Closes #455

See merge request !398
parents 0ab82ad5 92b6a44c
Pipeline #7480 passed with stages
          in 43 minutes and 30 seconds
          Hide whitespace changes
          Inline Side-by-side
          Showing with 168 additions and 47 deletions
          hie.yaml
          View file @ aa1dfda3
          ...@@ -42,6 +42,9 @@ cradle: ...@@ -42,6 +42,9 @@ cradle:
          - path: "./bin/gargantext-cli/CLI/Phylo/Profile.hs" - path: "./bin/gargantext-cli/CLI/Phylo/Profile.hs"
          component: "gargantext:exe:gargantext" component: "gargantext:exe:gargantext"
          - path: "./bin/gargantext-cli/CLI/Server.hs"
          component: "gargantext:exe:gargantext"
          - path: "./bin/gargantext-cli/CLI/Server/Routes.hs" - path: "./bin/gargantext-cli/CLI/Server/Routes.hs"
          component: "gargantext:exe:gargantext" component: "gargantext:exe:gargantext"
          ...@@ -51,13 +54,10 @@ cradle: ...@@ -51,13 +54,10 @@ cradle:
          - path: "./bin/gargantext-cli/CLI/Upgrade.hs" - path: "./bin/gargantext-cli/CLI/Upgrade.hs"
          component: "gargantext:exe:gargantext" component: "gargantext:exe:gargantext"
          - path: "./bin/gargantext-cli/Paths_gargantext.hs" - path: "./bin/gargantext-cli/CLI/Worker.hs"
          component: "gargantext:exe:gargantext"
          - path: "./bin/gargantext-server/Main.hs"
          component: "gargantext:exe:gargantext" component: "gargantext:exe:gargantext"
          - path: "./bin/gargantext-server/Paths_gargantext.hs" - path: "./bin/gargantext-cli/Paths_gargantext.hs"
          component: "gargantext:exe:gargantext" component: "gargantext:exe:gargantext"
          - path: "./test" - path: "./test"
          ......
          src/Gargantext/API/Auth/PolicyCheck.hs
          View file @ aa1dfda3
          ...@@ -266,10 +266,11 @@ nodeWriteChecks nid = ...@@ -266,10 +266,11 @@ nodeWriteChecks nid =
          -- if: -- if:
          -- * He/she is a super user -- * He/she is a super user
          -- * He/she owns the target or the source -- * He/she owns the target or the source
          -- * The node has been shared with the user
          moveChecks :: SourceId -> TargetId -> BoolExpr AccessCheck moveChecks :: SourceId -> TargetId -> BoolExpr AccessCheck
          moveChecks (SourceId sourceId) (TargetId targetId) = moveChecks (SourceId sourceId) (TargetId targetId) =
          BAnd (nodeUser sourceId `BOr` nodeSuper sourceId) BAnd (nodeUser sourceId `BOr` nodeSuper sourceId `BOr` nodeShared sourceId)
          (nodeUser targetId `BOr` nodeUser targetId) (nodeUser targetId `BOr` nodeUser targetId `BOr` nodeShared targetId)
          publishChecks :: NodeId -> BoolExpr AccessCheck publishChecks :: NodeId -> BoolExpr AccessCheck
          publishChecks nodeId = publishChecks nodeId =
          ......
          src/Gargantext/Database/Query/Table/Node.hs
          View file @ aa1dfda3
          ...@@ -36,6 +36,7 @@ module Gargantext.Database.Query.Table.Node ...@@ -36,6 +36,7 @@ module Gargantext.Database.Query.Table.Node
          , getParentId , getParentId
          , getUserRootPublicNode , getUserRootPublicNode
          , getUserRootPrivateNode , getUserRootPrivateNode
          , getUserRootShareNode
          , selectNode , selectNode
          -- * Boolean queries -- * Boolean queries
          ...@@ -463,6 +464,11 @@ getUserRootPrivateNode :: (HasNodeError err, HasDBid NodeType) ...@@ -463,6 +464,11 @@ getUserRootPrivateNode :: (HasNodeError err, HasDBid NodeType)
          -> DBCmd err (Node HyperdataFolder) -> DBCmd err (Node HyperdataFolder)
          getUserRootPrivateNode = get_user_root_node_folder NodeFolderPrivate 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) get_user_root_node_folder :: (HasNodeError err, HasDBid NodeType)
          => NodeType => NodeType
          -> UserId -> UserId
          ......
          test/Test/API/Prelude.hs
          View file @ aa1dfda3
          ...@@ -4,23 +4,33 @@ module Test.API.Prelude ...@@ -4,23 +4,33 @@ module Test.API.Prelude
          ( newCorpusForUser ( newCorpusForUser
          , newPrivateFolderForUser , newPrivateFolderForUser
          , newPublicFolderForUser , newPublicFolderForUser
          , newShareFolderForUser
          , newFolderForUser , newFolderForUser
          , addFolderForUser
          , getRootPublicFolderIdForUser , getRootPublicFolderIdForUser
          , getRootPrivateFolderIdForUser , getRootPrivateFolderIdForUser
          , getRootShareFolderIdForUser
          , newTeamWithOwner
          , myUserNodeId , myUserNodeId
          , checkEither , checkEither
          , shouldFailWith , shouldFailWith
          -- User fixtures
          , alice
          , bob
          ) where ) where
          import Data.Aeson qualified as JSON import Data.Aeson qualified as JSON
          import Data.Text qualified as T import Data.Text qualified as T
          import Gargantext.API.Errors import Gargantext.API.Errors
          import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
          import Gargantext.Core.Types (NodeId, NodeType(..)) import Gargantext.Core.Types (NodeId, NodeType(..), ParentId)
          import Gargantext.Core.Worker.Env () -- instance HasNodeError import Gargantext.Core.Worker.Env () -- instance HasNodeError
          import Gargantext.Database.Action.User import Gargantext.Database.Action.User
          import Gargantext.Database.Admin.Types.Hyperdata.Corpus import Gargantext.Database.Admin.Types.Hyperdata.Corpus
          import Gargantext.Database.Prelude
          import Gargantext.Database.Query.Table.Node import Gargantext.Database.Query.Table.Node
          import Gargantext.Database.Query.Table.Node.Error
          import Gargantext.Database.Query.Table.Node.User (getUserByName) import Gargantext.Database.Query.Table.Node.User (getUserByName)
          import Gargantext.Database.Query.Tree.Root import Gargantext.Database.Query.Tree.Root
          import Gargantext.Database.Schema.Node (_node_id) import Gargantext.Database.Schema.Node (_node_id)
          ...@@ -41,27 +51,46 @@ newCorpusForUser env uname = flip runReaderT env $ runTestMonad $ do ...@@ -41,27 +51,46 @@ newCorpusForUser env uname = flip runReaderT env $ runTestMonad $ do
          (corpusId:_) <- mk (Just corpusName) (Nothing :: Maybe HyperdataCorpus) parentId uid (corpusId:_) <- mk (Just corpusName) (Nothing :: Maybe HyperdataCorpus) parentId uid
          pure corpusId pure corpusId
          newFolderForUser :: TestEnv -> T.Text -> T.Text -> IO NodeId -- | Creates a new folder for the input user, nested under the given 'ParentId', if given.
          newFolderForUser env uname folderName = flip runReaderT env $ runTestMonad $ do newFolderForUser' :: HasNodeError err
          uid <- getUserId (UserName uname) => User
          parentId <- getRootId (UserName uname) -> T.Text
          -> ParentId
          -> DBCmd err NodeId
          newFolderForUser' ur folderName parentId = do
          uid <- getUserId ur
          insertNode NodeFolder (Just folderName) Nothing parentId uid insertNode NodeFolder (Just folderName) Nothing parentId uid
          addFolderForUser :: TestEnv
          -> User
          -> T.Text
          -> ParentId
          -> IO NodeId
          addFolderForUser env ur folderName parentId = flip runReaderT env $ runTestMonad $ do
          newFolderForUser' ur folderName parentId
          newFolderForUser :: TestEnv -> User -> T.Text -> IO NodeId
          newFolderForUser env uname folderName = flip runReaderT env $ runTestMonad $ do
          parentId <- getRootId uname
          newFolderForUser' uname folderName parentId
          -- | Generate a 'Node' where we can append more data into, a bit reminiscent to the -- | Generate a 'Node' where we can append more data into, a bit reminiscent to the
          -- \"Private\" root node we use in the real Gargantext. -- \"Private\" root node we use in the real Gargantext.
          newPrivateFolderForUser :: TestEnv -> T.Text -> IO NodeId newPrivateFolderForUser :: TestEnv -> User -> IO NodeId
          newPrivateFolderForUser env uname = flip runReaderT env $ runTestMonad $ do newPrivateFolderForUser env ur = newFolder env ur NodeFolderPrivate
          uid <- getUserId (UserName uname)
          parentId <- getRootId (UserName uname)
          let nodeName = "NodeFolderPrivate"
          insertNode NodeFolderPrivate (Just nodeName) Nothing parentId uid
          newPublicFolderForUser :: TestEnv -> T.Text -> IO NodeId newPublicFolderForUser :: TestEnv -> User -> IO NodeId
          newPublicFolderForUser env uname = flip runReaderT env $ runTestMonad $ do newPublicFolderForUser env ur = newFolder env ur NodeFolderPublic
          uid <- getUserId (UserName uname)
          parentId <- getRootId (UserName uname) newShareFolderForUser :: TestEnv -> User -> IO NodeId
          let nodeName = "NodeFolderPublic" newShareFolderForUser env ur = newFolder env ur NodeFolderShared
          insertNode NodeFolderPublic (Just nodeName) Nothing parentId uid
          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 :: TestEnv -> User -> IO NodeId
          getRootPublicFolderIdForUser env uname = flip runReaderT env $ runTestMonad $ do getRootPublicFolderIdForUser env uname = flip runReaderT env $ runTestMonad $ do
          ...@@ -71,6 +100,16 @@ getRootPrivateFolderIdForUser :: TestEnv -> User -> IO NodeId ...@@ -71,6 +100,16 @@ getRootPrivateFolderIdForUser :: TestEnv -> User -> IO NodeId
          getRootPrivateFolderIdForUser env uname = flip runReaderT env $ runTestMonad $ do getRootPrivateFolderIdForUser env uname = flip runReaderT env $ runTestMonad $ do
          _node_id <$> (getUserId uname >>= getUserRootPrivateNode) _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 :: TestEnv -> T.Text -> IO NodeId
          myUserNodeId env uname = flip runReaderT env $ runTestMonad $ do myUserNodeId env uname = flip runReaderT env $ runTestMonad $ do
          _node_id <$> getUserByName uname _node_id <$> getUserByName uname
          ...@@ -84,3 +123,9 @@ action `shouldFailWith` backendError = case action of ...@@ -84,3 +123,9 @@ action `shouldFailWith` backendError = case action of
          | otherwise | otherwise
          -> fail $ "FailureResponse didn't have FrontendError: " <> show fr -> fail $ "FailureResponse didn't have FrontendError: " <> show fr
          _xs -> fail $ "Unexpected ClientError: " <> show _xs _xs -> fail $ "Unexpected ClientError: " <> show _xs
          alice :: User
          alice = UserName "alice"
          bob :: User
          bob = UserName "bob"
          test/Test/API/Private/Move.hs
          View file @ aa1dfda3
          ...@@ -9,6 +9,7 @@ module Test.API.Private.Move ( ...@@ -9,6 +9,7 @@ module Test.API.Private.Move (
          import Gargantext.API.Errors import Gargantext.API.Errors
          import Gargantext.Core.Types import Gargantext.Core.Types
          import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
          import Gargantext.API.Node.Share.Types
          import Gargantext.Database.Query.Table.NodeNode (SourceId(..), TargetId(..)) import Gargantext.Database.Query.Table.NodeNode (SourceId(..), TargetId(..))
          import Gargantext.Prelude import Gargantext.Prelude
          import Servant.Client.Streaming import Servant.Client.Streaming
          ...@@ -29,6 +30,53 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -29,6 +30,53 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          -- Let's create the Alice user. -- Let's create the Alice user.
          void $ createAliceAndBob _sctx_env void $ createAliceAndBob _sctx_env
          describe "Moving a node" $ do
          describe "private to private moves" $ 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 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]
          it "should allow moving one folder into another (as team member)" $ \(SpecContext testEnv serverPort app _) -> do
          withApplication app $ do
          (teamNode, child1, child2) <- 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
          pure (teamNode, child1, child2)
          -- let's make bob a team member.
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> liftIO $ do
          let params = ShareTeamParams "bob"
          res <- checkEither $ runClientM (addTeamMember token teamNode params) clientEnv
          res `shouldBe` UnsafeMkNodeId 1
          withValidLogin serverPort "bob" (GargPassword "bob") $ \clientEnv token -> liftIO $ do
          -- Test that moving child1 into child2 works.
          res <- checkEither $ runClientM (move_node token (SourceId child2) (TargetId child1)) clientEnv
          res `shouldBe` [child2]
          describe "Publishing a Corpus" $ do describe "Publishing a Corpus" $ do
          it "should forbid moving a corpus node into another user Public folder" $ \(SpecContext testEnv serverPort app _) -> do it "should forbid moving a corpus node into another user Public folder" $ \(SpecContext testEnv serverPort app _) -> do
          ...@@ -36,7 +84,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -36,7 +84,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          liftIO $ do liftIO $ do
          cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
          bobPublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "bob") bobPublicFolderId <- getRootPublicFolderIdForUser testEnv bob
          res <- runClientM (move_node token (SourceId cId) (TargetId bobPublicFolderId)) clientEnv res <- runClientM (move_node token (SourceId cId) (TargetId bobPublicFolderId)) clientEnv
          res `shouldFailWith` EC_403__policy_check_error res `shouldFailWith` EC_403__policy_check_error
          ...@@ -45,7 +93,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -45,7 +93,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          nodes <- liftIO $ do nodes <- liftIO $ do
          cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
          alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice") alicePublicFolderId <- getRootPublicFolderIdForUser testEnv alice
          checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
          liftIO $ length nodes `shouldBe` 1 liftIO $ length nodes `shouldBe` 1
          ...@@ -54,8 +102,8 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -54,8 +102,8 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          nodes <- liftIO $ do nodes <- liftIO $ do
          cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
          alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice") alicePublicFolderId <- getRootPublicFolderIdForUser testEnv alice
          alicePrivateFolderId <- getRootPrivateFolderIdForUser testEnv (UserName "alice") alicePrivateFolderId <- getRootPrivateFolderIdForUser testEnv alice
          _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
          checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePrivateFolderId)) clientEnv checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePrivateFolderId)) clientEnv
          length nodes `shouldBe` 1 length nodes `shouldBe` 1
          ...@@ -65,7 +113,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -65,7 +113,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          aliceCorpusId <- withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do aliceCorpusId <- withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          liftIO $ do liftIO $ do
          cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
          alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice") alicePublicFolderId <- getRootPublicFolderIdForUser testEnv alice
          _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
          -- Check that we can see the folder -- Check that we can see the folder
          ...@@ -85,7 +133,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -85,7 +133,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          aliceCorpusId <- withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do aliceCorpusId <- withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          liftIO $ do liftIO $ do
          cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
          alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice") alicePublicFolderId <- getRootPublicFolderIdForUser testEnv alice
          _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
          -- Check that we can see the folder -- Check that we can see the folder
          ...@@ -103,7 +151,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -103,7 +151,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          -- Now alice moves the node back to her private folder, effectively unpublishing it. -- Now alice moves the node back to her private folder, effectively unpublishing it.
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          liftIO $ do liftIO $ do
          alicePrivateFolderId <- getRootPrivateFolderIdForUser testEnv (UserName "alice") alicePrivateFolderId <- getRootPrivateFolderIdForUser testEnv alice
          void $ checkEither $ runClientM (move_node token (SourceId aliceCorpusId) (TargetId alicePrivateFolderId)) clientEnv void $ checkEither $ runClientM (move_node token (SourceId aliceCorpusId) (TargetId alicePrivateFolderId)) clientEnv
          withValidLogin serverPort "bob" (GargPassword "bob") $ \clientEnv token -> do withValidLogin serverPort "bob" (GargPassword "bob") $ \clientEnv token -> do
          ...@@ -118,7 +166,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -118,7 +166,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          liftIO $ do liftIO $ do
          cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
          alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice") alicePublicFolderId <- getRootPublicFolderIdForUser testEnv alice
          _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
          -- Trying to delete a strictly published node should fail -- Trying to delete a strictly published node should fail
          ...@@ -129,9 +177,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -129,9 +177,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          withApplication app $ do withApplication app $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          liftIO $ do liftIO $ do
          fId <- newFolderForUser testEnv "alice" "my-test-folder" fId <- newFolderForUser testEnv alice "my-test-folder"
          fId'' <- newPrivateFolderForUser testEnv "alice" fId'' <- newPrivateFolderForUser testEnv alice
          alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice") alicePublicFolderId <- getRootPublicFolderIdForUser testEnv alice
          res <- runClientM (move_node token (SourceId fId) (TargetId alicePublicFolderId)) clientEnv res <- runClientM (move_node token (SourceId fId) (TargetId alicePublicFolderId)) clientEnv
          res `shouldFailWith` EC_403__node_move_error res `shouldFailWith` EC_403__node_move_error
          ......
          test/Test/API/Private/Remote.hs
          View file @ aa1dfda3
          ...@@ -84,7 +84,7 @@ tests = sequential $ aroundAll withTwoServerInstances $ do ...@@ -84,7 +84,7 @@ tests = sequential $ aroundAll withTwoServerInstances $ do
          it "forbids transferring certain node types" $ \(SpecContext testEnv1 server1Port app1 (_testEnv2, _app2, server2Port)) -> do it "forbids transferring certain node types" $ \(SpecContext testEnv1 server1Port app1 (_testEnv2, _app2, server2Port)) -> do
          withApplication app1 $ do withApplication app1 $ do
          withValidLogin server1Port "alice" (GargPassword "alice") $ \aliceClientEnv aliceToken -> 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 withValidLogin server2Port "bob" (GargPassword "bob") $ \_bobClientEnv bobToken -> do
          liftIO $ do liftIO $ do
          let rq = RemoteExportRequest { _rer_instance_url = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008" let rq = RemoteExportRequest { _rer_instance_url = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
          ......
          test/Test/API/Routes.hs
          View file @ aa1dfda3
          ...@@ -28,6 +28,7 @@ module Test.API.Routes ( ...@@ -28,6 +28,7 @@ module Test.API.Routes (
          , delete_node , delete_node
          , add_form_to_list , add_form_to_list
          , add_tsv_to_list , add_tsv_to_list
          , addTeamMember
          ) where ) where
          import Data.Text.Encoding qualified as TE import Data.Text.Encoding qualified as TE
          ...@@ -37,6 +38,7 @@ import Gargantext.API.Errors ...@@ -37,6 +38,7 @@ import Gargantext.API.Errors
          import Gargantext.API.HashedResponse (HashedResponse) import Gargantext.API.HashedResponse (HashedResponse)
          import Gargantext.API.Ngrams.List.Types (WithJsonFile, WithTextFile) import Gargantext.API.Ngrams.List.Types (WithJsonFile, WithTextFile)
          import Gargantext.API.Ngrams.Types ( NgramsTable, NgramsTablePatch, OrderBy, TabType, Versioned, VersionedWithCount ) import Gargantext.API.Ngrams.Types ( NgramsTable, NgramsTablePatch, OrderBy, TabType, Versioned, VersionedWithCount )
          import Gargantext.API.Node.Share.Types (ShareNodeParams(..))
          import Gargantext.API.Routes.Client import Gargantext.API.Routes.Client
          import Gargantext.API.Routes.Named import Gargantext.API.Routes.Named
          import Gargantext.API.Routes.Named.List (updateListJSONEp, updateListTSVEp) import Gargantext.API.Routes.Named.List (updateListJSONEp, updateListTSVEp)
          ...@@ -44,6 +46,7 @@ import Gargantext.API.Routes.Named.Node hiding (treeAPI) ...@@ -44,6 +46,7 @@ import Gargantext.API.Routes.Named.Node hiding (treeAPI)
          import Gargantext.API.Routes.Named.Private hiding (tableNgramsAPI) import Gargantext.API.Routes.Named.Private hiding (tableNgramsAPI)
          import Gargantext.API.Routes.Named.Publish (PublishAPI(..)) import Gargantext.API.Routes.Named.Publish (PublishAPI(..))
          import Gargantext.API.Routes.Named.Publish (PublishRequest(..)) import Gargantext.API.Routes.Named.Publish (PublishRequest(..))
          import Gargantext.API.Routes.Named.Share (shareNodeEp)
          import Gargantext.API.Routes.Named.Table import Gargantext.API.Routes.Named.Table
          import Gargantext.API.Routes.Named.Tree (nodeTreeEp) import Gargantext.API.Routes.Named.Tree (nodeTreeEp)
          import Gargantext.API.Types () -- MimeUnrender instances import Gargantext.API.Types () -- MimeUnrender instances
          ...@@ -337,3 +340,21 @@ publish_node (toServantToken -> token) sourceId policy = fmap UnsafeMkNodeId $ ...@@ -337,3 +340,21 @@ publish_node (toServantToken -> token) sourceId policy = fmap UnsafeMkNodeId $
          & publishAPI & publishAPI
          & publishEp & publishEp
          & ($ PublishRequest policy) & ($ PublishRequest policy)
          addTeamMember :: Token -> NodeId -> ShareNodeParams -> ClientM NodeId
          addTeamMember (toServantToken -> token) nodeId params = fmap UnsafeMkNodeId $
          clientRoutes & apiWithCustomErrorScheme
          & ($ GES_new)
          & backendAPI
          & backendAPI'
          & mkBackEndAPI
          & gargAPIVersion
          & gargPrivateAPI
          & mkPrivateAPI
          & ($ token)
          & nodeEp
          & nodeEndpointAPI
          & ($ nodeId)
          & shareAPI
          & shareNodeEp
          & ($ params)
          test/Test/API/UpdateList.hs
          View file @ aa1dfda3
          ...@@ -66,7 +66,7 @@ import Paths_gargantext (getDataFileName) ...@@ -66,7 +66,7 @@ import Paths_gargantext (getDataFileName)
          import qualified Prelude import qualified Prelude
          import Servant.Client.Streaming import Servant.Client.Streaming
          import System.FilePath 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.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.API.Setup (withTestDBAndPort, dbEnvSetup, SpecContext (..))
          import Test.Database.Types import Test.Database.Types
          ...@@ -349,7 +349,7 @@ createDocsList :: FilePath ...@@ -349,7 +349,7 @@ createDocsList :: FilePath
          -> Token -> Token
          -> WaiSession () CorpusId -> WaiSession () CorpusId
          createDocsList testDataPath testEnv port clientEnv token = do 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"}|] ([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. -- Import the docsList with only two documents, both containing a \"fortran\" term.
          simpleDocs <- liftIO (TIO.readFile =<< getDataFileName testDataPath) simpleDocs <- liftIO (TIO.readFile =<< getDataFileName testDataPath)
          ......
          test/Test/Database/Operations/PublishNode.hs
          View file @ aa1dfda3
          ...@@ -24,7 +24,7 @@ import Gargantext.Database.Prelude (DBCmd) ...@@ -24,7 +24,7 @@ import Gargantext.Database.Prelude (DBCmd)
          import Gargantext.Database.Query.Table.Node import Gargantext.Database.Query.Table.Node
          import Gargantext.Database.Query.Table.NodeNode import Gargantext.Database.Query.Table.NodeNode
          import Gargantext.Database.Schema.Node (NodePoly(..)) 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.Database.Types
          import Test.Tasty.HUnit import Test.Tasty.HUnit
          ...@@ -43,8 +43,8 @@ testGetUserRootPublicNode testEnv = do ...@@ -43,8 +43,8 @@ testGetUserRootPublicNode testEnv = do
          testIsReadOnlyWorks :: TestEnv -> Assertion testIsReadOnlyWorks :: TestEnv -> Assertion
          testIsReadOnlyWorks testEnv = do testIsReadOnlyWorks testEnv = do
          alicePrivateFolderId <- newPrivateFolderForUser testEnv "alice" alicePrivateFolderId <- newPrivateFolderForUser testEnv alice
          alicePublicFolderId <- newPublicFolderForUser testEnv "alice" alicePublicFolderId <- newPublicFolderForUser testEnv alice
          flip runReaderT testEnv $ runTestMonad $ do flip runReaderT testEnv $ runTestMonad $ do
          -- Create a corpus, by default is not read only -- Create a corpus, by default is not read only
          aliceUserId <- getUserId (UserName "alice") aliceUserId <- getUserId (UserName "alice")
          ...@@ -64,8 +64,8 @@ testIsReadOnlyWorks testEnv = do ...@@ -64,8 +64,8 @@ testIsReadOnlyWorks testEnv = do
          -- then all the children (up to the first level) are also marked read-only. -- then all the children (up to the first level) are also marked read-only.
          testPublishRecursiveFirstLevel :: TestEnv -> Assertion testPublishRecursiveFirstLevel :: TestEnv -> Assertion
          testPublishRecursiveFirstLevel testEnv = do testPublishRecursiveFirstLevel testEnv = do
          alicePrivateFolderId <- newPrivateFolderForUser testEnv "alice" alicePrivateFolderId <- newPrivateFolderForUser testEnv alice
          alicePublicFolderId <- newPublicFolderForUser testEnv "alice" alicePublicFolderId <- newPublicFolderForUser testEnv alice
          flip runReaderT testEnv $ runTestMonad $ do flip runReaderT testEnv $ runTestMonad $ do
          -- Create a corpus, by default is not read only -- Create a corpus, by default is not read only
          aliceUserId <- getUserId (UserName "alice") aliceUserId <- getUserId (UserName "alice")
          ...@@ -81,8 +81,8 @@ testPublishRecursiveFirstLevel testEnv = do ...@@ -81,8 +81,8 @@ testPublishRecursiveFirstLevel testEnv = do
          -- then all the children of the children are also marked read-only. -- then all the children of the children are also marked read-only.
          testPublishRecursiveNLevel :: TestEnv -> Assertion testPublishRecursiveNLevel :: TestEnv -> Assertion
          testPublishRecursiveNLevel testEnv = do testPublishRecursiveNLevel testEnv = do
          alicePrivateFolderId <- newPrivateFolderForUser testEnv "alice" alicePrivateFolderId <- newPrivateFolderForUser testEnv alice
          alicePublicFolderId <- newPublicFolderForUser testEnv "alice" alicePublicFolderId <- newPublicFolderForUser testEnv alice
          flip runReaderT testEnv $ runTestMonad $ do flip runReaderT testEnv $ runTestMonad $ do
          -- Create a corpus, by default is not read only -- Create a corpus, by default is not read only
          aliceUserId <- getUserId (UserName "alice") aliceUserId <- getUserId (UserName "alice")
          ...@@ -98,8 +98,8 @@ testPublishRecursiveNLevel testEnv = do ...@@ -98,8 +98,8 @@ testPublishRecursiveNLevel testEnv = do
          testPublishLenientWorks :: TestEnv -> Assertion testPublishLenientWorks :: TestEnv -> Assertion
          testPublishLenientWorks testEnv = do testPublishLenientWorks testEnv = do
          alicePrivateFolderId <- newPrivateFolderForUser testEnv "alice" alicePrivateFolderId <- newPrivateFolderForUser testEnv alice
          alicePublicFolderId <- newPublicFolderForUser testEnv "alice" alicePublicFolderId <- newPublicFolderForUser testEnv alice
          flip runReaderT testEnv $ runTestMonad $ do flip runReaderT testEnv $ runTestMonad $ do
          aliceUserId <- getUserId (UserName "alice") aliceUserId <- getUserId (UserName "alice")
          corpusId <- insertDefaultNode NodeCorpus alicePrivateFolderId aliceUserId corpusId <- insertDefaultNode NodeCorpus alicePrivateFolderId aliceUserId
          ......
          Markdown is supported
          0% or
          You are about to add 0 people to the discussion. Proceed with caution.
          Finish editing this message first!
          Please register or to comment