[tests] some more tests refactorings

test-data/test_config.toml

@@ -81,7 +81,7 @@ All = "corenlp://localhost:9000"
 default_visibility_timeout = 1
 
 # default delay before job is visible to the worker
-default_delay = 1
+default_delay = 0
 
 # NOTE This is overridden by Test.Database.Setup
 [worker.database]

test/Test/API/Authentication.hs

@@ -35,9 +35,7 @@ cannedToken :: T.Text
 cannedToken = "eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiaWQiOjF9fQ.t49zZSqkPAulEkYEh4pW17H2uwrkyPTdZKwHyG3KUJ0hzU2UUoPBNj8vdv087RCVBJ4tXgxNbP4j0RBv3gxdqg"
 
 tests :: Spec
-tests = sequential $ aroundAll withTestDBAndPort $ do
-  describe "Prelude" $ do
-    it "setup DB triggers" $ \SpecContext{..} -> setupEnvironment _sctx_env
+tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith (\ctx -> setupEnvironment (_sctx_env ctx) >>= (const $ pure ctx)) $ do
   describe "Authentication" $ do
     baseUrl <- runIO $ parseBaseUrl "http://localhost"
     manager <- runIO $ newManager defaultManagerSettings

test/Test/API/Errors.hs

@@ -16,7 +16,7 @@ import Servant.Auth.Client ()
 import Servant.Client
 import Servant.Client.Generic (genericClient)
 import Test.API.Routes (mkUrl)
-import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
+import Test.API.Setup (withTestDBAndPort, dbEnvSetup, SpecContext (..))
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication)
 import Test.Utils (protected, withValidLogin, protectedNewError)
@@ -24,26 +24,24 @@ import Text.RawString.QQ (r)
 
 
 tests :: Spec
-tests = sequential $ aroundAll withTestDBAndPort $ do
+tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
   describe "Errors API" $ do
     describe "Prelude" $ do
-      it "setup DB triggers and users" $ \(SpecContext testEnv port _app _) -> do
-        setupEnvironment testEnv
+      it "setup DB triggers and users" $ \ctx -> do
         baseUrl <- parseBaseUrl "http://localhost"
         manager <- newManager defaultManagerSettings
         let clientEnv prt = mkClientEnv manager (baseUrl { baseUrlPort = prt })
 
-        createAliceAndBob testEnv
-
         let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM))
             roots           = (getRootsEp . rootsEp $ gargAdminClient :: ClientM [Node HyperdataUser])
-        result <- liftIO $ runClientM roots (clientEnv port)
+        result <- liftIO $ runClientM roots (clientEnv $ _sctx_port ctx)
         length result `shouldBe` 0
 
     describe "GET /api/v1.0/node" $ do
 
-      it "returns the old error by default" $ \(SpecContext _testEnv port app _) -> do
-        withApplication app $ do
+      it "returns the old error by default" $ \ctx -> do
+        let port = _sctx_port ctx
+        withApplication (_sctx_app ctx) $ do
           withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
             res <- protected token "GET" (mkUrl port "/node/99") ""
             case res of
@@ -53,8 +51,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
                     statusCode `shouldBe` 404
                     simpleBody `shouldBe` [r|{"error":"Node does not exist","node":99}|]
 
-      it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \(SpecContext _testEnv port app _) -> do
-        withApplication app $ do
+      it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \ctx -> do
+        let port = _sctx_port ctx
+        withApplication (_sctx_app ctx) $ do
           withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
             res <- protectedNewError token "GET" (mkUrl port "/node/99") ""
             case res of

test/Test/API/GraphQL.hs

@@ -10,7 +10,7 @@ module Test.API.GraphQL (
 import Gargantext.Core.Types.Individu
 import Prelude
 import Servant.Auth.Client ()
-import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
+import Test.API.Setup (withTestDBAndPort, dbEnvSetup, SpecContext (..))
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication)
 import Test.Hspec.Wai.JSON (json)
@@ -18,15 +18,10 @@ import Test.Utils (protected, protectedNewError, shouldRespondWithFragment, shou
 import Text.RawString.QQ (r)
 
 tests :: Spec
-tests = sequential $ aroundAll withTestDBAndPort $ do
+tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
   describe "GraphQL" $ do
-    describe "Prelude" $ do
-      it "setup DB triggers" $ \SpecContext{..} -> setupEnvironment _sctx_env
-
     describe "get_user_infos" $ do
       it "allows 'alice' to see her own info" $ \(SpecContext testEnv port app _) -> do
-        createAliceAndBob testEnv
-
         withApplication app $ do
           withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
             let query = [r| { "query": "{ user_infos(user_id: 2) { ui_id, ui_email } }" } |]

test/Test/API/Private.hs

@@ -20,7 +20,7 @@ import Servant.Client.Generic (genericClient)
 import Test.API.Private.Share qualified as Share
 import Test.API.Private.Table qualified as Table
 import Test.API.Routes (mkUrl)
-import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob, SpecContext (..))
+import Test.API.Setup (withTestDBAndPort, dbEnvSetup, SpecContext (..))
 import Test.Hspec
 import Test.Hspec.Wai hiding (pendingWith)
 import Test.Hspec.Wai.Internal (withApplication)
