Skip to content

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

Introduce SpecContext, replicate search issue 

This commit refactors the test code ever so slightly to add a proper
type called `SpecContext` rather than anonymous pairs to carry around
the spec context/data. It also replicates the search problem around #415
via a test.
parent b4260d9b
Pipeline #6828 failed with stages
          in 49 minutes and 48 seconds
          Hide whitespace changes
          Inline Side-by-side
          Showing with 169 additions and 59 deletions
          gargantext.cabal
          View file @ d44831d0
          ...@@ -724,6 +724,7 @@ common testDependencies ...@@ -724,6 +724,7 @@ common testDependencies
          , epo-api-client , epo-api-client
          , extra ^>= 1.7.9 , extra ^>= 1.7.9
          , fast-logger ^>= 3.2.2 , fast-logger ^>= 3.2.2
          , filepath ^>= 1.4.2.2
          , fmt , fmt
          , gargantext , gargantext
          , gargantext-prelude , gargantext-prelude
          ...@@ -799,6 +800,7 @@ test-suite garg-test-tasty ...@@ -799,6 +800,7 @@ test-suite garg-test-tasty
          CLI.Phylo.Common CLI.Phylo.Common
          Paths_gargantext Paths_gargantext
          Test.API.Private.Share Test.API.Private.Share
          Test.API.Private.Table
          Test.API.Authentication Test.API.Authentication
          Test.API.Routes Test.API.Routes
          Test.API.Setup Test.API.Setup
          ...@@ -858,6 +860,7 @@ test-suite garg-test-hspec ...@@ -858,6 +860,7 @@ test-suite garg-test-hspec
          Test.API.Notifications Test.API.Notifications
          Test.API.Private Test.API.Private
          Test.API.Private.Share Test.API.Private.Share
          Test.API.Private.Table
          Test.API.Routes Test.API.Routes
          Test.API.Setup Test.API.Setup
          Test.API.UpdateList Test.API.UpdateList
          ......
          test-data/search/GarganText_DocsList-soysauce.json
          View file @ d44831d0
          ...@@ -114,7 +114,7 @@ ...@@ -114,7 +114,7 @@
          "hash": "" "hash": ""
          }, },
          "hash": "" "hash": ""
          }, }
          ], ],
          "garg_version": "0.0.7.3.1" "garg_version": "0.0.7.3.1"
          } }
          test/Test/API/Authentication.hs
          View file @ d44831d0
          ...@@ -20,7 +20,7 @@ import Prelude qualified ...@@ -20,7 +20,7 @@ import Prelude qualified
          import Servant.Auth.Client () import Servant.Auth.Client ()
          import Servant.Client import Servant.Client
          import Test.API.Routes (auth_api) import Test.API.Routes (auth_api)
          import Test.API.Setup (withTestDBAndPort, setupEnvironment) import Test.API.Setup (withTestDBAndPort, setupEnvironment, SpecContext (..))
          import Test.Database.Types import Test.Database.Types
          import Test.Hspec import Test.Hspec
          import Gargantext.API.Routes.Named import Gargantext.API.Routes.Named
          ...@@ -32,7 +32,7 @@ cannedToken = "eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiaWQiOjF9fQ.t49zZSqkPAulEkYEh4pW1 ...@@ -32,7 +32,7 @@ cannedToken = "eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiaWQiOjF9fQ.t49zZSqkPAulEkYEh4pW1
          tests :: Spec tests :: Spec
          tests = sequential $ aroundAll withTestDBAndPort $ do tests = sequential $ aroundAll withTestDBAndPort $ do
          describe "Prelude" $ do describe "Prelude" $ do
          it "setup DB triggers" $ \((testEnv, _), _) -> setupEnvironment testEnv it "setup DB triggers" $ \SpecContext{..} -> setupEnvironment _sctx_env
          describe "Authentication" $ do describe "Authentication" $ do
          baseUrl <- runIO $ parseBaseUrl "http://localhost" baseUrl <- runIO $ parseBaseUrl "http://localhost"
          manager <- runIO $ newManager defaultManagerSettings manager <- runIO $ newManager defaultManagerSettings
          ...@@ -41,15 +41,15 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -41,15 +41,15 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          -- testing scenarios start here -- testing scenarios start here
          describe "GET /api/v1.0/version" $ do describe "GET /api/v1.0/version" $ do
          let version_api = gargVersionEp . gargAPIVersion . mkBackEndAPI $ genericClient let version_api = gargVersionEp . gargAPIVersion . mkBackEndAPI $ genericClient
          it "requires no auth and returns the current version" $ \((_testEnv, port), _) -> do it "requires no auth and returns the current version" $ \SpecContext{..} -> do
          result <- runClientM version_api (clientEnv port) result <- runClientM version_api (clientEnv _sctx_port)
          case result of case result of
          Left err -> Prelude.fail (show err) Left err -> Prelude.fail (show err)
          Right r -> r `shouldSatisfy` ((>= 1) . T.length) -- we got something back Right r -> r `shouldSatisfy` ((>= 1) . T.length) -- we got something back
          describe "POST /api/v1.0/auth" $ do describe "POST /api/v1.0/auth" $ do
          it "requires no auth and authenticates the user 'alice'" $ \((testEnv, port), _) -> do it "requires no auth and authenticates the user 'alice'" $ \(SpecContext testEnv port _app _) -> do
          -- Let's create the Alice user. -- Let's create the Alice user.
          void $ flip runReaderT testEnv $ runTestMonad $ do void $ flip runReaderT testEnv $ runTestMonad $ do
          ...@@ -66,7 +66,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -66,7 +66,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          result `shouldBe` Right expected result `shouldBe` Right expected
          it "denies login for user 'alice' if password is invalid" $ \((_testEnv, port), _) -> do it "denies login for user 'alice' if password is invalid" $ \(SpecContext _testEnv port _app _) -> do
          let authPayload = AuthRequest "alice" (GargPassword "wrong") let authPayload = AuthRequest "alice" (GargPassword "wrong")
          result <- runClientM (auth_api authPayload) (clientEnv port) result <- runClientM (auth_api authPayload) (clientEnv port)
          putText $ "result: " <> show result putText $ "result: " <> show result
          ......
          test/Test/API/Errors.hs
          View file @ d44831d0
          ...@@ -15,7 +15,7 @@ import Servant.Auth.Client () ...@@ -15,7 +15,7 @@ import Servant.Auth.Client ()
          import Servant.Client import Servant.Client
          import Servant.Client.Generic (genericClient) import Servant.Client.Generic (genericClient)
          import Test.API.Routes (mkUrl) import Test.API.Routes (mkUrl)
          import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob) import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
          import Test.Hspec import Test.Hspec
          import Test.Hspec.Wai.Internal (withApplication) import Test.Hspec.Wai.Internal (withApplication)
          import Test.Utils (protected, withValidLogin, protectedNewError) import Test.Utils (protected, withValidLogin, protectedNewError)
          ...@@ -26,7 +26,7 @@ tests :: Spec ...@@ -26,7 +26,7 @@ tests :: Spec
          tests = sequential $ aroundAll withTestDBAndPort $ do tests = sequential $ aroundAll withTestDBAndPort $ do
          describe "Errors API" $ do describe "Errors API" $ do
          describe "Prelude" $ do describe "Prelude" $ do
          it "setup DB triggers and users" $ \((testEnv, port), _) -> do it "setup DB triggers and users" $ \(SpecContext testEnv port _app _) -> do
          setupEnvironment testEnv setupEnvironment testEnv
          baseUrl <- parseBaseUrl "http://localhost" baseUrl <- parseBaseUrl "http://localhost"
          manager <- newManager defaultManagerSettings manager <- newManager defaultManagerSettings
          ...@@ -41,7 +41,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -41,7 +41,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          describe "GET /api/v1.0/node" $ do describe "GET /api/v1.0/node" $ do
          it "returns the old error by default" $ \((_testEnv, port), app) -> do it "returns the old error by default" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
          res <- protected token "GET" (mkUrl port "/node/99") "" res <- protected token "GET" (mkUrl port "/node/99") ""
          ...@@ -52,7 +52,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -52,7 +52,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          statusCode `shouldBe` 404 statusCode `shouldBe` 404
          simpleBody `shouldBe` [r|{"error":"Node does not exist","node":99}|] simpleBody `shouldBe` [r|{"error":"Node does not exist","node":99}|]
          it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
          res <- protectedNewError token "GET" (mkUrl port "/node/99") "" res <- protectedNewError token "GET" (mkUrl port "/node/99") ""
          ......
          test/Test/API/GraphQL.hs
          View file @ d44831d0
          ...@@ -10,7 +10,7 @@ module Test.API.GraphQL ( ...@@ -10,7 +10,7 @@ module Test.API.GraphQL (
          import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
          import Prelude import Prelude
          import Servant.Auth.Client () import Servant.Auth.Client ()
          import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob) import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
          import Test.Hspec import Test.Hspec
          import Test.Hspec.Wai.Internal (withApplication) import Test.Hspec.Wai.Internal (withApplication)
          import Test.Hspec.Wai.JSON (json) import Test.Hspec.Wai.JSON (json)
          ...@@ -21,10 +21,10 @@ tests :: Spec ...@@ -21,10 +21,10 @@ tests :: Spec
          tests = sequential $ aroundAll withTestDBAndPort $ do tests = sequential $ aroundAll withTestDBAndPort $ do
          describe "GraphQL" $ do describe "GraphQL" $ do
          describe "Prelude" $ do describe "Prelude" $ do
          it "setup DB triggers" $ \((testEnv, _), _) -> setupEnvironment testEnv it "setup DB triggers" $ \SpecContext{..} -> setupEnvironment _sctx_env
          describe "get_user_infos" $ do describe "get_user_infos" $ do
          it "allows 'alice' to see her own info" $ \((testEnv, port), app) -> do it "allows 'alice' to see her own info" $ \(SpecContext testEnv port app _) -> do
          createAliceAndBob testEnv createAliceAndBob testEnv
          withApplication app $ do withApplication app $ do
          ...@@ -34,7 +34,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -34,7 +34,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          protected token "POST" "/gql" query `shouldRespondWithFragment` expected protected token "POST" "/gql" query `shouldRespondWithFragment` expected
          describe "nodes" $ do describe "nodes" $ do
          it "returns node_type" $ \((_testEnv, port), app) -> do it "returns node_type" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
          let query = [r| { "query": "{ nodes(node_id: 2) { node_type } }" } |] let query = [r| { "query": "{ nodes(node_id: 2) { node_type } }" } |]
          ...@@ -42,21 +42,21 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -42,21 +42,21 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          protected token "POST" "/gql" query `shouldRespondWithFragment` expected protected token "POST" "/gql" query `shouldRespondWithFragment` expected
          describe "check error format" $ do describe "check error format" $ do
          it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
          let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |] let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |]
          let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |] let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
          protectedNewError token "POST" "/gql" query `shouldRespondWithFragment` expected protectedNewError token "POST" "/gql" query `shouldRespondWithFragment` expected
          it "returns the old error (though this is deprecated)" $ \((_testEnv, port), app) -> do it "returns the old error (though this is deprecated)" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
          let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |] let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |]
          let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |] let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
          protected token "POST" "/gql" query `shouldRespondWithFragment` expected protected token "POST" "/gql" query `shouldRespondWithFragment` expected
          it "check new errors with 'type'" $ \((_testEnv, port), app) -> do it "check new errors with 'type'" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
          let query = [r| { "query": "mutation { delete_team_membership(shared_folder_id:1, team_node_id:1, token:\"abc\") }" } |] let query = [r| { "query": "mutation { delete_team_membership(shared_folder_id:1, team_node_id:1, token:\"abc\") }" } |]
          ......
          test/Test/API/Private.hs
          View file @ d44831d0
          ...@@ -9,26 +9,25 @@ module Test.API.Private ( ...@@ -9,26 +9,25 @@ module Test.API.Private (
          import Gargantext.API.Routes.Named.Node import Gargantext.API.Routes.Named.Node
          import Gargantext.API.Routes.Named.Private import Gargantext.API.Routes.Named.Private
          import Gargantext.Core.Types (Node)
          import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
          import Gargantext.Core.Types (Node)
          import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
          import Gargantext.Prelude hiding (get) import Gargantext.Prelude hiding (get)
          import Network.HTTP.Client hiding (Proxy) import Network.HTTP.Client hiding (Proxy)
          import Network.Wai
          import Servant.Auth.Client () import Servant.Auth.Client ()
          import Servant.Client import Servant.Client
          import Servant.Client.Generic (genericClient) import Servant.Client.Generic (genericClient)
          import Test.API.Private.Share qualified as Share import Test.API.Private.Share qualified as Share
          import Test.API.Private.Table qualified as Table
          import Test.API.Routes (mkUrl) import Test.API.Routes (mkUrl)
          import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob) import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
          import Test.Database.Types
          import Test.Hspec import Test.Hspec
          import Test.Hspec.Wai hiding (pendingWith) import Test.Hspec.Wai hiding (pendingWith)
          import Test.Hspec.Wai.Internal (withApplication) import Test.Hspec.Wai.Internal (withApplication)
          import Test.Hspec.Wai.JSON (json) import Test.Hspec.Wai.JSON (json)
          import Test.Utils (protected, shouldRespondWithFragment, withValidLogin) import Test.Utils (protected, shouldRespondWithFragment, withValidLogin)
          privateTests :: SpecWith ((TestEnv, Int), Application) privateTests :: SpecWith (SpecContext a)
          privateTests = privateTests =
          describe "Private API" $ do describe "Private API" $ do
          baseUrl <- runIO $ parseBaseUrl "http://localhost" baseUrl <- runIO $ parseBaseUrl "http://localhost"
          ...@@ -38,7 +37,7 @@ privateTests = ...@@ -38,7 +37,7 @@ privateTests =
          describe "GET /api/v1.0/user" $ do describe "GET /api/v1.0/user" $ do
          -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking. -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
          it "doesn't allow someone with an invalid token to show the results" $ \((testEnv, port), _) -> do it "doesn't allow someone with an invalid token to show the results" $ \(SpecContext testEnv port _ _) -> do
          createAliceAndBob testEnv createAliceAndBob testEnv
          ...@@ -49,7 +48,7 @@ privateTests = ...@@ -49,7 +48,7 @@ privateTests =
          length result `shouldBe` 0 length result `shouldBe` 0
          -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking. -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
          it "allows 'alice' to see the results" $ \((_testEnv, port), _) -> do it "allows 'alice' to see the results" $ \(SpecContext _testEnv port _app _) -> do
          withValidLogin port "alice" (GargPassword "alice") $ \clientEnv _token -> do withValidLogin port "alice" (GargPassword "alice") $ \clientEnv _token -> do
          let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM)) let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM))
          ...@@ -60,33 +59,33 @@ privateTests = ...@@ -60,33 +59,33 @@ privateTests =
          describe "GET /api/v1.0/node" $ do describe "GET /api/v1.0/node" $ do
          it "unauthorised users shouldn't see anything" $ \((_testEnv, port), app) -> do it "unauthorised users shouldn't see anything" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          get (mkUrl port "/node/1") `shouldRespondWith` 401 get (mkUrl port "/node/1") `shouldRespondWith` 401
          it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do it "allows 'alice' to see her own node info" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
          protected token "GET" (mkUrl port "/node/8") "" protected token "GET" (mkUrl port "/node/8") ""
          `shouldRespondWithFragment` [json| {"id":8,"user_id":2,"name":"alice" } |] `shouldRespondWithFragment` [json| {"id":8,"user_id":2,"name":"alice" } |]
          it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do it "forbids 'alice' to see others node private info" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
          protected token "GET" (mkUrl port "/node/1") "" `shouldRespondWith` 403 protected token "GET" (mkUrl port "/node/1") "" `shouldRespondWith` 403
          describe "GET /api/v1.0/tree" $ do describe "GET /api/v1.0/tree" $ do
          it "unauthorised users shouldn't see anything" $ \((_testEnv, port), app) -> do it "unauthorised users shouldn't see anything" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          get (mkUrl port "/tree/1") `shouldRespondWith` 401 get (mkUrl port "/tree/1") `shouldRespondWith` 401
          it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do it "allows 'alice' to see her own node info" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
          protected token "GET" (mkUrl port "/tree/8") "" protected token "GET" (mkUrl port "/tree/8") ""
          `shouldRespondWithFragment` [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |] `shouldRespondWithFragment` [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |]
          it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do it "forbids 'alice' to see others node private info" $ \(SpecContext _testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
          protected token "GET" (mkUrl port "/tree/1") "" `shouldRespondWith` 403 protected token "GET" (mkUrl port "/tree/1") "" `shouldRespondWith` 403
          ...@@ -96,7 +95,9 @@ tests :: Spec ...@@ -96,7 +95,9 @@ tests :: Spec
          tests = do tests = do
          sequential $ aroundAll withTestDBAndPort $ do sequential $ aroundAll withTestDBAndPort $ do
          describe "Prelude" $ do describe "Prelude" $ do
          it "setup DB triggers" $ \((testEnv, _), _) -> setupEnvironment testEnv it "setup DB triggers" $ \SpecContext{..} -> setupEnvironment _sctx_env
          privateTests privateTests
          describe "Share API" $ do describe "Share API" $ do
          Share.tests Share.tests
          describe "Table API" $ do
          Table.tests
          test/Test/API/Private/Share.hs
          View file @ d44831d0
          ...@@ -43,12 +43,12 @@ shareURL token = ...@@ -43,12 +43,12 @@ shareURL token =
          tests :: Spec tests :: Spec
          tests = sequential $ aroundAll withTestDBAndPort $ do tests = sequential $ aroundAll withTestDBAndPort $ do
          describe "Prelude" $ do describe "Prelude" $ do
          it "setup DB triggers" $ \((testEnv, _), _) -> do it "setup DB triggers" $ \SpecContext{..} -> do
          setupEnvironment testEnv setupEnvironment _sctx_env
          -- Let's create the Alice user. -- Let's create the Alice user.
          createAliceAndBob testEnv createAliceAndBob _sctx_env
          it "should fail if no node type is specified" $ \((_testEnv, serverPort), app) -> do it "should fail if no node type is specified" $ \(SpecContext _testEnv serverPort app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          url <- liftIO $ runClientM (shareURL (toServantToken token) Nothing Nothing) clientEnv url <- liftIO $ runClientM (shareURL (toServantToken token) Nothing Nothing) clientEnv
          ...@@ -57,7 +57,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -57,7 +57,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          -> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node Type" . T.pack) -> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node Type" . T.pack)
          _ -> fail "Test did not fail as expected!" _ -> fail "Test did not fail as expected!"
          it "should fail if no node ID is specified" $ \((_testEnv, serverPort), app) -> do it "should fail if no node ID is specified" $ \(SpecContext _testEnv serverPort app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) Nothing) clientEnv url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) Nothing) clientEnv
          ...@@ -66,7 +66,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -66,7 +66,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          -> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node ID" . T.pack) -> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node ID" . T.pack)
          _ -> fail "Test did not fail as expected!" _ -> fail "Test did not fail as expected!"
          it "should return a valid URL" $ \((testEnv, serverPort), app) -> do it "should return a valid URL" $ \(SpecContext testEnv serverPort app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          cId <- liftIO $ newCorpusForUser testEnv "alice" cId <- liftIO $ newCorpusForUser testEnv "alice"
          ...@@ -77,7 +77,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -77,7 +77,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          Right (ShareLink _) Right (ShareLink _)
          -> pure () -> pure ()
          it "should include the port if needed (like localhost)" $ \((testEnv, serverPort), app) -> do it "should include the port if needed (like localhost)" $ \(SpecContext testEnv serverPort app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
          cId <- liftIO $ newCorpusForUser testEnv "alice" cId <- liftIO $ newCorpusForUser testEnv "alice"
          ......
          test/Test/API/Private/Table.hs 0 → 100644
          View file @ d44831d0
          {-# LANGUAGE BangPatterns #-}
          {-# LANGUAGE TypeApplications #-}
          {-# LANGUAGE TypeFamilies #-}
          module Test.API.Private.Table (
          tests
          ) where
          import Gargantext.API.HashedResponse
          import Gargantext.Core.Text.Corpus.Query
          import Gargantext.Core.Types
          import Gargantext.Core.Types.Individu
          import Gargantext.Prelude
          import qualified Gargantext.API.Ngrams.Types as APINgrams
          import qualified Gargantext.Database.Query.Facet as Facet
          import Servant.Client
          import Test.API.Routes
          import Test.API.Setup
          import Test.API.UpdateList (createDocsList, checkEither)
          import Test.Hspec
          import Test.Hspec.Wai.Internal (withApplication)
          import Test.Utils
          tests :: Spec
          tests = sequential $ aroundAll withTestDBAndPort $ do
          describe "Prelude" $ do
          it "setup DB triggers" $ \SpecContext{..} -> do
          setupEnvironment _sctx_env
          -- Let's create the Alice user.
          createAliceAndBob _sctx_env
          beforeAllWith createSoySauceCorpus $ do
          it "should return sauce in the search (#415)" $ \SpecContext{..} -> do
          let corpusId = _sctx_data
          withApplication _sctx_app $ do
          withValidLogin _sctx_port "alice" (GargPassword "alice") $ \clientEnv token -> do
          liftIO $ do
          (HashedResponse _ tr1)
          <- checkEither $ runClientM (get_table token
          corpusId
          (Just APINgrams.Docs)
          (Just 10)
          (Just 0)
          (Just Facet.DateDesc)
          (Just $ RawQuery "sauce")
          Nothing
          ) clientEnv
          length (tr_docs tr1) `shouldBe` 1
          it "should return soy in the search (#415)" $ \SpecContext{..} -> do
          let corpusId = _sctx_data
          withApplication _sctx_app $ do
          withValidLogin _sctx_port "alice" (GargPassword "alice") $ \clientEnv token -> do
          liftIO $ do
          (HashedResponse _ tr1)
          <- checkEither $ runClientM (get_table token
          corpusId
          (Just APINgrams.Docs)
          (Just 10)
          (Just 0)
          (Just Facet.DateDesc)
          (Just $ RawQuery "soy")
          Nothing
          ) clientEnv
          length (tr_docs tr1) `shouldBe` 4
          createSoySauceCorpus :: SpecContext () -> IO (SpecContext CorpusId)
          createSoySauceCorpus ctx@SpecContext{..} = do
          withApplication _sctx_app $ do
          withValidLogin _sctx_port "alice" (GargPassword "alice") $ \clientEnv token -> do
          corpusId <- createDocsList "test-data/search/GarganText_DocsList-soysauce.json" _sctx_env _sctx_port clientEnv token
          pure $ const corpusId <$> ctx
          test/Test/API/Setup.hs
          View file @ d44831d0
          {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
          module Test.API.Setup where module Test.API.Setup (
          SpecContext(..)
          , withTestDBAndPort
          , withTestDBAndNotifications
          , withBackendServerAndProxy
          , setupEnvironment
          , createAliceAndBob
          ) where
          import Control.Concurrent.Async qualified as Async import Control.Concurrent.Async qualified as Async
          import Control.Concurrent.MVar import Control.Concurrent.MVar
          ...@@ -51,6 +58,21 @@ import Test.Database.Types ...@@ -51,6 +58,21 @@ import Test.Database.Types
          import UnliftIO qualified import UnliftIO qualified
          -- | The context that each spec will be carrying along. This type is
          -- polymorphic so that each test can embellish it with test-specific data.
          -- 'SpecContext' is a functor, so you can use 'fmap' to change the 'a'.
          data SpecContext a =
          SpecContext {
          _sctx_env :: !TestEnv
          , _sctx_port :: !Warp.Port
          , _sctx_app :: !Application
          , _sctx_data :: !a
          }
          instance Functor SpecContext where
          fmap f (SpecContext e p a d) = SpecContext e p a (f d)
          newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env
          newTestEnv testEnv logger port = do newTestEnv testEnv logger port = do
          tomlFile@(SettingsFile sf) <- fakeTomlPath tomlFile@(SettingsFile sf) <- fakeTomlPath
          ...@@ -94,7 +116,7 @@ newTestEnv testEnv logger port = do ...@@ -94,7 +116,7 @@ newTestEnv testEnv logger port = do
          -- | Run the gargantext server on a random port, picked by Warp, which allows -- | Run the gargantext server on a random port, picked by Warp, which allows
          -- for concurrent tests to be executed in parallel, if we need to. -- for concurrent tests to be executed in parallel, if we need to.
          withTestDBAndPort :: (((TestEnv, Warp.Port), Application) -> IO ()) -> IO () withTestDBAndPort :: (SpecContext () -> IO ()) -> IO ()
          withTestDBAndPort action = withTestDBAndPort action =
          withTestDB $ \testEnv -> do withTestDB $ \testEnv -> do
          -- TODO Despite being cautious here only to start/kill dispatcher -- TODO Despite being cautious here only to start/kill dispatcher
          ...@@ -123,7 +145,7 @@ withTestDBAndPort action = ...@@ -123,7 +145,7 @@ withTestDBAndPort action =
          env <- newTestEnv testEnv ioLogger 8080 env <- newTestEnv testEnv ioLogger 8080
          makeApp env makeApp env
          let stgs = Warp.defaultSettings { settingsOnExceptionResponse = showDebugExceptions } let stgs = Warp.defaultSettings { settingsOnExceptionResponse = showDebugExceptions }
          Warp.testWithApplicationSettings stgs (pure app) $ \port -> action ((testEnv, port), app) Warp.testWithApplicationSettings stgs (pure app) $ \port -> action (SpecContext testEnv port app ())
          withTestDBAndNotifications :: D.Dispatcher -> (((TestEnv, Warp.Port), Application) -> IO ()) -> IO () withTestDBAndNotifications :: D.Dispatcher -> (((TestEnv, Warp.Port), Application) -> IO ()) -> IO ()
          withTestDBAndNotifications dispatcher action = do withTestDBAndNotifications dispatcher action = do
          ......
          test/Test/API/UpdateList.hs
          View file @ d44831d0
          ...@@ -7,12 +7,14 @@ ...@@ -7,12 +7,14 @@
          module Test.API.UpdateList ( module Test.API.UpdateList (
          tests tests
          , newCorpusForUser -- * Useful helpers
          , JobPollHandle(..) , JobPollHandle(..)
          , newCorpusForUser
          , pollUntilFinished , pollUntilFinished
          -- * Useful helpers
          , updateNode , updateNode
          , createDocsList
          , checkEither
          ) where ) where
          import Control.Lens (mapped, over) import Control.Lens (mapped, over)
          ...@@ -57,11 +59,12 @@ import Gargantext.Prelude hiding (get) ...@@ -57,11 +59,12 @@ import Gargantext.Prelude hiding (get)
          import Network.Wai.Handler.Warp qualified as Wai import Network.Wai.Handler.Warp qualified as Wai
          import Paths_gargantext (getDataFileName) import Paths_gargantext (getDataFileName)
          import qualified Prelude import qualified Prelude
          import System.FilePath
          import Servant import Servant
          import Servant.Client import Servant.Client
          import Servant.Job.Async import Servant.Job.Async
          import Test.API.Routes (mkUrl, gqlUrl, get_table_ngrams, put_table_ngrams, toServantToken, clientRoutes, get_table, update_node) import Test.API.Routes (mkUrl, gqlUrl, get_table_ngrams, put_table_ngrams, toServantToken, clientRoutes, get_table, update_node)
          import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob) import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
          import Test.Database.Types import Test.Database.Types
          import Test.Hspec import Test.Hspec
          import Test.Hspec.Wai.Internal (withApplication, WaiSession) import Test.Hspec.Wai.Internal (withApplication, WaiSession)
          ...@@ -114,13 +117,13 @@ uploadJSONList port token cId pathToNgrams = do ...@@ -114,13 +117,13 @@ uploadJSONList port token cId pathToNgrams = do
          tests :: Spec tests :: Spec
          tests = sequential $ aroundAll withTestDBAndPort $ do tests = sequential $ aroundAll withTestDBAndPort $ do
          describe "UpdateList API" $ do describe "UpdateList API" $ do
          it "setup DB triggers and users" $ \((testEnv, _), _) -> do it "setup DB triggers and users" $ \(SpecContext testEnv _port _app _) -> do
          setupEnvironment testEnv setupEnvironment testEnv
          createAliceAndBob testEnv createAliceAndBob testEnv
          describe "POST /api/v1.0/lists/:id/add/form/async (JSON)" $ do describe "POST /api/v1.0/lists/:id/add/form/async (JSON)" $ do
          it "allows uploading a JSON ngrams file" $ \((testEnv, port), app) -> do it "allows uploading a JSON ngrams file" $ \(SpecContext testEnv port app _) -> do
          cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
          withApplication app $ do withApplication app $ do
          withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
          ...@@ -142,7 +145,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -142,7 +145,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          ] ]
          } |] } |]
          it "does not create duplicates when uploading JSON (#313)" $ \((testEnv, port), app) -> do it "does not create duplicates when uploading JSON (#313)" $ \(SpecContext testEnv port app _) -> do
          cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
          withApplication app $ do withApplication app $ do
          withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
          ...@@ -206,7 +209,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -206,7 +209,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          describe "POST /api/v1.0/lists/:id/csv/add/form/async (CSV)" $ do describe "POST /api/v1.0/lists/:id/csv/add/form/async (CSV)" $ do
          it "parses CSV via ngramsListFromCSVData" $ \((_testEnv, _port), _app) -> do it "parses CSV via ngramsListFromCSVData" $ \(SpecContext _testEnv _port _app _) -> do
          simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.tsv") simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.tsv")
          ngramsListFromTSVData simpleNgrams `shouldBe` ngramsListFromTSVData simpleNgrams `shouldBe`
          Right (Map.fromList [ (NgramsTerms, Versioned 0 $ Map.fromList [ Right (Map.fromList [ (NgramsTerms, Versioned 0 $ Map.fromList [
          ...@@ -214,7 +217,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -214,7 +217,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          , (NgramsTerm "brazorf", NgramsRepoElement 1 StopTerm Nothing Nothing (MSet mempty)) , (NgramsTerm "brazorf", NgramsRepoElement 1 StopTerm Nothing Nothing (MSet mempty))
          ])]) ])])
          it "allows uploading a CSV ngrams file" $ \((testEnv, port), app) -> do it "allows uploading a CSV ngrams file" $ \(SpecContext testEnv port app _) -> do
          cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
          withApplication app $ do withApplication app $ do
          withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
          ...@@ -257,12 +260,12 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -257,12 +260,12 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          describe "POST /api/v1.0/corpus/:id/add/form/async (JSON)" $ do describe "POST /api/v1.0/corpus/:id/add/form/async (JSON)" $ do
          it "allows uploading a JSON docs file" $ \((testEnv, port), app) -> it "allows uploading a JSON docs file" $ \(SpecContext testEnv port app _) ->
          withApplication app $ do withApplication app $ do
          withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
          void $ createFortranDocsList testEnv port clientEnv token void $ createFortranDocsList testEnv port clientEnv token
          it "doesn't use trashed documents for score calculation (#385)" $ \((testEnv, port), app) -> do it "doesn't use trashed documents for score calculation (#385)" $ \(SpecContext testEnv port app _) -> do
          withApplication app $ do withApplication app $ do
          withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
          corpusId <- createFortranDocsList testEnv port clientEnv token corpusId <- createFortranDocsList testEnv port clientEnv token
          ...@@ -336,21 +339,28 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -336,21 +339,28 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
          ) clientEnv ) clientEnv
          length (_ne_occurrences fortran_ngram') `shouldBe` 1 length (_ne_occurrences fortran_ngram') `shouldBe` 1
          createDocsList :: FilePath
          -> TestEnv
          createFortranDocsList :: TestEnv -> Int -> ClientEnv -> Token -> WaiSession () CorpusId -> Int
          createFortranDocsList testEnv port clientEnv token = do -> ClientEnv
          -> 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"}|] ([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 "test-data/ngrams/GarganText_DocsList-nodeId-177.json") simpleDocs <- liftIO (TIO.readFile =<< getDataFileName testDataPath)
          let newWithForm = mkNewWithForm simpleDocs "GarganText_DocsList-nodeId-177.json" let newWithForm = mkNewWithForm simpleDocs (T.pack $ takeBaseName testDataPath)
          (j :: JobPollHandle) <- checkEither $ fmap toJobPollHandle <$> liftIO (runClientM (add_file_async token corpusId newWithForm) clientEnv) (j :: JobPollHandle) <- checkEither $ fmap toJobPollHandle <$> liftIO (runClientM (add_file_async token corpusId newWithForm) clientEnv)
          let mkPollUrl jh = "/corpus/" <> fromString (show $ _NodeId corpusId) <> "/add/form/async/" +|_jph_id jh|+ "/poll?limit=1" let mkPollUrl jh = "/corpus/" <> fromString (show $ _NodeId corpusId) <> "/add/form/async/" +|_jph_id jh|+ "/poll?limit=1"
          j' <- pollUntilFinished token port mkPollUrl j j' <- pollUntilFinished token port mkPollUrl j
          liftIO (_jph_status j' `shouldBe` "IsFinished") liftIO (_jph_status j' `shouldBe` "IsFinished")
          pure corpusId pure corpusId
          createFortranDocsList :: TestEnv -> Int -> ClientEnv -> Token -> WaiSession () CorpusId
          createFortranDocsList testEnv port =
          createDocsList "test-data/ngrams/GarganText_DocsList-nodeId-177.json" testEnv port
          updateNode :: Int -> ClientEnv -> Token -> NodeId -> WaiSession () () updateNode :: Int -> ClientEnv -> Token -> NodeId -> WaiSession () ()
          updateNode port clientEnv token nodeId = do updateNode port clientEnv token nodeId = do
          let params = UpdateNodeParamsTexts Both let params = UpdateNodeParamsTexts Both
          ......
          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