diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 6f62962cdf5..1fc816c283c 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -1097,7 +1097,7 @@ test-suite graphql-engine-tests Test.QuickCheck.Extended test-suite tests-hspec - import: common-all + import: common-all, lib-depends type: exitcode-stdio-1.0 build-tool-depends: hspec-discover:hspec-discover build-depends: @@ -1116,6 +1116,7 @@ test-suite tests-hspec , dependent-map , dependent-sum , ekg-core + , fast-logger , dc-api , graphql-engine , graphql-parser @@ -1182,7 +1183,14 @@ test-suite tests-hspec , warp , websockets , yaml + + if !flag(ghci-load-test-with-lib) + build-depends: graphql-engine + hs-source-dirs: tests-hspec + if flag(ghci-load-test-with-lib) + hs-source-dirs: src-lib + -- Turning off optimizations is intentional; tests aren't -- performance sensitive and waiting for compilation is a problem. ghc-options: @@ -1239,11 +1247,11 @@ test-suite tests-hspec Test.BigQuery.TypeInterpretationSpec Test.CustomFieldNamesSpec Test.CustomRootFieldsSpec + Test.DataConnector.AggregateQuerySpec Test.DataConnector.MockAgent.AggregateQuerySpec Test.DataConnector.MockAgent.BasicQuerySpec - Test.DataConnector.MockAgent.TransformedConfigurationSpec Test.DataConnector.MockAgent.QueryRelationshipsSpec - Test.DataConnector.AggregateQuerySpec + Test.DataConnector.MockAgent.TransformedConfigurationSpec Test.DataConnector.QuerySpec Test.DataConnector.SelectPermissionsSpec Test.DisableRootFields.Common @@ -1253,12 +1261,13 @@ test-suite tests-hspec Test.DisableRootFields.SelectPermission.EnableAggSpec Test.DisableRootFields.SelectPermission.EnableAllRootFieldsSpec Test.DisableRootFields.SelectPermission.EnablePKSpec + Test.EventTrigger.EventTriggerDropSourceCleanupSpec + Test.EventTrigger.EventTriggersMSSQLUntrackTableCleanupSpec + Test.EventTrigger.EventTriggersPGUntrackTableCleanupSpec Test.EventTrigger.EventTriggersRecreationSpec Test.EventTrigger.EventTriggersRunSQLSpec - Test.EventTrigger.EventTriggerDropSourceCleanupSpec - Test.EventTrigger.EventTriggersPGUntrackTableCleanupSpec - Test.EventTrigger.EventTriggersMSSQLUntrackTableCleanupSpec Test.GatheringUniqueConstraintsSpec + Test.HelloWorldSpec Test.InsertCheckPermissionSpec Test.InsertDefaultsSpec Test.InsertOnConflictSpec @@ -1267,10 +1276,10 @@ test-suite tests-hspec Test.ObjectRelationshipsLimitSpec Test.Postgres.EnumSpec Test.Postgres.TimestampSpec - Test.Queries.DirectivesSpec - Test.Queries.Directives.IncludeSpec Test.Queries.Directives.IncludeAndSkipSpec + Test.Queries.Directives.IncludeSpec Test.Queries.Directives.SkipSpec + Test.Queries.DirectivesSpec Test.Queries.FilterSearchSpec Test.Queries.NestedObjectSpec Test.Queries.Paginate.LimitSpec @@ -1279,6 +1288,8 @@ test-suite tests-hspec Test.Queries.Simple.OperationNameSpec Test.Queries.Simple.PrimaryKeySpec Test.Queries.SortSpec + Test.Queries.SortSpec + Test.Quoter.YamlSpec Test.RemoteRelationship.FromRemoteSchemaSpec Test.RemoteRelationship.MetadataAPI.ClearMetadataSpec Test.RemoteRelationship.MetadataAPI.Common @@ -1289,14 +1300,17 @@ test-suite tests-hspec Test.RemoteRelationship.XToRemoteSchemaRelationshipSpec Test.RequestHeadersSpec Test.RunSQLSpec - Test.Schema.TableRelationships.ArrayRelationshipsSpec - Test.Schema.TableRelationships.ObjectRelationshipsSpec + Test.SQLServer.InsertVarcharColumnSpec + Test.SQLServer.InsertVarcharColumnSpec + Test.SQLServer.InsertVarcharColumnSpec + Test.Schema.DataValidation.PermissionSpec + Test.Schema.DataValidation.PermissionSpec Test.Schema.DataValidation.PermissionSpec Test.Schema.DefaultValuesSpec - Test.SQLServer.InsertVarcharColumnSpec + Test.Schema.TableRelationships.ArrayRelationshipsSpec + Test.Schema.TableRelationships.ObjectRelationshipsSpec Test.ServiceLivenessSpec Test.ViewsSpec - Test.Quoter.YamlSpec test-suite tests-dc-api import: common-all, common-exe diff --git a/server/tests-hspec/Harness/Backend/Citus.hs b/server/tests-hspec/Harness/Backend/Citus.hs index ea835d6929d..b94dc17174d 100644 --- a/server/tests-hspec/Harness/Backend/Citus.hs +++ b/server/tests-hspec/Harness/Backend/Citus.hs @@ -26,11 +26,8 @@ where import Control.Concurrent.Extended (sleep) import Control.Monad.Reader import Data.Aeson (Value) -import Data.Bool (bool) import Data.ByteString.Char8 qualified as S8 -import Data.Foldable (for_) -import Data.String -import Data.Text (Text, pack, replace) +import Data.String (fromString) import Data.Text qualified as T import Data.Text.Extended (commaSeparated) import Data.Time (defaultTimeLocale, formatTime) @@ -45,9 +42,8 @@ import Harness.Test.Permissions qualified as Permissions import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..)) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) -import Hasura.Prelude (tshow) +import Hasura.Prelude import System.Process.Typed -import Prelude -- | Check the citus server is live and ready to accept connections. livenessCheck :: HasCallStack => IO () @@ -196,8 +192,8 @@ wrapIdentifier identifier = "\"" <> identifier <> "\"" serialize :: ScalarValue -> Text serialize = \case VInt i -> tshow i - VStr s -> "'" <> replace "'" "\'" s <> "'" - VUTCTime t -> pack $ formatTime defaultTimeLocale "'%F %T'" t + VStr s -> "'" <> T.replace "'" "\'" s <> "'" + VUTCTime t -> T.pack $ formatTime defaultTimeLocale "'%F %T'" t VBool b -> if b then "TRUE" else "FALSE" VNull -> "NULL" VCustomValue bsv -> Schema.formatBackendScalarValueType $ Schema.backendScalarValue bsv bsvCitus diff --git a/server/tests-hspec/Harness/Backend/Mysql.hs b/server/tests-hspec/Harness/Backend/Mysql.hs index 70c71fed2f9..645c88a24c8 100644 --- a/server/tests-hspec/Harness/Backend/Mysql.hs +++ b/server/tests-hspec/Harness/Backend/Mysql.hs @@ -23,10 +23,7 @@ where import Control.Concurrent.Extended (sleep) import Control.Monad.Reader import Data.Aeson (Value) -import Data.Bool (bool) -import Data.Foldable (for_) -import Data.String -import Data.Text (Text, pack, replace) +import Data.String (fromString) import Data.Text qualified as T import Data.Text.Extended (commaSeparated) import Data.Time (defaultTimeLocale, formatTime) @@ -41,9 +38,8 @@ import Harness.Test.Permissions qualified as Permissions import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..)) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) -import Hasura.Prelude (tshow) +import Hasura.Prelude import System.Process.Typed -import Prelude -- | Check that the MySQL service is live and ready to accept connections. livenessCheck :: HasCallStack => IO () @@ -182,8 +178,8 @@ insertTable Schema.Table {tableName, tableColumns, tableData} serialize :: ScalarValue -> Text serialize = \case VInt i -> tshow i - VStr s -> "'" <> replace "'" "\'" s <> "'" - VUTCTime t -> pack $ formatTime defaultTimeLocale "'%F %T'" t + VStr s -> "'" <> T.replace "'" "\'" s <> "'" + VUTCTime t -> T.pack $ formatTime defaultTimeLocale "'%F %T'" t VBool b -> tshow @Int $ if b then 1 else 0 VNull -> "NULL" VCustomValue bsv -> Schema.formatBackendScalarValueType $ Schema.backendScalarValue bsv bsvMysql diff --git a/server/tests-hspec/Harness/Backend/Postgres.hs b/server/tests-hspec/Harness/Backend/Postgres.hs index 0cdb00cd638..becf434ebb0 100644 --- a/server/tests-hspec/Harness/Backend/Postgres.hs +++ b/server/tests-hspec/Harness/Backend/Postgres.hs @@ -26,11 +26,8 @@ where import Control.Concurrent.Extended (sleep) import Control.Monad.Reader import Data.Aeson (Value) -import Data.Bool (bool) import Data.ByteString.Char8 qualified as S8 -import Data.Foldable (for_) -import Data.String -import Data.Text (Text, pack, replace) +import Data.String (fromString) import Data.Text qualified as T import Data.Text.Extended (commaSeparated) import Data.Time (defaultTimeLocale, formatTime) @@ -45,9 +42,8 @@ import Harness.Test.Permissions qualified as Permissions import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..)) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) -import Hasura.Prelude (tshow) +import Hasura.Prelude import System.Process.Typed -import Prelude -- | Check the postgres server is live and ready to accept connections. livenessCheck :: HasCallStack => IO () @@ -206,8 +202,8 @@ wrapIdentifier identifier = "\"" <> identifier <> "\"" serialize :: ScalarValue -> Text serialize = \case VInt i -> tshow i - VStr s -> "'" <> replace "'" "\'" s <> "'" - VUTCTime t -> pack $ formatTime defaultTimeLocale "'%F %T'" t + VStr s -> "'" <> T.replace "'" "\'" s <> "'" + VUTCTime t -> T.pack $ formatTime defaultTimeLocale "'%F %T'" t VBool b -> if b then "TRUE" else "FALSE" VNull -> "NULL" VCustomValue bsv -> Schema.formatBackendScalarValueType $ Schema.backendScalarValue bsv bsvPostgres diff --git a/server/tests-hspec/Harness/Backend/Sqlserver.hs b/server/tests-hspec/Harness/Backend/Sqlserver.hs index 61fccb6e1ea..dad1a6473c1 100644 --- a/server/tests-hspec/Harness/Backend/Sqlserver.hs +++ b/server/tests-hspec/Harness/Backend/Sqlserver.hs @@ -24,11 +24,8 @@ where import Control.Concurrent.Extended (sleep) import Control.Monad.Reader import Data.Aeson (Value) -import Data.Bool (bool) -import Data.Foldable (for_) -import Data.String -import Data.Text (Text, pack, replace) -import Data.Text qualified as T (pack, unpack, unwords) +import Data.String (fromString) +import Data.Text qualified as T import Data.Text.Extended (commaSeparated) import Data.Time (defaultTimeLocale, formatTime) import Database.ODBC.SQLServer qualified as Sqlserver @@ -42,9 +39,8 @@ import Harness.Test.Permissions qualified as Permissions import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..)) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) -import Hasura.Prelude (tshow) +import Hasura.Prelude import System.Process.Typed -import Prelude -- | Check that the SQLServer service is live and ready to accept connections. livenessCheck :: HasCallStack => IO () @@ -202,8 +198,8 @@ wrapIdentifier identifier = "[" <> identifier <> "]" serialize :: ScalarValue -> Text serialize = \case VInt i -> tshow i - VStr s -> "'" <> replace "'" "\'" s <> "'" - VUTCTime t -> pack $ formatTime defaultTimeLocale "'%F %T'" t + VStr s -> "'" <> T.replace "'" "\'" s <> "'" + VUTCTime t -> T.pack $ formatTime defaultTimeLocale "'%F %T'" t VBool b -> tshow @Int $ if b then 1 else 0 VNull -> "NULL" VCustomValue bsv -> Schema.formatBackendScalarValueType $ Schema.backendScalarValue bsv bsvMssql diff --git a/server/tests-hspec/Harness/Quoter/Graphql.hs b/server/tests-hspec/Harness/Quoter/Graphql.hs index 56505b1d1a7..01d293db9bc 100644 --- a/server/tests-hspec/Harness/Quoter/Graphql.hs +++ b/server/tests-hspec/Harness/Quoter/Graphql.hs @@ -4,14 +4,14 @@ -- Interpolation works via the #{expression} syntax. module Harness.Quoter.Graphql (graphql, ToGraphqlString (..)) where -import Data.Bifunctor (first) +import Data.Bifunctor qualified as Bifunctor import Data.String (fromString) +import Hasura.Prelude import Language.Haskell.Meta (parseExp) import Language.Haskell.TH import Language.Haskell.TH.Quote import Text.Parsec qualified as P import Text.Parsec.String (Parser) -import Prelude -- | a class for values that can be interpolated in GraphQL queries class ToGraphqlString a where @@ -54,7 +54,7 @@ evalGraphql txt = Right result -> interpret result parseInterpolatedGQL :: String -> Either String [GraphqlPart] -parseInterpolatedGQL = first show . P.parse parseParts "graphqlQQ" +parseInterpolatedGQL = Bifunctor.first show . P.parse parseParts "graphqlQQ" where -- This can probably be made more succinct. We start by trying to parse -- an interpolated expression, then we try to parse a comment. The reasoning diff --git a/server/tests-hspec/Harness/Quoter/Sql.hs b/server/tests-hspec/Harness/Quoter/Sql.hs index 4c7f2faccb1..a062af70685 100644 --- a/server/tests-hspec/Harness/Quoter/Sql.hs +++ b/server/tests-hspec/Harness/Quoter/Sql.hs @@ -3,9 +3,9 @@ -- syntax highlighting. module Harness.Quoter.Sql (sql) where +import Hasura.Prelude import Language.Haskell.TH import Language.Haskell.TH.Quote -import Prelude sql :: QuasiQuoter sql = diff --git a/server/tests-hspec/Harness/Quoter/Yaml.hs b/server/tests-hspec/Harness/Quoter/Yaml.hs index 1bf137b7a4c..52cc66edd0c 100644 --- a/server/tests-hspec/Harness/Quoter/Yaml.hs +++ b/server/tests-hspec/Harness/Quoter/Yaml.hs @@ -16,7 +16,6 @@ import Control.Exception.Safe (Exception, impureThrow, throwM) import Control.Monad.Identity import Control.Monad.Trans.Resource (ResourceT) import Data.Aeson (Value) -import Data.Aeson qualified import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KM import Data.Aeson.KeyMap.Extended qualified as KM @@ -32,6 +31,7 @@ import Data.Yaml qualified import Data.Yaml.Internal qualified import Harness.Quoter.Yaml.InterpolateYaml import Harness.Test.Context qualified as Context (Options (..)) +import Hasura.Prelude import Instances.TH.Lift () import Language.Haskell.TH import Language.Haskell.TH.Lift (Lift) @@ -40,7 +40,6 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..)) import System.IO.Unsafe (unsafePerformIO) import Test.Hspec (HasCallStack, shouldBe, shouldContain) import Text.Libyaml qualified as Libyaml -import Prelude ------------------------------------------------------------------- @@ -159,7 +158,7 @@ processor = [| Data.Yaml.Internal.objToEvents Data.Yaml.Internal.defaultStringStyle - (Data.Aeson.toJSON $(varE (mkName anchorName))) + (Aeson.toJSON $(varE (mkName anchorName))) [] |] -- We disable anchors because aliases are used only to refer to diff --git a/server/tests-hspec/Harness/Quoter/Yaml/InterpolateYaml.hs b/server/tests-hspec/Harness/Quoter/Yaml/InterpolateYaml.hs index 3b7cb1b4784..109330336b8 100644 --- a/server/tests-hspec/Harness/Quoter/Yaml/InterpolateYaml.hs +++ b/server/tests-hspec/Harness/Quoter/Yaml/InterpolateYaml.hs @@ -10,19 +10,18 @@ where import Control.Exception.Safe (impureThrow) import Data.Aeson qualified as Aeson -import Data.Bifunctor +import Data.Bifunctor qualified as Bifunctor import Data.String import Data.Text qualified as T import Data.Text.Encoding (encodeUtf8) import Data.Yaml qualified +import Hasura.Prelude import Instances.TH.Lift () import Language.Haskell.Meta (parseExp) import Language.Haskell.TH import Language.Haskell.TH.Quote (QuasiQuoter (..)) -import Text.Parsec ((<|>)) import Text.Parsec qualified as P import Text.Parsec.String (Parser) -import Prelude -- | a class for values that can be interpolated in Yaml strings class ToYamlString a where @@ -73,7 +72,7 @@ evalInterpolation txt = interpret result parseInterpolated :: String -> Either String [InterpolatePart] -parseInterpolated = first show . P.parse parseParts "yamlQQ" +parseInterpolated = Bifunctor.first show . P.parse parseParts "yamlQQ" where -- This can probably be made more succinct. We start by trying to parse -- an interpolated expression, then we try to parse a comment. The reasoning diff --git a/server/tests-hspec/Harness/RemoteServer.hs b/server/tests-hspec/Harness/RemoteServer.hs index b8b0b0f956e..ff9100c9762 100644 --- a/server/tests-hspec/Harness/RemoteServer.hs +++ b/server/tests-hspec/Harness/RemoteServer.hs @@ -11,7 +11,6 @@ where import Control.Concurrent (forkIO) import Control.Exception.Safe (bracket) -import Control.Monad.IO.Class (liftIO) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as Lazy (ByteString) import Data.Morpheus qualified as Morpheus (interpreter) @@ -26,11 +25,11 @@ import Data.Morpheus.Types ) import Harness.Http qualified as Http import Harness.TestEnvironment (Server (..), serverUrl) +import Hasura.Prelude import Network.Socket qualified as Socket import Network.Wai.Extended qualified as Wai import Network.Wai.Handler.Warp qualified as Warp import Web.Spock.Core qualified as Spock -import Prelude ------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Harness/Test/BackendType.hs b/server/tests-hspec/Harness/Test/BackendType.hs index 6de59b468d3..70b4a9d562c 100644 --- a/server/tests-hspec/Harness/Test/BackendType.hs +++ b/server/tests-hspec/Harness/Test/BackendType.hs @@ -10,7 +10,7 @@ where import Data.Aeson.Key (Key) import Harness.Constants qualified as Constants (bigqueryDataset, citusDb, dataConnectorDb, mysqlDb, postgresDb, sqlserverDb) -import Prelude +import Hasura.Prelude -- | A supported backend type. data BackendType diff --git a/server/tests-hspec/Harness/Test/Context.hs b/server/tests-hspec/Harness/Test/Context.hs index 5115809bfcf..28d94088246 100644 --- a/server/tests-hspec/Harness/Test/Context.hs +++ b/server/tests-hspec/Harness/Test/Context.hs @@ -48,7 +48,7 @@ import Test.Hspec.Core.Spec (mapSpecItem) -- -- For a more general version that can run tests for any 'Context'@ a@, see -- 'runWithLocalTestEnvironment'. -run :: [Context ()] -> (Options -> SpecWith TestEnvironment) -> SpecWith TestEnvironment +run :: NonEmpty (Context ()) -> (Options -> SpecWith TestEnvironment) -> SpecWith TestEnvironment run contexts tests = do let mappedTests opts = mapSpecItem @@ -82,7 +82,7 @@ actionWithTestEnvironmentMapping actionWith (testEnvironment, _) = actionWith te -- See 'Context' for details. runWithLocalTestEnvironment :: forall a. - [Context a] -> + NonEmpty (Context a) -> (Options -> SpecWith (TestEnvironment, a)) -> SpecWith TestEnvironment runWithLocalTestEnvironment contexts tests = diff --git a/server/tests-hspec/Harness/Test/Hspec/Extended.hs b/server/tests-hspec/Harness/Test/Hspec/Extended.hs index 77a0d8253eb..dd2994b50be 100644 --- a/server/tests-hspec/Harness/Test/Hspec/Extended.hs +++ b/server/tests-hspec/Harness/Test/Hspec/Extended.hs @@ -4,9 +4,9 @@ module Harness.Test.Hspec.Extended ) where +import Hasura.Prelude import Test.Hspec import Test.Hspec.Core.Spec -import Prelude -- | Modify an 'Item'@ a@ by way of mapping its 'ActionWith'@ a@ function to -- some 'ActionWith'@ b@, producing an 'Item'@ b@. diff --git a/server/tests-hspec/Harness/Test/Permissions.hs b/server/tests-hspec/Harness/Test/Permissions.hs index 19bcabd0261..f75059b9b50 100644 --- a/server/tests-hspec/Harness/Test/Permissions.hs +++ b/server/tests-hspec/Harness/Test/Permissions.hs @@ -14,11 +14,10 @@ module Harness.Test.Permissions ) where -import Data.Text (Text) import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Yaml (yaml) import Harness.TestEnvironment -import Prelude +import Hasura.Prelude -- | Data type used to model permissions to be setup in tests. -- Each case of this type mirrors the fields in the correspond permission diff --git a/server/tests-hspec/Harness/Test/Schema.hs b/server/tests-hspec/Harness/Test/Schema.hs index 9c66729160c..a3850d20445 100644 --- a/server/tests-hspec/Harness/Test/Schema.hs +++ b/server/tests-hspec/Harness/Test/Schema.hs @@ -40,8 +40,7 @@ import Data.Aeson (.=), ) import Data.Aeson.Key qualified as K -import Data.Foldable (for_) -import Data.Text (Text, pack) +import Data.Text qualified as T import Data.Time (UTCTime, defaultTimeLocale) import Data.Time.Format (parseTimeOrError) import Harness.Exceptions @@ -49,7 +48,7 @@ import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Yaml (yaml) import Harness.Test.Context (BackendType, defaultBackendTypeString, defaultSchema, defaultSource, schemaKeyword) import Harness.TestEnvironment (TestEnvironment) -import Prelude +import Hasura.Prelude -- | Generic type to use to specify schema tables for all backends. -- Usually a list of these make up a "schema" to pass to the respective @@ -302,7 +301,7 @@ trackObjectRelationships backend Table {tableName, tableReferences, tableManualR schema = defaultSchema backend tableObj = object - [ schemaKeyword backend .= String (pack schema), + [ schemaKeyword backend .= String (T.pack schema), "name" .= String tableName ] requestType = source <> "_create_object_relationship" @@ -323,7 +322,7 @@ args: let relationshipName = mkObjectRelationshipName ref targetTableObj = object - [ schemaKeyword backend .= String (pack schema), + [ schemaKeyword backend .= String (T.pack schema), "name" .= String referenceTargetTable ] manualConfiguration :: Value @@ -358,7 +357,7 @@ trackArrayRelationships backend Table {tableName, tableReferences, tableManualRe schema = defaultSchema backend tableObj = object - [ schemaKeyword backend .= String (pack schema), + [ schemaKeyword backend .= String (T.pack schema), "name" .= String tableName ] requestType = source <> "_create_array_relationship" @@ -366,7 +365,7 @@ trackArrayRelationships backend Table {tableName, tableReferences, tableManualRe let relationshipName = mkArrayRelationshipName tableName referenceTargetColumn referenceLocalColumn targetTableObj = object - [ schemaKeyword backend .= String (pack schema), + [ schemaKeyword backend .= String (T.pack schema), "name" .= String referenceTargetTable ] GraphqlEngine.postMetadata_ @@ -386,7 +385,7 @@ args: let relationshipName = mkArrayRelationshipName tableName referenceTargetColumn referenceLocalColumn targetTableObj = object - [ schemaKeyword backend .= String (pack schema), + [ schemaKeyword backend .= String (T.pack schema), "name" .= String referenceTargetTable ] manualConfiguration :: Value @@ -417,7 +416,7 @@ untrackRelationships backend Table {tableName, tableReferences, tableManualRelat schema = defaultSchema backend tableObj = object - [ schemaKeyword backend .= String (pack schema), + [ schemaKeyword backend .= String (T.pack schema), "name" .= String tableName ] requestType = source <> "_drop_relationship" @@ -426,7 +425,7 @@ untrackRelationships backend Table {tableName, tableReferences, tableManualRelat objectRelationshipName = mkObjectRelationshipName ref targetTableObj = object - [ schemaKeyword backend .= String (pack schema), + [ schemaKeyword backend .= String (T.pack schema), "name" .= String referenceTargetTable ] finally diff --git a/server/tests-hspec/Harness/TestEnvironment.hs b/server/tests-hspec/Harness/TestEnvironment.hs index ba0a30faa40..302b6e7d1d3 100644 --- a/server/tests-hspec/Harness/TestEnvironment.hs +++ b/server/tests-hspec/Harness/TestEnvironment.hs @@ -14,10 +14,13 @@ where import Control.Concurrent (ThreadId, killThread) import Data.Word import Hasura.Prelude +import System.Log.FastLogger qualified as FL -- | A testEnvironment that's passed to all tests. data TestEnvironment = TestEnvironment - { server :: Server + { server :: Server, + logger :: FL.LogStr -> IO (), + loggerCleanup :: IO () } instance Show TestEnvironment where diff --git a/server/tests-hspec/Harness/Webhook.hs b/server/tests-hspec/Harness/Webhook.hs index 447b007ff54..f1920c750d6 100644 --- a/server/tests-hspec/Harness/Webhook.hs +++ b/server/tests-hspec/Harness/Webhook.hs @@ -8,20 +8,18 @@ where import Control.Concurrent (forkIO) import Control.Concurrent.Chan qualified as Chan import Control.Exception.Safe (bracket) -import Control.Monad.IO.Class (liftIO) import Data.Aeson qualified as Aeson import Data.Parser.JSONPath (parseJSONPath) import Data.Text qualified as T import Harness.Http qualified as Http import Harness.TestEnvironment (Server (..), serverUrl) import Hasura.Base.Error (iResultToMaybe) -import Hasura.Prelude (fromMaybe) +import Hasura.Prelude import Hasura.Server.Utils (executeJSONPath) import Network.Socket qualified as Socket import Network.Wai.Extended qualified as Wai import Network.Wai.Handler.Warp qualified as Warp import Web.Spock.Core qualified as Spock -import Prelude newtype EventsQueue = EventsQueue (Chan.Chan Aeson.Value) diff --git a/server/tests-hspec/SpecHook.hs b/server/tests-hspec/SpecHook.hs index a52e84dc000..c26334690c5 100644 --- a/server/tests-hspec/SpecHook.hs +++ b/server/tests-hspec/SpecHook.hs @@ -8,21 +8,24 @@ where import Control.Exception.Safe (bracket) import Harness.GraphqlEngine (startServerThread) import Harness.TestEnvironment (TestEnvironment (..), stopServer) +import Hasura.Prelude import System.Environment (lookupEnv) +import System.Log.FastLogger qualified as FL import Test.Hspec (Spec, SpecWith, aroundAllWith) -import Text.Read (readMaybe) -import Prelude setupTestEnvironment :: IO TestEnvironment setupTestEnvironment = do murlPrefix <- lookupEnv "HASURA_TEST_URLPREFIX" mport <- fmap (>>= readMaybe) (lookupEnv "HASURA_TEST_PORT") server <- startServerThread ((,) <$> murlPrefix <*> mport) - pure $ TestEnvironment server + let logType = FL.LogFileNoRotate "tests-hspec.log" 1024 + (logger, loggerCleanup) <- FL.newFastLogger logType + pure TestEnvironment {..} teardownTestEnvironment :: TestEnvironment -> IO () -teardownTestEnvironment TestEnvironment {server} = +teardownTestEnvironment TestEnvironment {..} = do stopServer server + loggerCleanup hook :: SpecWith TestEnvironment -> Spec hook = aroundAllWith (const . bracket setupTestEnvironment teardownTestEnvironment) diff --git a/server/tests-hspec/Test/ArrayParamPermissionSpec.hs b/server/tests-hspec/Test/ArrayParamPermissionSpec.hs index 71fdfd22386..6f400d68b2a 100644 --- a/server/tests-hspec/Test/ArrayParamPermissionSpec.hs +++ b/server/tests-hspec/Test/ArrayParamPermissionSpec.hs @@ -4,6 +4,7 @@ -- https://github.com/hasura/graphql-engine-mono/pull/4651 module Test.ArrayParamPermissionSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql (graphql) @@ -12,8 +13,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..)) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -------------------------------------------------------------------------------- @@ -22,14 +23,16 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = postgresSetup, - teardown = postgresTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = postgresSetup, + teardown = postgresTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/BackendOnlyPermissionsSpec.hs b/server/tests-hspec/Test/BackendOnlyPermissionsSpec.hs index 59011c750f6..2ae76753e51 100644 --- a/server/tests-hspec/Test/BackendOnlyPermissionsSpec.hs +++ b/server/tests-hspec/Test/BackendOnlyPermissionsSpec.hs @@ -3,6 +3,7 @@ -- | Test backend only permissions module Test.BackendOnlyPermissionsSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql (graphql) @@ -11,8 +12,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- @@ -21,14 +22,16 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = postgresSetup, - teardown = postgresTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = postgresSetup, + teardown = postgresTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/BigQuery/ComputedFieldSpec.hs b/server/tests-hspec/Test/BigQuery/ComputedFieldSpec.hs index 494a0107b2b..2b974c6d6f5 100644 --- a/server/tests-hspec/Test/BigQuery/ComputedFieldSpec.hs +++ b/server/tests-hspec/Test/BigQuery/ComputedFieldSpec.hs @@ -3,6 +3,7 @@ -- | All tests related to computed fields in a BigQuery source module Test.BigQuery.ComputedFieldSpec (spec) where +import Data.List.NonEmpty qualified as NE import Data.Text qualified as T import Harness.Backend.BigQuery qualified as BigQuery import Harness.Constants qualified as Constants @@ -14,22 +15,24 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -- ** Preamble spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.BigQuery, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = bigquerySetup, - teardown = bigqueryTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.BigQuery, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = bigquerySetup, + teardown = bigqueryTeardown, + customOptions = Nothing + } + ] + ) tests -- ** Setup and teardown diff --git a/server/tests-hspec/Test/BigQuery/Metadata/ComputedFieldSpec.hs b/server/tests-hspec/Test/BigQuery/Metadata/ComputedFieldSpec.hs index a6eb139d2c3..cc9899e3de1 100644 --- a/server/tests-hspec/Test/BigQuery/Metadata/ComputedFieldSpec.hs +++ b/server/tests-hspec/Test/BigQuery/Metadata/ComputedFieldSpec.hs @@ -3,6 +3,7 @@ -- | All tests related to metadata API for computed fields in a BigQuery source module Test.BigQuery.Metadata.ComputedFieldSpec (spec) where +import Data.List.NonEmpty qualified as NE import Data.Text qualified as T import Harness.Backend.BigQuery qualified as BigQuery import Harness.Constants qualified as Constants @@ -12,22 +13,24 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -- ** Preamble spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.BigQuery, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = bigquerySetup, - teardown = bigqueryTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.BigQuery, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = bigquerySetup, + teardown = bigqueryTeardown, + customOptions = Nothing + } + ] + ) tests -- ** Setup and teardown diff --git a/server/tests-hspec/Test/BigQuery/TypeInterpretationSpec.hs b/server/tests-hspec/Test/BigQuery/TypeInterpretationSpec.hs index ce474a01e3c..9becac924bf 100644 --- a/server/tests-hspec/Test/BigQuery/TypeInterpretationSpec.hs +++ b/server/tests-hspec/Test/BigQuery/TypeInterpretationSpec.hs @@ -6,7 +6,7 @@ module Test.BigQuery.TypeInterpretationSpec (spec) where import Data.Aeson (Value) -import Data.Text (Text) +import Data.List.NonEmpty qualified as NE import Harness.Backend.BigQuery qualified as BigQuery import Harness.GraphqlEngine (postGraphql) import Harness.Quoter.Graphql (graphql) @@ -15,20 +15,22 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.BigQuery, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = BigQuery.setup schema, - teardown = BigQuery.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.BigQuery, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = BigQuery.setup schema, + teardown = BigQuery.teardown schema, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/CustomFieldNamesSpec.hs b/server/tests-hspec/Test/CustomFieldNamesSpec.hs index 15aa5925adf..1b59506cc02 100644 --- a/server/tests-hspec/Test/CustomFieldNamesSpec.hs +++ b/server/tests-hspec/Test/CustomFieldNamesSpec.hs @@ -7,6 +7,7 @@ -- - MSSQL: https://hasura.io/docs/latest/graphql/core/databases/ms-sql-server/schema/custom-field-names.html module Test.CustomFieldNamesSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as Sqlserver import Harness.GraphqlEngine qualified as GraphqlEngine @@ -16,8 +17,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -------------------------------------------------------------------------------- @@ -26,21 +27,23 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = sqlserverSetup, - teardown = Sqlserver.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = postgresSetup, - teardown = Postgres.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = sqlserverSetup, + teardown = Sqlserver.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = postgresSetup, + teardown = Postgres.teardown schema, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/CustomRootFieldsSpec.hs b/server/tests-hspec/Test/CustomRootFieldsSpec.hs index 354ebf981a9..63550c343c8 100644 --- a/server/tests-hspec/Test/CustomRootFieldsSpec.hs +++ b/server/tests-hspec/Test/CustomRootFieldsSpec.hs @@ -6,6 +6,7 @@ -- - Postgres: https://hasura.io/docs/latest/graphql/core/databases/postgres/schema/custom-field-names/#expose-table-root-fields-with-a-different-name-in-the-graphql-api module Test.CustomRootFieldsSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql (graphql) @@ -14,8 +15,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -------------------------------------------------------------------------------- @@ -24,14 +25,16 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = postgresSetup, - teardown = Postgres.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = postgresSetup, + teardown = Postgres.teardown schema, + customOptions = Nothing + } + ] + ) streamingSubscriptionCustomRootFieldTests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/DataConnector/AggregateQuerySpec.hs b/server/tests-hspec/Test/DataConnector/AggregateQuerySpec.hs index 5bb57c16ced..689be64b2de 100644 --- a/server/tests-hspec/Test/DataConnector/AggregateQuerySpec.hs +++ b/server/tests-hspec/Test/DataConnector/AggregateQuerySpec.hs @@ -6,6 +6,7 @@ module Test.DataConnector.AggregateQuerySpec where import Data.Aeson qualified as Aeson +import Data.List.NonEmpty qualified as NE import Harness.Backend.DataConnector qualified as DataConnector import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql (graphql) @@ -13,20 +14,22 @@ import Harness.Quoter.Yaml (shouldReturnYaml, yaml) import Harness.Test.BackendType (BackendType (..), defaultBackendTypeString, defaultSource) import Harness.Test.Context qualified as Context import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.DataConnector, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = DataConnector.setupFixture sourceMetadata DataConnector.defaultBackendConfig, - teardown = DataConnector.teardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.DataConnector, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = DataConnector.setupFixture sourceMetadata DataConnector.defaultBackendConfig, + teardown = DataConnector.teardown, + customOptions = Nothing + } + ] + ) tests sourceMetadata :: Aeson.Value diff --git a/server/tests-hspec/Test/DataConnector/MockAgent/AggregateQuerySpec.hs b/server/tests-hspec/Test/DataConnector/MockAgent/AggregateQuerySpec.hs index 3cf67f4272c..d4c95912277 100644 --- a/server/tests-hspec/Test/DataConnector/MockAgent/AggregateQuerySpec.hs +++ b/server/tests-hspec/Test/DataConnector/MockAgent/AggregateQuerySpec.hs @@ -8,6 +8,7 @@ where import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KM import Data.HashMap.Strict qualified as HashMap +import Data.List.NonEmpty qualified as NE import Harness.Backend.DataConnector (TestCase (..)) import Harness.Backend.DataConnector qualified as DataConnector import Harness.Quoter.Graphql (graphql) @@ -16,20 +17,22 @@ import Harness.Test.BackendType (BackendType (..), defaultBackendTypeString, def import Harness.Test.Context qualified as Context import Harness.TestEnvironment (TestEnvironment) import Hasura.Backends.DataConnector.API qualified as API +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.DataConnector, - mkLocalTestEnvironment = DataConnector.mkLocalTestEnvironmentMock, - setup = DataConnector.setupMock sourceMetadata DataConnector.mockBackendConfig, - teardown = DataConnector.teardownMock, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.DataConnector, + mkLocalTestEnvironment = DataConnector.mkLocalTestEnvironmentMock, + setup = DataConnector.setupMock sourceMetadata DataConnector.mockBackendConfig, + teardown = DataConnector.teardownMock, + customOptions = Nothing + } + ] + ) tests sourceMetadata :: Aeson.Value diff --git a/server/tests-hspec/Test/DataConnector/MockAgent/BasicQuerySpec.hs b/server/tests-hspec/Test/DataConnector/MockAgent/BasicQuerySpec.hs index aba22fea91f..21a1cf00d6c 100644 --- a/server/tests-hspec/Test/DataConnector/MockAgent/BasicQuerySpec.hs +++ b/server/tests-hspec/Test/DataConnector/MockAgent/BasicQuerySpec.hs @@ -19,22 +19,24 @@ import Harness.Test.BackendType (BackendType (..), defaultBackendTypeString, def import Harness.Test.Context qualified as Context import Harness.TestEnvironment (TestEnvironment) import Hasura.Backends.DataConnector.API qualified as API +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.DataConnector, - mkLocalTestEnvironment = DataConnector.mkLocalTestEnvironmentMock, - setup = DataConnector.setupMock sourceMetadata DataConnector.mockBackendConfig, - teardown = DataConnector.teardownMock, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.DataConnector, + mkLocalTestEnvironment = DataConnector.mkLocalTestEnvironmentMock, + setup = DataConnector.setupMock sourceMetadata DataConnector.mockBackendConfig, + teardown = DataConnector.teardownMock, + customOptions = Nothing + } + ] + ) tests sourceMetadata :: Aeson.Value diff --git a/server/tests-hspec/Test/DataConnector/MockAgent/QueryRelationshipsSpec.hs b/server/tests-hspec/Test/DataConnector/MockAgent/QueryRelationshipsSpec.hs index 16fa27ce6f7..a998ee72a73 100644 --- a/server/tests-hspec/Test/DataConnector/MockAgent/QueryRelationshipsSpec.hs +++ b/server/tests-hspec/Test/DataConnector/MockAgent/QueryRelationshipsSpec.hs @@ -8,6 +8,7 @@ where import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KM import Data.HashMap.Strict qualified as HashMap +import Data.List.NonEmpty qualified as NE import Harness.Backend.DataConnector (TestCase (..)) import Harness.Backend.DataConnector qualified as DataConnector import Harness.Quoter.Graphql (graphql) @@ -16,20 +17,22 @@ import Harness.Test.BackendType (BackendType (..), defaultBackendTypeString, def import Harness.Test.Context qualified as Context import Harness.TestEnvironment (TestEnvironment) import Hasura.Backends.DataConnector.API qualified as API +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.DataConnector, - mkLocalTestEnvironment = DataConnector.mkLocalTestEnvironmentMock, - setup = DataConnector.setupMock sourceMetadata DataConnector.mockBackendConfig, - teardown = DataConnector.teardownMock, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.DataConnector, + mkLocalTestEnvironment = DataConnector.mkLocalTestEnvironmentMock, + setup = DataConnector.setupMock sourceMetadata DataConnector.mockBackendConfig, + teardown = DataConnector.teardownMock, + customOptions = Nothing + } + ] + ) tests sourceMetadata :: Aeson.Value diff --git a/server/tests-hspec/Test/DataConnector/MockAgent/TransformedConfigurationSpec.hs b/server/tests-hspec/Test/DataConnector/MockAgent/TransformedConfigurationSpec.hs index 1e29d266fb5..738d0595cc6 100644 --- a/server/tests-hspec/Test/DataConnector/MockAgent/TransformedConfigurationSpec.hs +++ b/server/tests-hspec/Test/DataConnector/MockAgent/TransformedConfigurationSpec.hs @@ -10,6 +10,7 @@ where import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KM +import Data.List.NonEmpty qualified as NE import Harness.Backend.DataConnector (TestCase (..)) import Harness.Backend.DataConnector qualified as DataConnector import Harness.Quoter.Graphql (graphql) @@ -18,22 +19,24 @@ import Harness.Test.BackendType (BackendType (..), defaultBackendTypeString, def import Harness.Test.Context qualified as Context import Harness.TestEnvironment (TestEnvironment) import Hasura.Backends.DataConnector.API qualified as API +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.DataConnector, - mkLocalTestEnvironment = DataConnector.mkLocalTestEnvironmentMock, - setup = DataConnector.setupMock sourceMetadata DataConnector.mockBackendConfig, - teardown = DataConnector.teardownMock, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.DataConnector, + mkLocalTestEnvironment = DataConnector.mkLocalTestEnvironmentMock, + setup = DataConnector.setupMock sourceMetadata DataConnector.mockBackendConfig, + teardown = DataConnector.teardownMock, + customOptions = Nothing + } + ] + ) tests sourceMetadata :: Aeson.Value diff --git a/server/tests-hspec/Test/DataConnector/QuerySpec.hs b/server/tests-hspec/Test/DataConnector/QuerySpec.hs index 1dbe29139df..c3d31084af0 100644 --- a/server/tests-hspec/Test/DataConnector/QuerySpec.hs +++ b/server/tests-hspec/Test/DataConnector/QuerySpec.hs @@ -9,6 +9,7 @@ where -------------------------------------------------------------------------------- import Data.Aeson qualified as Aeson +import Data.List.NonEmpty qualified as NE import Harness.Backend.DataConnector qualified as DataConnector import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql (graphql) @@ -16,8 +17,8 @@ import Harness.Quoter.Yaml (shouldReturnYaml, yaml) import Harness.Test.BackendType (BackendType (..), defaultBackendTypeString, defaultSource) import Harness.Test.Context qualified as Context import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Reference Agent Query Tests @@ -25,14 +26,16 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.DataConnector, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = DataConnector.setupFixture sourceMetadata DataConnector.defaultBackendConfig, - teardown = DataConnector.teardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.DataConnector, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = DataConnector.setupFixture sourceMetadata DataConnector.defaultBackendConfig, + teardown = DataConnector.teardown, + customOptions = Nothing + } + ] + ) tests sourceMetadata :: Aeson.Value diff --git a/server/tests-hspec/Test/DataConnector/SelectPermissionsSpec.hs b/server/tests-hspec/Test/DataConnector/SelectPermissionsSpec.hs index 89cc0617a3d..bc81910348d 100644 --- a/server/tests-hspec/Test/DataConnector/SelectPermissionsSpec.hs +++ b/server/tests-hspec/Test/DataConnector/SelectPermissionsSpec.hs @@ -8,6 +8,7 @@ where import Data.Aeson (Value) import Data.ByteString (ByteString) +import Data.List.NonEmpty qualified as NE import Harness.Backend.DataConnector (defaultBackendConfig) import Harness.Backend.DataConnector qualified as DataConnector import Harness.GraphqlEngine qualified as GraphqlEngine @@ -16,8 +17,8 @@ import Harness.Quoter.Yaml (shouldReturnYaml, yaml) import Harness.Test.BackendType (BackendType (..), defaultBackendTypeString, defaultSource) import Harness.Test.Context qualified as Context import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -25,14 +26,16 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.DataConnector, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = DataConnector.setupFixture sourceMetadata defaultBackendConfig, - teardown = DataConnector.teardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.DataConnector, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = DataConnector.setupFixture sourceMetadata defaultBackendConfig, + teardown = DataConnector.teardown, + customOptions = Nothing + } + ] + ) tests testRoleName :: ByteString diff --git a/server/tests-hspec/Test/DisableRootFields/DefaultRootFieldsSpec.hs b/server/tests-hspec/Test/DisableRootFields/DefaultRootFieldsSpec.hs index 74b95feafb9..7a6f7c39560 100644 --- a/server/tests-hspec/Test/DisableRootFields/DefaultRootFieldsSpec.hs +++ b/server/tests-hspec/Test/DisableRootFields/DefaultRootFieldsSpec.hs @@ -3,6 +3,7 @@ -- | Test if all root fields (list, pk and aggregate) are enabled by default module Test.DisableRootFields.DefaultRootFieldsSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as SQLServer import Harness.GraphqlEngine qualified as GraphqlEngine @@ -21,21 +22,23 @@ import Test.Hspec (SpecWith, describe, it) spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = postgresSetup, - teardown = Postgres.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = sqlServerSetup, - teardown = SQLServer.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = postgresSetup, + teardown = Postgres.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = sqlServerSetup, + teardown = SQLServer.teardown schema, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/DisableRootFields/SelectPermission/DisableAllRootFieldsRelationshipSpec.hs b/server/tests-hspec/Test/DisableRootFields/SelectPermission/DisableAllRootFieldsRelationshipSpec.hs index 3dc18af83d3..f4f01de3dc1 100644 --- a/server/tests-hspec/Test/DisableRootFields/SelectPermission/DisableAllRootFieldsRelationshipSpec.hs +++ b/server/tests-hspec/Test/DisableRootFields/SelectPermission/DisableAllRootFieldsRelationshipSpec.hs @@ -9,6 +9,7 @@ -- directly. module Test.DisableRootFields.SelectPermission.DisableAllRootFieldsRelationshipSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as SQLServer import Harness.Exceptions @@ -28,21 +29,23 @@ import Test.Hspec (SpecWith, describe, it) spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = postgresSetup, - teardown = postgresTeardown, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = sqlServerSetup, - teardown = sqlServerTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = postgresSetup, + teardown = postgresTeardown, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = sqlServerSetup, + teardown = sqlServerTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/DisableRootFields/SelectPermission/DisableAllRootFieldsSpec.hs b/server/tests-hspec/Test/DisableRootFields/SelectPermission/DisableAllRootFieldsSpec.hs index 51f4e95c651..5c32cde6905 100644 --- a/server/tests-hspec/Test/DisableRootFields/SelectPermission/DisableAllRootFieldsSpec.hs +++ b/server/tests-hspec/Test/DisableRootFields/SelectPermission/DisableAllRootFieldsSpec.hs @@ -3,6 +3,7 @@ -- | Test if all root fields are disabled module Test.DisableRootFields.SelectPermission.DisableAllRootFieldsSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Yaml (shouldReturnYaml, yaml) @@ -20,14 +21,16 @@ import Test.Hspec (SpecWith, describe, it) spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = postgresSetup, - teardown = Postgres.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = postgresSetup, + teardown = Postgres.teardown schema, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnableAggSpec.hs b/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnableAggSpec.hs index f418ce3d481..a28918f56e7 100644 --- a/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnableAggSpec.hs +++ b/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnableAggSpec.hs @@ -9,6 +9,7 @@ -- This test, tests that disabling of 'aggregate' of fields works. module Test.DisableRootFields.SelectPermission.EnableAggSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as SQLServer import Harness.GraphqlEngine qualified as GraphqlEngine @@ -42,12 +43,16 @@ spec = do teardown = SQLServer.teardown schema, customOptions = Nothing } - Context.run [pgContext, sqlServerContext] commonTests Context.run - [ pgContext - { Context.setup = Postgres.setup schema - } - ] + (NE.fromList [pgContext, sqlServerContext]) + commonTests + Context.run + ( NE.fromList + [ pgContext + { Context.setup = Postgres.setup schema + } + ] + ) metadataValidationTests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnableAllRootFieldsSpec.hs b/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnableAllRootFieldsSpec.hs index 1b51e829e14..cb06bb44b9a 100644 --- a/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnableAllRootFieldsSpec.hs +++ b/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnableAllRootFieldsSpec.hs @@ -3,6 +3,7 @@ -- | Test if all root fields are accessible module Test.DisableRootFields.SelectPermission.EnableAllRootFieldsSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as SQLServer import Harness.GraphqlEngine qualified as GraphqlEngine @@ -21,21 +22,23 @@ import Test.Hspec (SpecWith, describe, it) spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = postgresSetup, - teardown = Postgres.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = mssqlSetup, - teardown = SQLServer.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = postgresSetup, + teardown = Postgres.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = mssqlSetup, + teardown = SQLServer.teardown schema, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnablePKSpec.hs b/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnablePKSpec.hs index f3a32f37752..f4b6a48a197 100644 --- a/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnablePKSpec.hs +++ b/server/tests-hspec/Test/DisableRootFields/SelectPermission/EnablePKSpec.hs @@ -3,6 +3,7 @@ -- | Test if only list root field is accessible module Test.DisableRootFields.SelectPermission.EnablePKSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as SQLServer import Harness.GraphqlEngine qualified as GraphqlEngine @@ -21,31 +22,35 @@ import Test.Hspec (SpecWith, describe, it) spec :: SpecWith TestEnvironment spec = do Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = postgresSetup, - teardown = Postgres.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = mssqlSetup, - teardown = SQLServer.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = postgresSetup, + teardown = Postgres.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = mssqlSetup, + teardown = SQLServer.teardown schema, + customOptions = Nothing + } + ] + ) graphQLTests Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Postgres.setup schema, - teardown = Postgres.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Postgres.setup schema, + teardown = Postgres.teardown schema, + customOptions = Nothing + } + ] + ) metadataValidationTests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/EventTrigger/EventTriggerDropSourceCleanupSpec.hs b/server/tests-hspec/Test/EventTrigger/EventTriggerDropSourceCleanupSpec.hs index 6c59d33c1b0..ff911c036a9 100644 --- a/server/tests-hspec/Test/EventTrigger/EventTriggerDropSourceCleanupSpec.hs +++ b/server/tests-hspec/Test/EventTrigger/EventTriggerDropSourceCleanupSpec.hs @@ -7,6 +7,7 @@ module Test.EventTrigger.EventTriggerDropSourceCleanupSpec (spec) where import Control.Concurrent.Chan qualified as Chan +import Data.List.NonEmpty qualified as NE import Harness.Backend.Sqlserver qualified as Sqlserver import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Yaml @@ -26,16 +27,18 @@ import Test.Hspec (SpecWith, describe, it) spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.SQLServer, - -- setup the webhook server as the local test environment, - -- so that the server can be referenced while testing - mkLocalTestEnvironment = webhookServerMkLocalTestEnvironment, - setup = mssqlSetupWithEventTriggers, - teardown = mssqlTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.SQLServer, + -- setup the webhook server as the local test environment, + -- so that the server can be referenced while testing + mkLocalTestEnvironment = webhookServerMkLocalTestEnvironment, + setup = mssqlSetupWithEventTriggers, + teardown = mssqlTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/EventTrigger/EventTriggersMSSQLUntrackTableCleanupSpec.hs b/server/tests-hspec/Test/EventTrigger/EventTriggersMSSQLUntrackTableCleanupSpec.hs index 065c199f1b4..c162bb32e5d 100644 --- a/server/tests-hspec/Test/EventTrigger/EventTriggersMSSQLUntrackTableCleanupSpec.hs +++ b/server/tests-hspec/Test/EventTrigger/EventTriggersMSSQLUntrackTableCleanupSpec.hs @@ -6,6 +6,7 @@ module Test.EventTrigger.EventTriggersMSSQLUntrackTableCleanupSpec (spec) where import Control.Concurrent.Chan qualified as Chan +import Data.List.NonEmpty qualified as NE import Harness.Backend.Sqlserver qualified as Sqlserver import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Yaml @@ -25,16 +26,18 @@ import Test.Hspec (SpecWith, describe, it) spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.SQLServer, - -- setup the webhook server as the local test environment, - -- so that the server can be referenced while testing - mkLocalTestEnvironment = webhookServerMkLocalTestEnvironment, - setup = mssqlSetup, - teardown = mssqlTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.SQLServer, + -- setup the webhook server as the local test environment, + -- so that the server can be referenced while testing + mkLocalTestEnvironment = webhookServerMkLocalTestEnvironment, + setup = mssqlSetup, + teardown = mssqlTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/EventTrigger/EventTriggersPGUntrackTableCleanupSpec.hs b/server/tests-hspec/Test/EventTrigger/EventTriggersPGUntrackTableCleanupSpec.hs index e06d115881d..70b433461dc 100644 --- a/server/tests-hspec/Test/EventTrigger/EventTriggersPGUntrackTableCleanupSpec.hs +++ b/server/tests-hspec/Test/EventTrigger/EventTriggersPGUntrackTableCleanupSpec.hs @@ -6,6 +6,7 @@ module Test.EventTrigger.EventTriggersPGUntrackTableCleanupSpec (spec) where import Control.Concurrent.Chan qualified as Chan +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Yaml @@ -25,16 +26,18 @@ import Test.Hspec (SpecWith, describe, it) spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.Postgres, - -- setup the webhook server as the local test environment, - -- so that the server can be referenced while testing - mkLocalTestEnvironment = webhookServerMkLocalTestEnvironment, - setup = postgresSetup, - teardown = postgresTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + -- setup the webhook server as the local test environment, + -- so that the server can be referenced while testing + mkLocalTestEnvironment = webhookServerMkLocalTestEnvironment, + setup = postgresSetup, + teardown = postgresTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/EventTrigger/EventTriggersRecreationSpec.hs b/server/tests-hspec/Test/EventTrigger/EventTriggersRecreationSpec.hs index 64388f03291..9052646bd9d 100644 --- a/server/tests-hspec/Test/EventTrigger/EventTriggersRecreationSpec.hs +++ b/server/tests-hspec/Test/EventTrigger/EventTriggersRecreationSpec.hs @@ -2,6 +2,7 @@ module Test.EventTrigger.EventTriggersRecreationSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine (postV2Query_) import Harness.GraphqlEngine qualified as GraphQLEngine @@ -12,8 +13,8 @@ import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment, stopServer) import Harness.Webhook qualified as Webhook +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -21,14 +22,16 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = webhookServerMkLocalTestEnvironment, - setup = postgresSetup, - teardown = postgresTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = webhookServerMkLocalTestEnvironment, + setup = postgresSetup, + teardown = postgresTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/EventTrigger/EventTriggersRunSQLSpec.hs b/server/tests-hspec/Test/EventTrigger/EventTriggersRunSQLSpec.hs index b1ce65a6006..98f95abfd09 100644 --- a/server/tests-hspec/Test/EventTrigger/EventTriggersRunSQLSpec.hs +++ b/server/tests-hspec/Test/EventTrigger/EventTriggersRunSQLSpec.hs @@ -7,6 +7,7 @@ module Test.EventTrigger.EventTriggersRunSQLSpec (spec) where import Control.Concurrent.Chan qualified as Chan import Data.Aeson (eitherDecode) import Data.ByteString.Lazy.Char8 qualified as L8 +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Http qualified as Http @@ -16,12 +17,11 @@ import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (Server (..), TestEnvironment, getServer, stopServer) import Harness.Webhook qualified as Webhook -import Hasura.Prelude (Text, onLeft, onNothing) +import Hasura.Prelude import Network.HTTP.Simple qualified as Http import System.Timeout (timeout) import Test.HUnit.Base (assertFailure) import Test.Hspec (SpecWith, it, shouldBe) -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -29,16 +29,18 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment - [ Context.Context - { name = Context.Backend Context.Postgres, - -- setup the webhook server as the local test environment, - -- so that the server can be referenced while testing - mkLocalTestEnvironment = webhookServerMkLocalTestEnvironment, - setup = postgresSetup, - teardown = postgresTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + -- setup the webhook server as the local test environment, + -- so that the server can be referenced while testing + mkLocalTestEnvironment = webhookServerMkLocalTestEnvironment, + setup = postgresSetup, + teardown = postgresTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/GatheringUniqueConstraintsSpec.hs b/server/tests-hspec/Test/GatheringUniqueConstraintsSpec.hs index 222f4a93dc1..11bbfec3e88 100644 --- a/server/tests-hspec/Test/GatheringUniqueConstraintsSpec.hs +++ b/server/tests-hspec/Test/GatheringUniqueConstraintsSpec.hs @@ -7,7 +7,7 @@ import Harness.Backend.Postgres qualified as Postgres import Harness.Test.BackendType qualified as BackendType import Harness.Test.Fixture import Harness.Test.Schema -import Harness.TestEnvironment (TestEnvironment) +import Harness.TestEnvironment (TestEnvironment (..)) import Hasura.Prelude import Test.Hspec @@ -18,7 +18,7 @@ spec :: SpecWith TestEnvironment spec = run [postgresFixture, citusFixture] - (\_ -> it "Tracks tables without failing" $ \_ -> return @IO ()) + (\_ -> it "Tracks tables without failing" \_ -> return @IO ()) postgresFixture :: Fixture () postgresFixture = diff --git a/server/tests-hspec/Test/HelloWorldSpec.hs b/server/tests-hspec/Test/HelloWorldSpec.hs new file mode 100644 index 00000000000..d8defac2a17 --- /dev/null +++ b/server/tests-hspec/Test/HelloWorldSpec.hs @@ -0,0 +1,29 @@ +-- | A starting point feature test. +module Test.HelloWorldSpec (spec) where + +import Data.List.NonEmpty qualified as NE +import Harness.Test.Context qualified as Context +import Harness.TestEnvironment (TestEnvironment (..)) +import Test.Hspec (SpecWith, describe, it, shouldBe) + +-------------------------------------------------------------------------------- +-- Preamble + +spec :: SpecWith TestEnvironment +spec = + Context.run + ( NE.fromList + [ Context.context (Context.Backend Context.Postgres) + ] + ) + tests + +-------------------------------------------------------------------------------- +-- Tests + +tests :: Context.Options -> SpecWith TestEnvironment +tests _opts = + describe "HelloWorld" do + it "No-op" \te -> do + logger te "woop\n" + () `shouldBe` () diff --git a/server/tests-hspec/Test/InsertCheckPermissionSpec.hs b/server/tests-hspec/Test/InsertCheckPermissionSpec.hs index 75158bacfb0..14b0b98f652 100644 --- a/server/tests-hspec/Test/InsertCheckPermissionSpec.hs +++ b/server/tests-hspec/Test/InsertCheckPermissionSpec.hs @@ -3,6 +3,7 @@ -- | Test insert check permissions module Test.InsertCheckPermissionSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Sqlserver qualified as Sqlserver import Harness.Exceptions import Harness.GraphqlEngine qualified as GraphqlEngine @@ -12,8 +13,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -------------------------------------------------------------------------------- @@ -22,14 +23,16 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = mssqlSetup, - teardown = mssqlTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = mssqlSetup, + teardown = mssqlTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/InsertDefaultsSpec.hs b/server/tests-hspec/Test/InsertDefaultsSpec.hs index 9713e9daa40..d5e750bf8aa 100644 --- a/server/tests-hspec/Test/InsertDefaultsSpec.hs +++ b/server/tests-hspec/Test/InsertDefaultsSpec.hs @@ -3,6 +3,7 @@ -- | Test insert with default values module Test.InsertDefaultsSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Citus qualified as Citus import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as Sqlserver @@ -13,8 +14,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -------------------------------------------------------------------------------- @@ -22,15 +23,9 @@ import Prelude spec :: SpecWith TestEnvironment spec = do - Context.run - [ postgresContext, - citusContext, - mssqlContext - ] - commonTests - - Context.run [postgresContext, citusContext] postgresTests - Context.run [mssqlContext] mssqlTests + Context.run (NE.fromList [postgresContext, citusContext, mssqlContext]) commonTests + Context.run (NE.fromList [postgresContext, citusContext]) postgresTests + Context.run (NE.fromList [mssqlContext]) mssqlTests where postgresContext = Context.Context diff --git a/server/tests-hspec/Test/LongIdentifiersSpec.hs b/server/tests-hspec/Test/LongIdentifiersSpec.hs index 42e2399f1e9..c0fd3ae4306 100644 --- a/server/tests-hspec/Test/LongIdentifiersSpec.hs +++ b/server/tests-hspec/Test/LongIdentifiersSpec.hs @@ -5,6 +5,7 @@ -- See "Hasura.Backend.Postgres.SQL.RenameIdentifiers" for more details. module Test.LongIdentifiersSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.BigQuery qualified as Bigquery import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as Sqlserver @@ -15,8 +16,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -24,52 +25,54 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ -- Create table fails currently becasuse we postfix table names for some reason - -- which makes the valid table name go over the limit - -- - -- Context.Context - -- { name = Context.Backend Context.MySQL, - -- mkLocalTestEnvironment = Context.noLocalTestEnvironment, - -- setup = Mysql.setup schema, - -- teardown = Mysql.teardown schema, - -- customOptions = Nothing - -- }, - Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Postgres.setup schema, - teardown = Postgres.teardown schema, - customOptions = Nothing - }, - -- Create table fails currently on a weird error: - -- > relation "i_need_a_table_with_a_long_na_i_need_a_column_with_a_long_n_seq" already exists - -- - -- Context.Context - -- { name = Context.Backend Context.Citus, - -- mkLocalTestEnvironment = Context.noLocalTestEnvironment, - -- setup = Citus.setup schema, - -- teardown = Citus.teardown schema, - -- customOptions = Nothing - -- }, - Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Sqlserver.setup schema, - teardown = Sqlserver.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.BigQuery, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Bigquery.setup schema, - teardown = Bigquery.teardown schema, - customOptions = - Just $ - Context.Options - { stringifyNumbers = True - } - } - ] + ( NE.fromList + [ -- Create table fails currently becasuse we postfix table names for some reason + -- which makes the valid table name go over the limit + -- + -- Context.Context + -- { name = Context.Backend Context.MySQL, + -- mkLocalTestEnvironment = Context.noLocalTestEnvironment, + -- setup = Mysql.setup schema, + -- teardown = Mysql.teardown schema, + -- customOptions = Nothing + -- }, + Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Postgres.setup schema, + teardown = Postgres.teardown schema, + customOptions = Nothing + }, + -- Create table fails currently on a weird error: + -- > relation "i_need_a_table_with_a_long_na_i_need_a_column_with_a_long_n_seq" already exists + -- + -- Context.Context + -- { name = Context.Backend Context.Citus, + -- mkLocalTestEnvironment = Context.noLocalTestEnvironment, + -- setup = Citus.setup schema, + -- teardown = Citus.teardown schema, + -- customOptions = Nothing + -- }, + Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Sqlserver.setup schema, + teardown = Sqlserver.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.BigQuery, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Bigquery.setup schema, + teardown = Bigquery.teardown schema, + customOptions = + Just $ + Context.Options + { stringifyNumbers = True + } + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/Mutations/MultiplePerRequest/UpdateManySpec.hs b/server/tests-hspec/Test/Mutations/MultiplePerRequest/UpdateManySpec.hs index 693eb56f3bd..cf2865d9ac7 100644 --- a/server/tests-hspec/Test/Mutations/MultiplePerRequest/UpdateManySpec.hs +++ b/server/tests-hspec/Test/Mutations/MultiplePerRequest/UpdateManySpec.hs @@ -6,6 +6,7 @@ module Test.Mutations.MultiplePerRequest.UpdateManySpec (spec) where import Data.Aeson (Value) +import Data.List.NonEmpty qualified as NE import Harness.Backend.Citus qualified as Citus import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine (postGraphql) @@ -15,8 +16,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = do @@ -24,21 +25,23 @@ spec = do -- "SERIAL" as the 'Schema.defaultSerialType' for MySQL. Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Postgres.setup schema, - teardown = Postgres.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.Citus, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Citus.setup schema, - teardown = Citus.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Postgres.setup schema, + teardown = Postgres.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.Citus, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Citus.setup schema, + teardown = Citus.teardown schema, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/ObjectRelationshipsLimitSpec.hs b/server/tests-hspec/Test/ObjectRelationshipsLimitSpec.hs index b7e599e9ae3..58757c14aff 100644 --- a/server/tests-hspec/Test/ObjectRelationshipsLimitSpec.hs +++ b/server/tests-hspec/Test/ObjectRelationshipsLimitSpec.hs @@ -5,6 +5,7 @@ -- Test case for bug reported at https://github.com/hasura/graphql-engine/issues/7936 module Test.ObjectRelationshipsLimitSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres as Postgres import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql @@ -13,8 +14,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec -import Prelude -------------------------------------------------------------------------------- @@ -23,14 +24,16 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = postgresSetup, - teardown = postgresTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = postgresSetup, + teardown = postgresTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/Postgres/EnumSpec.hs b/server/tests-hspec/Test/Postgres/EnumSpec.hs index 37c90f979a2..e18d27208eb 100644 --- a/server/tests-hspec/Test/Postgres/EnumSpec.hs +++ b/server/tests-hspec/Test/Postgres/EnumSpec.hs @@ -3,6 +3,7 @@ module Test.Postgres.EnumSpec (spec) where import Data.Aeson (Value) +import Data.List.NonEmpty qualified as NE import Harness.Backend.Citus qualified as Citus import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine (postGraphql) @@ -12,27 +13,29 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = const (Postgres.run_ setup) <> Postgres.setup schema, - teardown = Postgres.teardown schema <> const (Postgres.run_ teardown), - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.Citus, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = const (Citus.run_ setup) <> Citus.setup schema, - teardown = Citus.teardown schema <> const (Citus.run_ teardown), - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = const (Postgres.run_ setup) <> Postgres.setup schema, + teardown = Postgres.teardown schema <> const (Postgres.run_ teardown), + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.Citus, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = const (Citus.run_ setup) <> Citus.setup schema, + teardown = Citus.teardown schema <> const (Citus.run_ teardown), + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/Postgres/TimestampSpec.hs b/server/tests-hspec/Test/Postgres/TimestampSpec.hs index 9df16959aec..9f5bbc9b9fc 100644 --- a/server/tests-hspec/Test/Postgres/TimestampSpec.hs +++ b/server/tests-hspec/Test/Postgres/TimestampSpec.hs @@ -6,6 +6,7 @@ module Test.Postgres.TimestampSpec (spec) where import Data.Aeson (Value) +import Data.List.NonEmpty qualified as NE import Harness.Backend.Citus qualified as Citus import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine (postGraphql) @@ -15,8 +16,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -24,21 +25,23 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Postgres.setup schema, - teardown = Postgres.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.Citus, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Citus.setup schema, - teardown = Citus.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Postgres.setup schema, + teardown = Postgres.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.Citus, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Citus.setup schema, + teardown = Citus.teardown schema, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/Queries/Directives/IncludeAndSkipSpec.hs b/server/tests-hspec/Test/Queries/Directives/IncludeAndSkipSpec.hs index 85f3db39a63..c73874c59f7 100644 --- a/server/tests-hspec/Test/Queries/Directives/IncludeAndSkipSpec.hs +++ b/server/tests-hspec/Test/Queries/Directives/IncludeAndSkipSpec.hs @@ -22,8 +22,8 @@ import Harness.Test.Fixture qualified as Fixture import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = do diff --git a/server/tests-hspec/Test/Queries/Directives/IncludeSpec.hs b/server/tests-hspec/Test/Queries/Directives/IncludeSpec.hs index 92af0c91980..ff288a34af0 100644 --- a/server/tests-hspec/Test/Queries/Directives/IncludeSpec.hs +++ b/server/tests-hspec/Test/Queries/Directives/IncludeSpec.hs @@ -22,8 +22,8 @@ import Harness.Test.Fixture qualified as Fixture import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble diff --git a/server/tests-hspec/Test/Queries/Directives/SkipSpec.hs b/server/tests-hspec/Test/Queries/Directives/SkipSpec.hs index 7ade2181dab..674006f0fee 100644 --- a/server/tests-hspec/Test/Queries/Directives/SkipSpec.hs +++ b/server/tests-hspec/Test/Queries/Directives/SkipSpec.hs @@ -22,8 +22,8 @@ import Harness.Test.Fixture qualified as Fixture import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble diff --git a/server/tests-hspec/Test/Queries/DirectivesSpec.hs b/server/tests-hspec/Test/Queries/DirectivesSpec.hs index 2ece3d44b42..6d274ff5061 100644 --- a/server/tests-hspec/Test/Queries/DirectivesSpec.hs +++ b/server/tests-hspec/Test/Queries/DirectivesSpec.hs @@ -22,8 +22,8 @@ import Harness.Test.Fixture qualified as Fixture import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = do diff --git a/server/tests-hspec/Test/Queries/FilterSearchSpec.hs b/server/tests-hspec/Test/Queries/FilterSearchSpec.hs index 4ef7df7689e..7ec85946e1c 100644 --- a/server/tests-hspec/Test/Queries/FilterSearchSpec.hs +++ b/server/tests-hspec/Test/Queries/FilterSearchSpec.hs @@ -21,8 +21,8 @@ import Harness.Test.Fixture qualified as Fixture import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble diff --git a/server/tests-hspec/Test/Queries/NestedObjectSpec.hs b/server/tests-hspec/Test/Queries/NestedObjectSpec.hs index f35f0435af2..dce8d75a75b 100644 --- a/server/tests-hspec/Test/Queries/NestedObjectSpec.hs +++ b/server/tests-hspec/Test/Queries/NestedObjectSpec.hs @@ -9,6 +9,7 @@ module Test.Queries.NestedObjectSpec (spec) where import Data.Aeson (Value) +import Data.List.NonEmpty qualified as NE import Harness.Backend.BigQuery qualified as BigQuery import Harness.Backend.Citus qualified as Citus import Harness.Backend.Mysql qualified as Mysql @@ -22,8 +23,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -31,46 +32,48 @@ import Prelude spec :: SpecWith TestEnvironment spec = do Context.run - [ Context.Context - { name = Context.Backend Context.MySQL, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Mysql.setup schema, - teardown = Mysql.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Postgres.setup schema, - teardown = Postgres.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.Citus, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Citus.setup schema, - teardown = Citus.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Sqlserver.setup schema, - teardown = Sqlserver.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.BigQuery, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = BigQuery.setup schema, - teardown = BigQuery.teardown schema, - customOptions = - Just $ - Context.Options - { stringifyNumbers = True - } - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.MySQL, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Mysql.setup schema, + teardown = Mysql.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Postgres.setup schema, + teardown = Postgres.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.Citus, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Citus.setup schema, + teardown = Citus.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Sqlserver.setup schema, + teardown = Sqlserver.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.BigQuery, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = BigQuery.setup schema, + teardown = BigQuery.teardown schema, + customOptions = + Just $ + Context.Options + { stringifyNumbers = True + } + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/Queries/Paginate/LimitSpec.hs b/server/tests-hspec/Test/Queries/Paginate/LimitSpec.hs index ad9d34a6f52..629b80b3316 100644 --- a/server/tests-hspec/Test/Queries/Paginate/LimitSpec.hs +++ b/server/tests-hspec/Test/Queries/Paginate/LimitSpec.hs @@ -21,8 +21,8 @@ import Harness.Test.Fixture qualified as Fixture import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble diff --git a/server/tests-hspec/Test/Queries/Paginate/OffsetSpec.hs b/server/tests-hspec/Test/Queries/Paginate/OffsetSpec.hs index a9eb1d64d42..8b7b958a301 100644 --- a/server/tests-hspec/Test/Queries/Paginate/OffsetSpec.hs +++ b/server/tests-hspec/Test/Queries/Paginate/OffsetSpec.hs @@ -21,8 +21,8 @@ import Harness.Test.Fixture qualified as Fixture import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble diff --git a/server/tests-hspec/Test/Queries/Simple/ObjectQueriesSpec.hs b/server/tests-hspec/Test/Queries/Simple/ObjectQueriesSpec.hs index 6683cae3925..ab5bb2521ff 100644 --- a/server/tests-hspec/Test/Queries/Simple/ObjectQueriesSpec.hs +++ b/server/tests-hspec/Test/Queries/Simple/ObjectQueriesSpec.hs @@ -9,6 +9,7 @@ module Test.Queries.Simple.ObjectQueriesSpec (spec) where import Data.Aeson (Value) +import Data.List.NonEmpty qualified as NE import Harness.Backend.BigQuery qualified as BigQuery import Harness.Backend.Citus qualified as Citus import Harness.Backend.Mysql qualified as Mysql @@ -22,52 +23,54 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = do Context.run - [ Context.Context - { name = Context.Backend Context.MySQL, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Mysql.setup schema, - teardown = Mysql.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Postgres.setup schema, - teardown = Postgres.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.Citus, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Citus.setup schema, - teardown = Citus.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Sqlserver.setup schema, - teardown = Sqlserver.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.BigQuery, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = BigQuery.setup schema, - teardown = BigQuery.teardown schema, - customOptions = - Just $ - Context.Options - { stringifyNumbers = True - } - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.MySQL, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Mysql.setup schema, + teardown = Mysql.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Postgres.setup schema, + teardown = Postgres.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.Citus, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Citus.setup schema, + teardown = Citus.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Sqlserver.setup schema, + teardown = Sqlserver.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.BigQuery, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = BigQuery.setup schema, + teardown = BigQuery.teardown schema, + customOptions = + Just $ + Context.Options + { stringifyNumbers = True + } + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/Queries/Simple/OperationNameSpec.hs b/server/tests-hspec/Test/Queries/Simple/OperationNameSpec.hs index 01176b62656..606ec7648ae 100644 --- a/server/tests-hspec/Test/Queries/Simple/OperationNameSpec.hs +++ b/server/tests-hspec/Test/Queries/Simple/OperationNameSpec.hs @@ -18,8 +18,8 @@ import Harness.Test.Fixture qualified as Fixture import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = do diff --git a/server/tests-hspec/Test/Queries/Simple/PrimaryKeySpec.hs b/server/tests-hspec/Test/Queries/Simple/PrimaryKeySpec.hs index fed243fcafb..7418d3a962c 100644 --- a/server/tests-hspec/Test/Queries/Simple/PrimaryKeySpec.hs +++ b/server/tests-hspec/Test/Queries/Simple/PrimaryKeySpec.hs @@ -19,8 +19,8 @@ import Harness.Test.Fixture qualified as Fixture import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = diff --git a/server/tests-hspec/Test/Queries/SortSpec.hs b/server/tests-hspec/Test/Queries/SortSpec.hs index 0a5f0d72a6b..0dae0b8245e 100644 --- a/server/tests-hspec/Test/Queries/SortSpec.hs +++ b/server/tests-hspec/Test/Queries/SortSpec.hs @@ -21,8 +21,8 @@ import Harness.Test.Fixture qualified as Fixture import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble diff --git a/server/tests-hspec/Test/Quoter/YamlSpec.hs b/server/tests-hspec/Test/Quoter/YamlSpec.hs index 218103dda2f..018f8981e5a 100644 --- a/server/tests-hspec/Test/Quoter/YamlSpec.hs +++ b/server/tests-hspec/Test/Quoter/YamlSpec.hs @@ -9,8 +9,8 @@ import Data.Aeson.KeyMap qualified as KM import GHC.Generics import Harness.Quoter.Yaml (interpolateYaml, yaml) import Harness.TestEnvironment +import Hasura.Prelude import Test.Hspec -import Prelude -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/RemoteRelationship/FromRemoteSchemaSpec.hs b/server/tests-hspec/Test/RemoteRelationship/FromRemoteSchemaSpec.hs index 1ba096553ff..41de4307e5a 100644 --- a/server/tests-hspec/Test/RemoteRelationship/FromRemoteSchemaSpec.hs +++ b/server/tests-hspec/Test/RemoteRelationship/FromRemoteSchemaSpec.hs @@ -8,10 +8,9 @@ -- making joins against them. module Test.RemoteRelationship.FromRemoteSchemaSpec (spec) where -import Data.Functor ((<&>)) +import Data.List.NonEmpty qualified as NE import Data.Morpheus.Document (gqlDocument) import Data.Morpheus.Types -import Data.Text (Text) import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql (graphql) @@ -22,14 +21,14 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (Server, TestEnvironment, stopServer) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble spec :: SpecWith TestEnvironment -spec = Context.runWithLocalTestEnvironment [context] tests +spec = Context.runWithLocalTestEnvironment (NE.fromList [context]) tests where context = Context diff --git a/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/ClearMetadataSpec.hs b/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/ClearMetadataSpec.hs index 7f378ccf39d..993800c31f3 100644 --- a/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/ClearMetadataSpec.hs +++ b/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/ClearMetadataSpec.hs @@ -25,6 +25,7 @@ -- The LHS source in the below tests have the source name as "source" module Test.RemoteRelationship.MetadataAPI.ClearMetadataSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Yaml (shouldReturnYaml, yaml) import Harness.Test.Context qualified as Context @@ -39,11 +40,12 @@ spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment contexts tests where contexts = - [ Common.dbTodbRemoteRelationshipContext, - Common.dbToRemoteSchemaRemoteRelationshipContext, - Common.remoteSchemaToDBRemoteRelationshipContext, - Common.remoteSchemaToremoteSchemaRemoteRelationshipContext - ] + NE.fromList + [ Common.dbTodbRemoteRelationshipContext, + Common.dbToRemoteSchemaRemoteRelationshipContext, + Common.remoteSchemaToDBRemoteRelationshipContext, + Common.remoteSchemaToremoteSchemaRemoteRelationshipContext + ] -------------------------------------------------------------------------------- -- Tests diff --git a/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/Common.hs b/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/Common.hs index 6c3238c2700..8b39e1bde91 100644 --- a/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/Common.hs +++ b/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/Common.hs @@ -36,16 +36,11 @@ where -- Debugging import Data.Char (isUpper, toLower) -import Data.Foldable (traverse_) -import Data.Function ((&)) -import Data.List (intercalate, sortBy) import Data.List.Split (dropBlanks, keepDelimsL, split, whenElt) import Data.Morpheus.Document (gqlDocument) import Data.Morpheus.Types import Data.Morpheus.Types qualified as Morpheus -import Data.Text (Text) import Data.Typeable (Typeable) -import GHC.Generics (Generic) import Harness.Backend.Postgres qualified as Postgres import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Yaml (yaml) @@ -55,7 +50,7 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (Server, TestEnvironment, stopServer) -import Prelude +import Hasura.Prelude -------------------------------------------------------------------------------- -- Preamble @@ -507,7 +502,7 @@ lhsRemoteServerMkLocalTestEnvironment _ = do orderByFunction = case ta_order_by of Nothing -> \_ _ -> EQ Just orderByArg -> orderTrack orderByArg - limitFunction = maybe Prelude.id take ta_limit + limitFunction = maybe Hasura.Prelude.id take ta_limit pure $ tracks & filter filterFunction diff --git a/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/DropSource/DBtoDBRelationshipSpec.hs b/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/DropSource/DBtoDBRelationshipSpec.hs index 48d173a8c3a..516c751741d 100644 --- a/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/DropSource/DBtoDBRelationshipSpec.hs +++ b/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/DropSource/DBtoDBRelationshipSpec.hs @@ -31,14 +31,15 @@ module Test.RemoteRelationship.MetadataAPI.DropSource.DBtoDBRelationshipSpec (sp import Control.Lens (findOf, has, only, (^?!)) import Data.Aeson.Lens (key, values, _String) +import Data.List.NonEmpty qualified as NE import Data.Maybe qualified as Unsafe (fromJust) import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Yaml (shouldBeYaml, shouldReturnYaml, yaml) import Harness.Test.Context qualified as Context import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) import Test.RemoteRelationship.MetadataAPI.Common (LocalTestTestEnvironment (..), dbTodbRemoteRelationshipContext) -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -46,7 +47,7 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment contexts tests where - contexts = [dbTodbRemoteRelationshipContext] + contexts = NE.fromList [dbTodbRemoteRelationshipContext] -------------------------------------------------------------------------------- -- Tests diff --git a/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/DropSource/RSToDBRelationshipSpec.hs b/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/DropSource/RSToDBRelationshipSpec.hs index ef2a90e34f1..6a32d749661 100644 --- a/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/DropSource/RSToDBRelationshipSpec.hs +++ b/server/tests-hspec/Test/RemoteRelationship/MetadataAPI/DropSource/RSToDBRelationshipSpec.hs @@ -31,14 +31,15 @@ module Test.RemoteRelationship.MetadataAPI.DropSource.RSToDBRelationshipSpec (sp import Control.Lens (findOf, has, only, (^?!)) import Data.Aeson.Lens (key, values, _String) +import Data.List.NonEmpty qualified as NE import Data.Maybe qualified as Unsafe (fromJust) import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Yaml (shouldBeYaml, shouldReturnYaml, yaml) import Harness.Test.Context qualified as Context import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) import Test.RemoteRelationship.MetadataAPI.Common (LocalTestTestEnvironment (..), remoteSchemaToDBRemoteRelationshipContext) -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -46,7 +47,7 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment contexts tests where - contexts = [remoteSchemaToDBRemoteRelationshipContext] + contexts = NE.fromList [remoteSchemaToDBRemoteRelationshipContext] -------------------------------------------------------------------------------- -- Tests diff --git a/server/tests-hspec/Test/RemoteRelationship/XToDBArrayRelationshipSpec.hs b/server/tests-hspec/Test/RemoteRelationship/XToDBArrayRelationshipSpec.hs index 1bbc61fd0d0..f16ddc7a7a9 100644 --- a/server/tests-hspec/Test/RemoteRelationship/XToDBArrayRelationshipSpec.hs +++ b/server/tests-hspec/Test/RemoteRelationship/XToDBArrayRelationshipSpec.hs @@ -17,17 +17,13 @@ import Control.Lens (findOf, has, only, (^?!)) import Data.Aeson (Value) import Data.Aeson.Lens (key, values, _String) import Data.Char (isUpper, toLower) -import Data.Foldable (traverse_) -import Data.Function ((&)) -import Data.List (intercalate, sortBy) +import Data.List.NonEmpty qualified as NE import Data.List.Split (dropBlanks, keepDelimsL, split, whenElt) import Data.Maybe qualified as Unsafe (fromJust) import Data.Morpheus.Document (gqlDocument) import Data.Morpheus.Types import Data.Morpheus.Types qualified as Morpheus -import Data.Text (Text) import Data.Typeable (Typeable) -import GHC.Generics (Generic) import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as SQLServer import Harness.GraphqlEngine qualified as GraphqlEngine @@ -39,10 +35,10 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..)) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (Server, TestEnvironment, stopServer) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude --------------------------------------------------------------------------------- +------------------------------------------------------------------------------- -- Preamble spec :: SpecWith TestEnvironment @@ -50,7 +46,7 @@ spec = Context.runWithLocalTestEnvironment contexts tests where lhsContexts = [lhsPostgres, lhsSQLServer, lhsRemoteServer] rhsContexts = [rhsPostgres, rhsSQLServer] - contexts = combine <$> lhsContexts <*> rhsContexts + contexts = NE.fromList $ combine <$> lhsContexts <*> rhsContexts -- | Combines a lhs and a rhs. -- diff --git a/server/tests-hspec/Test/RemoteRelationship/XToDBObjectRelationshipSpec.hs b/server/tests-hspec/Test/RemoteRelationship/XToDBObjectRelationshipSpec.hs index f2b979acae5..32ead88b2f2 100644 --- a/server/tests-hspec/Test/RemoteRelationship/XToDBObjectRelationshipSpec.hs +++ b/server/tests-hspec/Test/RemoteRelationship/XToDBObjectRelationshipSpec.hs @@ -16,15 +16,11 @@ where import Data.Aeson (Value) import Data.Char (isUpper, toLower) -import Data.Foldable (traverse_) -import Data.Function ((&)) -import Data.List (intercalate, sortBy) +import Data.List.NonEmpty qualified as NE import Data.List.Split (dropBlanks, keepDelimsL, split, whenElt) import Data.Morpheus.Document (gqlDocument) import Data.Morpheus.Types qualified as Morpheus -import Data.Text (Text) import Data.Typeable (Typeable) -import GHC.Generics import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as SQLServer import Harness.GraphqlEngine qualified as GraphqlEngine @@ -36,8 +32,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..)) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (Server, TestEnvironment, stopServer) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -47,7 +43,7 @@ spec = Context.runWithLocalTestEnvironment contexts tests where lhsContexts = [lhsPostgres, lhsSQLServer, lhsRemoteServer] rhsContexts = [rhsPostgres, rhsSQLServer] - contexts = combine <$> lhsContexts <*> rhsContexts + contexts = NE.fromList $ combine <$> lhsContexts <*> rhsContexts -- | Combines a lhs and a rhs. -- @@ -456,7 +452,7 @@ lhsRemoteServerMkLocalTestEnvironment _ = do orderByFunction = case ta_order_by of Nothing -> \_ _ -> EQ Just orderByArg -> orderTrack orderByArg - limitFunction = maybe Prelude.id take ta_limit + limitFunction = maybe Hasura.Prelude.id take ta_limit pure $ tracks & filter filterFunction diff --git a/server/tests-hspec/Test/RemoteRelationship/XToRemoteSchemaRelationshipSpec.hs b/server/tests-hspec/Test/RemoteRelationship/XToRemoteSchemaRelationshipSpec.hs index 23905fcf51a..eb188306582 100644 --- a/server/tests-hspec/Test/RemoteRelationship/XToRemoteSchemaRelationshipSpec.hs +++ b/server/tests-hspec/Test/RemoteRelationship/XToRemoteSchemaRelationshipSpec.hs @@ -14,16 +14,12 @@ module Test.RemoteRelationship.XToRemoteSchemaRelationshipSpec where import Data.Char (isUpper, toLower) -import Data.Foldable (traverse_) -import Data.Function ((&)) -import Data.List (intercalate, sortBy) +import Data.List.NonEmpty qualified as NE import Data.List.Split (dropBlanks, keepDelimsL, split, whenElt) import Data.Morpheus.Document (gqlDocument) import Data.Morpheus.Types import Data.Morpheus.Types qualified as Morpheus -import Data.Text (Text) import Data.Typeable (Typeable) -import GHC.Generics (Generic) import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as SQLServer import Harness.GraphqlEngine qualified as GraphqlEngine @@ -35,8 +31,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (Server, TestEnvironment, stopServer) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -44,7 +40,7 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.runWithLocalTestEnvironment contexts tests where - contexts = map mkContext [lhsPostgres, lhsSQLServer, lhsRemoteServer] + contexts = NE.fromList $ map mkContext [lhsPostgres, lhsSQLServer, lhsRemoteServer] lhsPostgres = Context { name = Context.Backend Context.Postgres, @@ -347,7 +343,7 @@ lhsRemoteServerMkLocalTestEnvironment _ = do orderByFunction = case ta_order_by of Nothing -> \_ _ -> EQ Just orderByArg -> orderTrack orderByArg - limitFunction = maybe Prelude.id take ta_limit + limitFunction = maybe Hasura.Prelude.id take ta_limit pure $ tracks & filter filterFunction diff --git a/server/tests-hspec/Test/RequestHeadersSpec.hs b/server/tests-hspec/Test/RequestHeadersSpec.hs index 6075248274d..398463238b5 100644 --- a/server/tests-hspec/Test/RequestHeadersSpec.hs +++ b/server/tests-hspec/Test/RequestHeadersSpec.hs @@ -3,6 +3,7 @@ -- | Tests related to request headers module Test.RequestHeadersSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Sqlserver qualified as Sqlserver import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql (graphql) @@ -16,8 +17,8 @@ import Harness.Test.Schema ) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -------------------------------------------------------------------------------- @@ -26,14 +27,16 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = sqlserverSetup, - teardown = sqlserverTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = sqlserverSetup, + teardown = sqlserverTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/RunSQLSpec.hs b/server/tests-hspec/Test/RunSQLSpec.hs index 8c43a41e1c0..793533258f8 100644 --- a/server/tests-hspec/Test/RunSQLSpec.hs +++ b/server/tests-hspec/Test/RunSQLSpec.hs @@ -3,6 +3,7 @@ -- | Test *_run_sql query API module Test.RunSQLSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.BigQuery qualified as BigQuery import Harness.Backend.Postgres qualified as Postgres import Harness.Constants qualified as Constants @@ -12,8 +13,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Permissions qualified as Permissions import Harness.Test.Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -21,25 +22,29 @@ spec :: SpecWith TestEnvironment spec = do -- BigQuery Context.run - [ Context.Context - { name = Context.Backend Context.BigQuery, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = BigQuery.setup [], - teardown = BigQuery.teardown [], - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.BigQuery, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = BigQuery.setup [], + teardown = BigQuery.teardown [], + customOptions = Nothing + } + ] + ) bigqueryTests -- Postgres Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = postgresSetup, - teardown = postgresTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = postgresSetup, + teardown = postgresTeardown, + customOptions = Nothing + } + ] + ) postgresTests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/SQLServer/InsertVarcharColumnSpec.hs b/server/tests-hspec/Test/SQLServer/InsertVarcharColumnSpec.hs index d6565c65656..9a9f147fd3e 100644 --- a/server/tests-hspec/Test/SQLServer/InsertVarcharColumnSpec.hs +++ b/server/tests-hspec/Test/SQLServer/InsertVarcharColumnSpec.hs @@ -3,6 +3,7 @@ -- | Test inserting non-ASCII characters in @'varchar' column type module Test.SQLServer.InsertVarcharColumnSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Sqlserver qualified as Sqlserver import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql (graphql) @@ -10,22 +11,24 @@ import Harness.Quoter.Sql (sql) import Harness.Quoter.Yaml (shouldReturnYaml, yaml) import Harness.Test.Context qualified as Context import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -- ** Preamble spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = mssqlSetup, - teardown = mssqlTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = mssqlSetup, + teardown = mssqlTeardown, + customOptions = Nothing + } + ] + ) tests -- ** Setup and teardown diff --git a/server/tests-hspec/Test/Schema/DataValidation/PermissionSpec.hs b/server/tests-hspec/Test/Schema/DataValidation/PermissionSpec.hs index 3bfd45493a8..f7884def78b 100644 --- a/server/tests-hspec/Test/Schema/DataValidation/PermissionSpec.hs +++ b/server/tests-hspec/Test/Schema/DataValidation/PermissionSpec.hs @@ -3,6 +3,7 @@ -- | Test select permissions module Test.Schema.DataValidation.PermissionSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.BigQuery qualified as BigQuery import Harness.Exceptions import Harness.GraphqlEngine qualified as GraphqlEngine @@ -12,8 +13,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, it) -import Prelude -------------------------------------------------------------------------------- @@ -22,14 +23,16 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.BigQuery, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = bigquerySetup, - teardown = bigqueryTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.BigQuery, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = bigquerySetup, + teardown = bigqueryTeardown, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/Schema/DefaultValuesSpec.hs b/server/tests-hspec/Test/Schema/DefaultValuesSpec.hs index e6825a0b112..97a30f2ebb2 100644 --- a/server/tests-hspec/Test/Schema/DefaultValuesSpec.hs +++ b/server/tests-hspec/Test/Schema/DefaultValuesSpec.hs @@ -8,7 +8,7 @@ module Test.Schema.DefaultValuesSpec (spec) where import Data.Aeson (Value) -import Data.Text (Text) +import Data.List.NonEmpty qualified as NE import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as Sqlserver import Harness.GraphqlEngine (postGraphql, postGraphqlWithHeaders, postMetadata_) @@ -19,27 +19,29 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Postgres.setup schema <> setupMetadata "postgres", - teardown = Postgres.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Sqlserver.setup schema <> setupMetadata "mssql", - teardown = Sqlserver.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Postgres.setup schema <> setupMetadata "postgres", + teardown = Postgres.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Sqlserver.setup schema <> setupMetadata "mssql", + teardown = Sqlserver.teardown schema, + customOptions = Nothing + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/Schema/TableRelationships/ArrayRelationshipsSpec.hs b/server/tests-hspec/Test/Schema/TableRelationships/ArrayRelationshipsSpec.hs index bf01092961d..6ee565b8ca4 100644 --- a/server/tests-hspec/Test/Schema/TableRelationships/ArrayRelationshipsSpec.hs +++ b/server/tests-hspec/Test/Schema/TableRelationships/ArrayRelationshipsSpec.hs @@ -3,6 +3,7 @@ module Test.Schema.TableRelationships.ArrayRelationshipsSpec (spec) where import Data.Aeson (Value) +import Data.List.NonEmpty qualified as NE import Harness.Backend.BigQuery qualified as BigQuery import Harness.Backend.Citus qualified as Citus import Harness.Backend.Mysql qualified as Mysql @@ -15,52 +16,54 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = do Context.run - [ Context.Context - { name = Context.Backend Context.MySQL, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Mysql.setup schema, - teardown = Mysql.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Postgres.setup schema, - teardown = Postgres.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.Citus, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Citus.setup schema, - teardown = Citus.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.SQLServer, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Sqlserver.setup schema, - teardown = Sqlserver.teardown schema, - customOptions = Nothing - }, - Context.Context - { name = Context.Backend Context.BigQuery, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = BigQuery.setup schema, - teardown = BigQuery.teardown schema, - customOptions = - Just $ - Context.Options - { stringifyNumbers = True - } - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.MySQL, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Mysql.setup schema, + teardown = Mysql.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Postgres.setup schema, + teardown = Postgres.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.Citus, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Citus.setup schema, + teardown = Citus.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.SQLServer, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Sqlserver.setup schema, + teardown = Sqlserver.teardown schema, + customOptions = Nothing + }, + Context.Context + { name = Context.Backend Context.BigQuery, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = BigQuery.setup schema, + teardown = BigQuery.teardown schema, + customOptions = + Just $ + Context.Options + { stringifyNumbers = True + } + } + ] + ) tests -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/Schema/TableRelationships/ObjectRelationshipsSpec.hs b/server/tests-hspec/Test/Schema/TableRelationships/ObjectRelationshipsSpec.hs index 86593885399..a2e13f40725 100644 --- a/server/tests-hspec/Test/Schema/TableRelationships/ObjectRelationshipsSpec.hs +++ b/server/tests-hspec/Test/Schema/TableRelationships/ObjectRelationshipsSpec.hs @@ -9,8 +9,8 @@ -- https://hasura.io/docs/latest/schema/bigquery/table-relationships/index/ module Test.Schema.TableRelationships.ObjectRelationshipsSpec (spec) where -import Control.Monad (unless) import Data.Aeson (Value) +import Data.List.NonEmpty qualified as NE import Harness.Backend.BigQuery qualified as BigQuery import Harness.Backend.Mysql qualified as Mysql import Harness.Backend.Postgres qualified as Postgres @@ -23,31 +23,35 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec (SpecWith, describe, it) -import Prelude spec :: SpecWith TestEnvironment spec = do Context.run - [ Context.Context - { name = Context.Backend Context.MySQL, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Mysql.setup schema, - teardown = Mysql.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.MySQL, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Mysql.setup schema, + teardown = Mysql.teardown schema, + customOptions = Nothing + } + ] + ) $ tests MySQL Context.run - [ Context.Context - { name = Context.Backend Context.Postgres, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = Postgres.setup schema, - teardown = Postgres.teardown schema, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.Postgres, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = Postgres.setup schema, + teardown = Postgres.teardown schema, + customOptions = Nothing + } + ] + ) $ tests Postgres -- Context.run @@ -73,18 +77,20 @@ spec = do -- $ tests SQLServer Context.run - [ Context.Context - { name = Context.Backend Context.BigQuery, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = BigQuery.setup schema, - teardown = BigQuery.teardown schema, - customOptions = - Just $ - Context.Options - { stringifyNumbers = True - } - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.BigQuery, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = BigQuery.setup schema, + teardown = BigQuery.teardown schema, + customOptions = + Just $ + Context.Options + { stringifyNumbers = True + } + } + ] + ) $ tests BigQuery -------------------------------------------------------------------------------- diff --git a/server/tests-hspec/Test/ServiceLivenessSpec.hs b/server/tests-hspec/Test/ServiceLivenessSpec.hs index da8834aefb9..b1fd8c2b523 100644 --- a/server/tests-hspec/Test/ServiceLivenessSpec.hs +++ b/server/tests-hspec/Test/ServiceLivenessSpec.hs @@ -9,8 +9,8 @@ import Harness.Backend.Sqlserver qualified as Sqlserver import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Http qualified as Http import Harness.TestEnvironment (TestEnvironment (TestEnvironment, server)) +import Hasura.Prelude import Test.Hspec -import Prelude spec :: SpecWith TestEnvironment spec = do diff --git a/server/tests-hspec/Test/ViewsSpec.hs b/server/tests-hspec/Test/ViewsSpec.hs index 6aaed887bf7..e975982ce12 100644 --- a/server/tests-hspec/Test/ViewsSpec.hs +++ b/server/tests-hspec/Test/ViewsSpec.hs @@ -3,6 +3,7 @@ -- | Test views. module Test.ViewsSpec (spec) where +import Data.List.NonEmpty qualified as NE import Harness.Backend.Mysql as Mysql import Harness.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql @@ -12,8 +13,8 @@ import Harness.Test.Context qualified as Context import Harness.Test.Schema (Table (..), table) import Harness.Test.Schema qualified as Schema import Harness.TestEnvironment (TestEnvironment) +import Hasura.Prelude import Test.Hspec -import Prelude -------------------------------------------------------------------------------- -- Preamble @@ -21,14 +22,16 @@ import Prelude spec :: SpecWith TestEnvironment spec = Context.run - [ Context.Context - { name = Context.Backend Context.MySQL, - mkLocalTestEnvironment = Context.noLocalTestEnvironment, - setup = mysqlSetup, - teardown = mysqlTeardown, - customOptions = Nothing - } - ] + ( NE.fromList + [ Context.Context + { name = Context.Backend Context.MySQL, + mkLocalTestEnvironment = Context.noLocalTestEnvironment, + setup = mysqlSetup, + teardown = mysqlTeardown, + customOptions = Nothing + } + ] + ) tests --------------------------------------------------------------------------------