@@ -38,20 +38,18 @@ privateTests =
     describe "GET /api/v1.0/user" $ do
 
       -- 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" $ \(SpecContext testEnv port _ _) -> do
-
-        createAliceAndBob testEnv
+      it "doesn't allow someone with an invalid token to show the results" $ \ctx -> do
 
         let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM))
             admin_user_api_get = (getRootsEp . rootsEp $ gargAdminClient :: ClientM [Node HyperdataUser])
 
-        result <- runClientM admin_user_api_get (unauthenticatedClientEnv port)
+        result <- runClientM admin_user_api_get (unauthenticatedClientEnv $ _sctx_port ctx)
         length result `shouldBe` 0
 
       -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
-      it "allows 'alice' to see the results" $ \(SpecContext _testEnv port _app _) -> do
+      it "allows 'alice' to see the results" $ \ctx -> do
 
-        withValidLogin port "alice" (GargPassword "alice") $ \clientEnv _token -> do
+        withValidLogin (_sctx_port ctx) "alice" (GargPassword "alice") $ \clientEnv _token -> do
           let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM))
               admin_user_api_get = (getRootsEp . rootsEp $ gargAdminClient :: ClientM [Node HyperdataUser])
 
@@ -60,43 +58,45 @@ privateTests =
 
     describe "GET /api/v1.0/node" $ do
 
-      it "unauthorised users shouldn't see anything" $ \(SpecContext _testEnv port app _) -> do
-        withApplication app $ do
-          get (mkUrl port "/node/1") `shouldRespondWith` 401
+      it "unauthorised users shouldn't see anything" $ \ctx -> do
+        withApplication (_sctx_app ctx) $ do
+          get (mkUrl (_sctx_port ctx) "/node/1") `shouldRespondWith` 401
 
-      it "allows 'alice' to see her own node info" $ \(SpecContext _testEnv port app _) -> do
-        withApplication app $ do
+      it "allows 'alice' to see her own node info" $ \ctx -> do
+        let port = _sctx_port ctx
+        withApplication (_sctx_app ctx) $ do
           withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
             protected token "GET" (mkUrl port "/node/8") ""
               `shouldRespondWithFragment` [json| {"id":8,"user_id":2,"name":"alice" } |]
 
-      it "forbids 'alice' to see others node private info" $ \(SpecContext _testEnv port app _) -> do
-        withApplication app $ do
+      it "forbids 'alice' to see others node private info" $ \ctx -> do
+        let port = _sctx_port ctx
+        withApplication (_sctx_app ctx) $ do
           withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
             protected token "GET" (mkUrl port "/node/1") "" `shouldRespondWith` 403
 
     describe "GET /api/v1.0/tree" $ do
-      it "unauthorised users shouldn't see anything" $ \(SpecContext _testEnv port app _) -> do
-        withApplication app $ do
-          get (mkUrl port "/tree/1") `shouldRespondWith` 401
+      it "unauthorised users shouldn't see anything" $ \ctx -> do
+        withApplication (_sctx_app ctx) $ do
+          get (mkUrl (_sctx_port ctx) "/tree/1") `shouldRespondWith` 401
 
-      it "allows 'alice' to see her own node info" $ \(SpecContext _testEnv port app _) -> do
-        withApplication app $ do
+      it "allows 'alice' to see her own node info" $ \ctx -> do
+        let port = _sctx_port ctx
+        withApplication (_sctx_app ctx) $ do
           withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
             protected token "GET" (mkUrl port "/tree/8") ""
               `shouldRespondWithFragment` [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |]
 
-      it "forbids 'alice' to see others node private info" $ \(SpecContext _testEnv port app _) -> do
-        withApplication app $ do
+      it "forbids 'alice' to see others node private info" $ \ctx -> do
+        let port = _sctx_port ctx
+        withApplication (_sctx_app ctx) $ do
           withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
             protected token "GET" (mkUrl port "/tree/1") "" `shouldRespondWith` 403
 
 
 tests :: Spec
 tests = do
-  sequential $ aroundAll withTestDBAndPort $ do
-    describe "Prelude" $ do
-      it "setup DB triggers" $ \SpecContext{..} -> setupEnvironment _sctx_env
+  sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
     privateTests
   describe "Share API" $ do
     Share.tests

test/Test/API/Private/Share.hs

