diff --git a/server/lib/api-tests/test/Test/DataConnector/MetadataApiSpec.hs b/server/lib/api-tests/test/Test/DataConnector/MetadataApiSpec.hs index 7e391aad45e..ca3f21ea6d4 100644 --- a/server/lib/api-tests/test/Test/DataConnector/MetadataApiSpec.hs +++ b/server/lib/api-tests/test/Test/DataConnector/MetadataApiSpec.hs @@ -1,4 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} +-- For runWithLocalTestEnvironmentSingleSetup +{-# OPTIONS_GHC -Wno-deprecations #-} -- | Metadata API tests for Data Connector Backend module Test.DataConnector.MetadataApiSpec @@ -33,7 +35,7 @@ import Test.Hspec (SpecWith, describe, it, pendingWith) spec :: SpecWith TestEnvironment spec = do - Fixture.runWithLocalTestEnvironment + Fixture.runWithLocalTestEnvironmentSingleSetup ( NE.fromList [ (Fixture.fixture $ Fixture.Backend Fixture.DataConnectorReference) { Fixture.setupTeardown = \(testEnv, _) -> @@ -47,7 +49,7 @@ spec = do ) schemaCrudTests - Fixture.runWithLocalTestEnvironment + Fixture.runWithLocalTestEnvironmentSingleSetup ( NE.fromList [ (Fixture.fixture $ Fixture.Backend Fixture.DataConnectorReference) { Fixture.setupTeardown = \(testEnv, _) -> diff --git a/server/lib/api-tests/test/Test/EventTrigger/PG/EventTriggersRecreationSpec.hs b/server/lib/api-tests/test/Test/EventTrigger/PG/EventTriggersRecreationSpec.hs index f8f16ba4dd2..285e34b632b 100644 --- a/server/lib/api-tests/test/Test/EventTrigger/PG/EventTriggersRecreationSpec.hs +++ b/server/lib/api-tests/test/Test/EventTrigger/PG/EventTriggersRecreationSpec.hs @@ -1,4 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} +-- For runWithLocalTestEnvironmentSingleSetup +{-# OPTIONS_GHC -Wno-deprecations #-} module Test.EventTrigger.PG.EventTriggersRecreationSpec (spec) where @@ -22,7 +24,7 @@ import Test.Hspec (SpecWith, it) spec :: SpecWith TestEnvironment spec = - Fixture.runWithLocalTestEnvironment + Fixture.runWithLocalTestEnvironmentSingleSetup ( NE.fromList [ (Fixture.fixture $ Fixture.Backend Fixture.Postgres) { Fixture.mkLocalTestEnvironment = webhookServerMkLocalTestEnvironment, diff --git a/server/lib/api-tests/test/Test/EventTrigger/PG/EventTriggersRunSQLSpec.hs b/server/lib/api-tests/test/Test/EventTrigger/PG/EventTriggersRunSQLSpec.hs index a372a8e3c4b..58ddd080f7b 100644 --- a/server/lib/api-tests/test/Test/EventTrigger/PG/EventTriggersRunSQLSpec.hs +++ b/server/lib/api-tests/test/Test/EventTrigger/PG/EventTriggersRunSQLSpec.hs @@ -1,5 +1,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ViewPatterns #-} +-- For runWithLocalTestEnvironmentSingleSetup +{-# OPTIONS_GHC -Wno-deprecations #-} -- | Testing the `run_sql` API module Test.EventTrigger.PG.EventTriggersRunSQLSpec (spec) where @@ -29,7 +31,7 @@ import Test.Hspec (SpecWith, it, shouldBe) spec :: SpecWith TestEnvironment spec = - Fixture.runWithLocalTestEnvironment + Fixture.runWithLocalTestEnvironmentSingleSetup ( NE.fromList [ (Fixture.fixture $ Fixture.Backend Fixture.Postgres) { -- setup the webhook server as the local test environment, diff --git a/server/lib/api-tests/test/Test/Postgres/DefaultValuesSpec.hs b/server/lib/api-tests/test/Test/Postgres/DefaultValuesSpec.hs index 6c9390de0a1..cffef18d3ee 100644 --- a/server/lib/api-tests/test/Test/Postgres/DefaultValuesSpec.hs +++ b/server/lib/api-tests/test/Test/Postgres/DefaultValuesSpec.hs @@ -1,4 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} +-- For runWithLocalTestEnvironmentSingleSetup +{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Tests for the behaviour of columns with default values. @@ -23,7 +25,7 @@ import Test.Hspec (SpecWith, describe, it) spec :: SpecWith TestEnvironment spec = - Fixture.run + Fixture.runSingleSetup ( NE.fromList [ (Fixture.fixture $ Fixture.Backend Fixture.Postgres) { Fixture.setupTeardown = \(testEnv, _) -> diff --git a/server/lib/api-tests/test/Test/RemoteRelationship/FromRemoteSchemaSpec.hs b/server/lib/api-tests/test/Test/RemoteRelationship/FromRemoteSchemaSpec.hs index 91bd7369742..c1bae41d4a6 100644 --- a/server/lib/api-tests/test/Test/RemoteRelationship/FromRemoteSchemaSpec.hs +++ b/server/lib/api-tests/test/Test/RemoteRelationship/FromRemoteSchemaSpec.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE QuasiQuotes #-} +-- For runWithLocalTestEnvironmentSingleSetup +{-# OPTIONS_GHC -Wno-deprecations #-} -- | Tests for remote relationships from remote schemas. Unlike the "ToX" -- modules, this module specifically cares about the remote schema on the LHS: @@ -29,7 +31,7 @@ import Test.Hspec (SpecWith, describe, it) -- Preamble spec :: SpecWith TestEnvironment -spec = Fixture.runWithLocalTestEnvironment (NE.fromList [context]) tests +spec = Fixture.runWithLocalTestEnvironmentSingleSetup (NE.fromList [context]) tests where context = (Fixture.fixture $ Fixture.RemoteGraphQLServer) diff --git a/server/lib/api-tests/test/Test/RemoteRelationship/MetadataAPI/DropSource/DBtoDBRelationshipSpec.hs b/server/lib/api-tests/test/Test/RemoteRelationship/MetadataAPI/DropSource/DBtoDBRelationshipSpec.hs index fbaa71ec4d0..2c18a04c6b6 100644 --- a/server/lib/api-tests/test/Test/RemoteRelationship/MetadataAPI/DropSource/DBtoDBRelationshipSpec.hs +++ b/server/lib/api-tests/test/Test/RemoteRelationship/MetadataAPI/DropSource/DBtoDBRelationshipSpec.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE QuasiQuotes #-} +-- For runWithLocalTestEnvironmentSingleSetup +{-# OPTIONS_GHC -Wno-deprecations #-} -- | Test that drop_source metadata API executes successfully when any remote -- relationships is present between a database and a database. @@ -46,7 +48,7 @@ import Test.RemoteRelationship.MetadataAPI.Common (LocalTestTestEnvironment (..) -- Preamble spec :: SpecWith TestEnvironment -spec = Fixture.runWithLocalTestEnvironment contexts tests +spec = Fixture.runWithLocalTestEnvironmentSingleSetup contexts tests where contexts = NE.fromList [dbTodbRemoteRelationshipFixture] diff --git a/server/lib/api-tests/test/Test/RemoteRelationship/MetadataAPI/DropSource/RSToDBRelationshipSpec.hs b/server/lib/api-tests/test/Test/RemoteRelationship/MetadataAPI/DropSource/RSToDBRelationshipSpec.hs index e41a247f7cc..236ccbbdf6a 100644 --- a/server/lib/api-tests/test/Test/RemoteRelationship/MetadataAPI/DropSource/RSToDBRelationshipSpec.hs +++ b/server/lib/api-tests/test/Test/RemoteRelationship/MetadataAPI/DropSource/RSToDBRelationshipSpec.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE QuasiQuotes #-} +-- For runWithLocalTestEnvironmentSingleSetup +{-# OPTIONS_GHC -Wno-deprecations #-} -- | Test that drop_source metadata API executes successfully when any remote -- relationships is present between a remote schema and a database. @@ -46,7 +48,7 @@ import Test.RemoteRelationship.MetadataAPI.Common (LocalTestTestEnvironment (..) -- Preamble spec :: SpecWith TestEnvironment -spec = Fixture.runWithLocalTestEnvironment contexts tests +spec = Fixture.runWithLocalTestEnvironmentSingleSetup contexts tests where contexts = NE.fromList [remoteSchemaToDBRemoteRelationshipFixture] diff --git a/server/lib/api-tests/test/Test/SQLServer/DefaultValuesSpec.hs b/server/lib/api-tests/test/Test/SQLServer/DefaultValuesSpec.hs index 873d5ba0ce8..b8a9c39e6b4 100644 --- a/server/lib/api-tests/test/Test/SQLServer/DefaultValuesSpec.hs +++ b/server/lib/api-tests/test/Test/SQLServer/DefaultValuesSpec.hs @@ -1,4 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} +-- For runWithLocalTestEnvironmentSingleSetup +{-# OPTIONS_GHC -Wno-deprecations #-} -- | Test that Postgres databases correctly roundtrip timestamps. -- @@ -20,7 +22,7 @@ import Test.Hspec (SpecWith, describe, it) spec :: SpecWith TestEnvironment spec = - Fixture.run + Fixture.runSingleSetup ( NE.fromList [ (Fixture.fixture $ Fixture.Backend Fixture.SQLServer) { Fixture.setupTeardown = \(testEnv, _) -> diff --git a/server/lib/api-tests/test/Test/Schema/CustomFieldNames/MutationSpec.hs b/server/lib/api-tests/test/Test/Schema/CustomFieldNames/MutationSpec.hs index 8c7042f110a..ac2a5d65790 100644 --- a/server/lib/api-tests/test/Test/Schema/CustomFieldNames/MutationSpec.hs +++ b/server/lib/api-tests/test/Test/Schema/CustomFieldNames/MutationSpec.hs @@ -1,4 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} +-- For runWithLocalTestEnvironmentSingleSetup +{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Tests around mutations involving fields with custom names. @@ -27,7 +29,7 @@ import Prelude spec :: SpecWith TestEnvironment spec = do - Fixture.run + Fixture.runSingleSetup ( NE.fromList [ (Fixture.fixture $ Fixture.Backend Fixture.Postgres) { Fixture.setupTeardown = \(testEnv, _) -> diff --git a/server/lib/test-harness/src/Harness/Test/Fixture.hs b/server/lib/test-harness/src/Harness/Test/Fixture.hs index 46b44abd6a5..f644ce1403c 100644 --- a/server/lib/test-harness/src/Harness/Test/Fixture.hs +++ b/server/lib/test-harness/src/Harness/Test/Fixture.hs @@ -4,7 +4,9 @@ -- Central types and functions are 'Fixture', 'SetupAction', and 'run'. module Harness.Test.Fixture ( run, + runSingleSetup, runWithLocalTestEnvironment, + runWithLocalTestEnvironmentSingleSetup, Fixture (..), fixture, FixtureName (..), @@ -28,7 +30,15 @@ import Harness.Test.BackendType import Harness.Test.CustomOptions import Harness.TestEnvironment (TestEnvironment (..), testLog) import Hasura.Prelude -import Test.Hspec (SpecWith, aroundAllWith, aroundWith, beforeWith, describe, pendingWith) +import Test.Hspec + ( ActionWith, + SpecWith, + aroundAllWith, + aroundWith, + beforeWith, + describe, + pendingWith, + ) -- | Runs the given tests, for each provided 'Fixture'@ ()@. -- @@ -43,10 +53,17 @@ import Test.Hspec (SpecWith, aroundAllWith, aroundWith, beforeWith, describe, pe -- -- For a more general version that can run tests for any 'Fixture'@ a@, see -- 'runWithLocalTestEnvironment'. +-- +-- This function runs setup and teardown for each Spec item individually. run :: NonEmpty (Fixture ()) -> (Options -> SpecWith TestEnvironment) -> SpecWith TestEnvironment run fixtures tests = do runWithLocalTestEnvironment fixtures (\opts -> beforeWith (\(te, ()) -> return te) (tests opts)) +{-# DEPRECATED runSingleSetup "runSingleSetup lets all specs in aFixture share a single database environment, which impedes parallelisation and out-of-order execution." #-} +runSingleSetup :: NonEmpty (Fixture ()) -> (Options -> SpecWith TestEnvironment) -> SpecWith TestEnvironment +runSingleSetup fixtures tests = do + runWithLocalTestEnvironmentSingleSetup fixtures (\opts -> beforeWith (\(te, ()) -> return te) (tests opts)) + -- | Runs the given tests, for each provided 'Fixture'@ a@. -- -- Each 'Fixture' provides a list of 'SetupActions'; @@ -56,27 +73,45 @@ run fixtures tests = do -- 'Fixture's are parameterized by the type of local testEnvironment that needs -- to be carried throughout the tests. -- +-- This function runs setup and teardown for each Spec item individually. +-- -- See 'Fixture' for details. runWithLocalTestEnvironment :: forall a. NonEmpty (Fixture a) -> (Options -> SpecWith (TestEnvironment, a)) -> SpecWith TestEnvironment -runWithLocalTestEnvironment fixtures tests = - for_ fixtures \context -> do - let n = name context - co = customOptions context +runWithLocalTestEnvironment = runWithLocalTestEnvironmentInternal aroundWith + +{-# DEPRECATED runWithLocalTestEnvironmentSingleSetup "runWithLocalTestEnvironmentSingleSetup lets all specs in a Fixture share a single database environment, which impedes parallelisation and out-of-order execution." #-} +runWithLocalTestEnvironmentSingleSetup :: + forall a. + NonEmpty (Fixture a) -> + (Options -> SpecWith (TestEnvironment, a)) -> + SpecWith TestEnvironment +runWithLocalTestEnvironmentSingleSetup = runWithLocalTestEnvironmentInternal aroundAllWith + +runWithLocalTestEnvironmentInternal :: + forall a. + ((ActionWith (TestEnvironment, a) -> ActionWith (TestEnvironment)) -> SpecWith (TestEnvironment, a) -> SpecWith (TestEnvironment)) -> + NonEmpty (Fixture a) -> + (Options -> SpecWith (TestEnvironment, a)) -> + SpecWith TestEnvironment +runWithLocalTestEnvironmentInternal aroundSomeWith fixtures tests = + for_ fixtures \fixture' -> do + let n = name fixture' + co = customOptions fixture' options = fromMaybe defaultOptions co case skipTests options of Just skipMsg -> - describe (show n) $ aroundWith (\_ _ -> pendingWith $ "Tests skipped: " <> T.unpack skipMsg) (tests options) + describe (show n) $ aroundSomeWith (\_ _ -> pendingWith $ "Tests skipped: " <> T.unpack skipMsg) (tests options) Nothing -> - describe (show n) $ aroundAllWith (fixtureBracket context) (tests options) + describe (show n) $ aroundSomeWith (fixtureBracket fixture') (tests options) -- We want to be able to report exceptions happening both during the tests -- and at teardown, which is why we use a custom re-implementation of -- @bracket@. -fixtureBracket :: Fixture b -> ((TestEnvironment, b) -> IO a) -> TestEnvironment -> IO () +fixtureBracket :: Fixture b -> (ActionWith (TestEnvironment, b)) -> ActionWith TestEnvironment fixtureBracket Fixture {name, mkLocalTestEnvironment, setupTeardown} actionWith globalTestEnvironment = mask \restore -> do -- log DB of test