@@ -20,7 +20,7 @@ import Prelude (fail)
 import Servant.Auth.Client qualified as SC
 import Servant.Client
 import Test.API.Routes
-import Test.API.Setup
+import Test.API.Setup (SpecContext(..), dbEnvSetup, withTestDBAndPort)
 import Test.API.UpdateList (newCorpusForUser)
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication)
@@ -41,13 +41,8 @@ shareURL token =
                & shareUrlEp
 
 tests :: Spec
-tests = sequential $ aroundAll withTestDBAndPort $ do
+tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
   describe "Prelude" $ do
-    it "setup DB triggers" $ \SpecContext{..} -> do
-      setupEnvironment _sctx_env
-      -- Let's create the Alice user.
-      createAliceAndBob _sctx_env
-
     it "should fail if no node type is specified" $ \(SpecContext _testEnv serverPort app _) -> do
       withApplication app $ do
         withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do

test/Test/API/Private/Table.hs

@@ -13,7 +13,7 @@ import Gargantext.Database.Query.Facet qualified as Facet
 import Gargantext.Prelude
 import Servant.Client
 import Test.API.Routes
-import Test.API.Setup
+import Test.API.Setup (SpecContext(..), dbEnvSetup, withTestDBAndPort)
 import Test.API.UpdateList (createDocsList, checkEither)
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication)
@@ -21,13 +21,8 @@ import Test.Utils
 
 
 tests :: Spec
-tests = sequential $ aroundAll withTestDBAndPort $ do
+tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ 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

test/Test/API/Setup.hs

@@ -7,6 +7,7 @@ module Test.API.Setup (
   , withBackendServerAndProxy
   , setupEnvironment
   , createAliceAndBob
+  , dbEnvSetup
   ) where
 
 import Control.Concurrent.Async qualified as Async
@@ -172,6 +173,14 @@ createAliceAndBob testEnv = do
     void $ new_user nur1
     void $ new_user nur2
 
+dbEnvSetup :: SpecContext a -> IO (SpecContext a)
+dbEnvSetup ctx = do
+  let testEnv = _sctx_env ctx
+  setupEnvironment testEnv
+  createAliceAndBob testEnv
+
+  pure ctx
+
 -- show the full exceptions during testing, rather than shallowing them under a generic
 -- "Something went wrong".
 showDebugExceptions :: SomeException -> Wai.Response

test/Test/API/UpdateList.hs

@@ -73,7 +73,7 @@ import Paths_gargantext (getDataFileName)
 import Servant.Client
 import System.FilePath
 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, setupEnvironment, createAliceAndBob, SpecContext (..))
+import Test.API.Setup (withTestDBAndPort, dbEnvSetup, SpecContext (..))
 import Test.Database.Types
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication, WaiSession)
@@ -131,14 +131,10 @@ uploadJSONList port token cId pathToNgrams clientEnv = do
   pure listId
 
 
--- tests :: D.Dispatcher -> Spec
+
 tests :: Spec
-tests = sequential $ aroundAll withTestDBAndPort $ do
+tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
   describe "UpdateList API" $ do
-    
-    it "setup DB triggers and users" $ \(SpecContext testEnv _port _app _) -> do
-      setupEnvironment testEnv
-      createAliceAndBob testEnv
 
     describe "POST /api/v1.0/lists/:id/add/form/async (JSON)" $ do
 

test/Test/Database/Operations.hs

@@ -49,9 +49,7 @@ uniqueArbitraryNewUser currentIx = do
    ascii_txt = fmap (T.pack . getPrintableString) arbitrary
 
 tests :: Spec
-tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
-  describe "Prelude" $ do
-    it "setup DB triggers" setupEnvironment
+tests = sequential $ aroundAll withTestDB $ beforeAllWith (\ctx -> setupEnvironment ctx >>= (const $ pure ctx)) $ describe "Database" $ do
   describe "Read/Writes" $ do
     describe "User creation" $ do
       it "Simple write/read" writeRead01

test/Test/Server/ReverseProxy.hs

@@ -26,9 +26,7 @@ tests = describe "Microservices proxy" $ do
   writeFrameTests
 
 writeFrameTests :: Spec
-writeFrameTests = sequential $ aroundAll withBackendServerAndProxy $ do
-  describe "Prelude" $ do
-    it "setup DB triggers" $ \(testEnv, _, _) -> setupEnvironment testEnv
+writeFrameTests = sequential $ aroundAll withBackendServerAndProxy $ beforeAllWith (\ctx@(testEnv, _, _) -> setupEnvironment testEnv >>= (const $ pure ctx)) $ do
   describe "Write Frame Reverse Proxy" $ do
     it "should disallow unauthenticated requests" $ \(_testEnv, _serverPort, proxyPort) -> do
       baseUrl <- parseBaseUrl "http://localhost"