From ccea1da1d50479e3233f77ceaba30f520cd05e68 Mon Sep 17 00:00:00 2001 From: Antoine Leblanc Date: Thu, 17 Mar 2022 20:53:56 +0000 Subject: [PATCH] Enable and test remote relationships from remote schemas. ### Description This is it! This PR enables the Metadata API for remote relationships from remote schemas, adds tests, ~~adds documentation~~, adds an entry to the Changelog. This is the release PR that enables the feature. ### Checklist - [ ] Tests: - [x] RS-to-Postgres (high level) - [x] RS-to-RS (high level) - [x] From RS specifically (testing for edge cases) - [x] Metadata API tests - [ ] Unit testing the actual engine? - [x] Changelog entry - [ ] Documentation? PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3974 Co-authored-by: Vamshi Surabhi <6562944+0x777@users.noreply.github.com> Co-authored-by: Vishnu Bharathi <4211715+scriptnull@users.noreply.github.com> Co-authored-by: jkachmar <8461423+jkachmar@users.noreply.github.com> GitOrigin-RevId: c9aebf12e6eebef8d264ea831a327b968d4be9d2 --- CHANGELOG.md | 44 ++ server/graphql-engine.cabal | 1 + .../Hasura/RQL/DDL/RemoteRelationship.hs | 2 +- server/src-lib/Hasura/Server/API/Metadata.hs | 11 + .../Hasura/Server/API/Metadata.hs-boot | 4 + server/tests-hspec/Harness/Constants.hs | 2 +- server/tests-hspec/Harness/GraphqlEngine.hs | 25 +- server/tests-hspec/Harness/Http.hs | 6 +- server/tests-hspec/Harness/RemoteServer.hs | 13 + server/tests-hspec/Harness/State.hs | 7 +- server/tests-hspec/Harness/Test/Context.hs | 2 + server/tests-hspec/SpecHook.hs | 4 +- .../FromRemoteSchemaSpec.hs | 747 ++++++++++++++++++ .../XToDBArrayRelationshipSpec.hs | 269 ++++++- .../XToDBObjectRelationshipSpec.hs | 246 +++++- .../XToRemoteSchemaRelationshipSpec.hs | 246 +++++- server/tests-py/test_schema_stitching.py | 4 +- 17 files changed, 1540 insertions(+), 93 deletions(-) create mode 100644 server/tests-hspec/Test/RemoteRelationship/FromRemoteSchemaSpec.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index e68f7e0062c..7caa60edbe7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,50 @@ # Hasura GraphQL Engine Changelog ## Next release + +### Remote relationships from remote schemas + +This release adds three new metadata API commands: +- `create_remote_schema_remote_relationship` +- `update_remote_schema_remote_relationship` +- `delete_remote_schema_remote_relationship` + +that allows to create remote relationships between remote schemas on +the left-hand side and databases or remote schemas on the right-hand +side. Both use the same syntax as remote relationships from databases: + +```yaml +type: create_remote_schema_remote_relationship +args: + remote_schema: LeftHandSide + type_name: LeftHandSideTypeName + name: RelationshipName + definition: + to_remote_schema: + remote_schema: RightHandSideSchema + lhs_fields: [LHSJoinKeyName] + remote_field: + rhsFieldName: + arguments: + ids: $LHSJoinKeyName + +type: create_remote_schema_remote_relationship +args: + remote_schema: LeftHandSide + type_name: LeftHandSideTypeName + name: RelationshipName + definition: + to_source: + source: RightHandSideSource + table: {schema: public, name: RHSTable} + relationship_type: object + field_mapping: + LHSJoinKeyName: RHSColumnName +``` + +Similarly to DB-to-DB relationships, only `Postgres` is supported on +the right-hand side for now. + ### Deprecations * The `custom_column_names` property of TableConfig used on `_track_table` and `set_table_customization` metadata APIs has been deprecated in favour of the new `column_config` property. `custom_column_names` will still work for now, however, values used in `column_config` will take precedence over values from `custom_column_names` and any overlapped values in `custom_column_names` will be discarded. diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index ec1dbda6d2d..ea4f530863b 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -1047,6 +1047,7 @@ test-suite tests-hspec Test.ObjectRelationshipsLimitSpec Test.ObjectRelationshipsSpec Test.OrderingSpec + Test.RemoteRelationship.FromRemoteSchemaSpec Test.RemoteRelationship.XToDBArrayRelationshipSpec Test.RemoteRelationship.XToDBObjectRelationshipSpec Test.RemoteRelationship.XToRemoteSchemaRelationshipSpec diff --git a/server/src-lib/Hasura/RQL/DDL/RemoteRelationship.hs b/server/src-lib/Hasura/RQL/DDL/RemoteRelationship.hs index 5f4ba17d2e9..7ddbc3b40e2 100644 --- a/server/src-lib/Hasura/RQL/DDL/RemoteRelationship.hs +++ b/server/src-lib/Hasura/RQL/DDL/RemoteRelationship.hs @@ -364,7 +364,7 @@ getRemoteSchemaEntityJoinColumns :: getRemoteSchemaEntityJoinColumns remoteSchemaName introspection typeName = do typeDefinition <- onNothing (lookupType introspection typeName) $ - throw400 NotFound ("no such type defined in remote schema: " <>> remoteSchemaName) + throw400 NotFound ("no type named " <> typeName <<> " defined in remote schema " <>> remoteSchemaName) case typeDefinition of G.TypeDefinitionObject objectDefinition -> pure $ diff --git a/server/src-lib/Hasura/Server/API/Metadata.hs b/server/src-lib/Hasura/Server/API/Metadata.hs index ec2f14442d4..0db41360f93 100644 --- a/server/src-lib/Hasura/Server/API/Metadata.hs +++ b/server/src-lib/Hasura/Server/API/Metadata.hs @@ -112,6 +112,10 @@ data RQLMetadataV1 | -- Remote schemas permissions RMAddRemoteSchemaPermissions !AddRemoteSchemaPermission | RMDropRemoteSchemaPermissions !DropRemoteSchemaPermissions + | -- Remote Schema remote relationships + RMCreateRemoteSchemaRemoteRelationship CreateRemoteSchemaRemoteRelationship + | RMUpdateRemoteSchemaRemoteRelationship CreateRemoteSchemaRemoteRelationship + | RMDeleteRemoteSchemaRemoteRelationship DeleteRemoteSchemaRemoteRelationship | -- Scheduled triggers RMCreateCronTrigger !(Unvalidated CreateCronTrigger) | RMDeleteCronTrigger !ScheduledTriggerName @@ -185,6 +189,9 @@ instance FromJSON RQLMetadataV1 where "introspect_remote_schema" -> RMIntrospectRemoteSchema <$> args "add_remote_schema_permissions" -> RMAddRemoteSchemaPermissions <$> args "drop_remote_schema_permissions" -> RMDropRemoteSchemaPermissions <$> args + "create_remote_schema_remote_relationship" -> RMCreateRemoteSchemaRemoteRelationship <$> args + "update_remote_schema_remote_relationship" -> RMUpdateRemoteSchemaRemoteRelationship <$> args + "delete_remote_schema_remote_relationship" -> RMDeleteRemoteSchemaRemoteRelationship <$> args "create_cron_trigger" -> RMCreateCronTrigger <$> args "delete_cron_trigger" -> RMDeleteCronTrigger <$> args "create_scheduled_event" -> RMCreateScheduledEvent <$> args @@ -317,6 +324,7 @@ runMetadataQuery env logger instanceId userInfo httpManager serverConfigCtx sche (MaintenanceModeDisabled, ReadOnlyModeDisabled) -> do -- set modified metadata in storage newResourceVersion <- setMetadata (fromMaybe currentResourceVersion _rqlMetadataResourceVersion) modMetadata + -- notify schema cache sync notifySchemaCacheSync newResourceVersion instanceId cacheInvalidations (_, modSchemaCache', _) <- @@ -449,6 +457,9 @@ runMetadataQueryV1M env currentResourceVersion = \case RMIntrospectRemoteSchema q -> runIntrospectRemoteSchema q RMAddRemoteSchemaPermissions q -> runAddRemoteSchemaPermissions q RMDropRemoteSchemaPermissions q -> runDropRemoteSchemaPermissions q + RMCreateRemoteSchemaRemoteRelationship q -> runCreateRemoteSchemaRemoteRelationship q + RMUpdateRemoteSchemaRemoteRelationship q -> runUpdateRemoteSchemaRemoteRelationship q + RMDeleteRemoteSchemaRemoteRelationship q -> runDeleteRemoteSchemaRemoteRelationship q RMCreateCronTrigger q -> validateTransforms (unUnvalidate . cctRequestTransform . _Just) diff --git a/server/src-lib/Hasura/Server/API/Metadata.hs-boot b/server/src-lib/Hasura/Server/API/Metadata.hs-boot index d0c096b18e7..220fc0fa40c 100644 --- a/server/src-lib/Hasura/Server/API/Metadata.hs-boot +++ b/server/src-lib/Hasura/Server/API/Metadata.hs-boot @@ -74,6 +74,10 @@ data RQLMetadataV1 | -- Remote schemas permissions RMAddRemoteSchemaPermissions !AddRemoteSchemaPermission | RMDropRemoteSchemaPermissions !DropRemoteSchemaPermissions + | -- Remote Schema remote relationships + RMCreateRemoteSchemaRemoteRelationship CreateRemoteSchemaRemoteRelationship + | RMUpdateRemoteSchemaRemoteRelationship CreateRemoteSchemaRemoteRelationship + | RMDeleteRemoteSchemaRemoteRelationship DeleteRemoteSchemaRemoteRelationship | -- Scheduled triggers RMCreateCronTrigger !(Unvalidated CreateCronTrigger) | RMDeleteCronTrigger !ScheduledTriggerName diff --git a/server/tests-hspec/Harness/Constants.hs b/server/tests-hspec/Harness/Constants.hs index 687bd39fb44..c3b223e3e65 100644 --- a/server/tests-hspec/Harness/Constants.hs +++ b/server/tests-hspec/Harness/Constants.hs @@ -263,7 +263,7 @@ serveOptions = -- only used in 'serveOptions'. -- -- This should be adjusted locally for debugging purposes; e.g. change it to --- @Just L.Debug@ to enable all logs. +-- @Just L.LevelDebug@ to enable all logs. -- -- See 'L.LogLevel' for an enumeration of available log levels. engineLogLevel :: Maybe L.LogLevel diff --git a/server/tests-hspec/Harness/GraphqlEngine.hs b/server/tests-hspec/Harness/GraphqlEngine.hs index 69938d7fdd6..44212bb9264 100644 --- a/server/tests-hspec/Harness/GraphqlEngine.hs +++ b/server/tests-hspec/Harness/GraphqlEngine.hs @@ -21,12 +21,8 @@ module Harness.GraphqlEngine setSource, setSources, - -- * Misc. Helpers - graphqlEndpoint, - - -- * Server Setup & Teardown + -- * Server Setup startServerThread, - stopServer, -- * Re-exports serverUrl, @@ -36,7 +32,7 @@ where ------------------------------------------------------------------------------- -import Control.Concurrent (forkIO, killThread, threadDelay) +import Control.Concurrent (forkIO, threadDelay) import Control.Exception.Safe (bracket) import Control.Monad.Trans.Managed (ManagedT (..), lowerManagedT) import Data.Aeson (Value, object, (.=)) @@ -85,7 +81,7 @@ post_ state path = void . postWithHeaders_ state path mempty postWithHeaders :: HasCallStack => State -> String -> Http.RequestHeaders -> Value -> IO Value postWithHeaders (getServer -> Server {urlPrefix, port}) path = - Http.postValue_ (urlPrefix ++ ":" ++ show port ++ path) + Http.postValue (urlPrefix ++ ":" ++ show port ++ path) -- | Post some JSON to graphql-engine, getting back more JSON. -- @@ -150,17 +146,6 @@ args: ------------------------------------------------------------------------------- --- | Extracts the full GraphQL endpoint URL from a given 'Server'. --- --- @ --- > graphqlEndpoint (Server 8080 "http://localhost" someThreadId) --- "http://localhost:8080/graphql" --- @ -graphqlEndpoint :: Server -> String -graphqlEndpoint server = serverUrl server ++ "/graphql" - -------------------------------------------------------------------------------- - -- | Choose a random port and start a graphql-engine server on that -- port accessible from localhost. It waits until the server is -- available before returning. @@ -183,10 +168,6 @@ startServerThread murlPrefixport = do Http.healthCheck (serverUrl server) pure server --- | Forcibly stop a given 'Server'. -stopServer :: Server -> IO () -stopServer Server {threadId} = killThread threadId - ------------------------------------------------------------------------------- -- | Run the graphql-engine server. diff --git a/server/tests-hspec/Harness/Http.hs b/server/tests-hspec/Harness/Http.hs index 71058c7ba59..50a5721e431 100644 --- a/server/tests-hspec/Harness/Http.hs +++ b/server/tests-hspec/Harness/Http.hs @@ -1,7 +1,7 @@ -- | Helper functions for HTTP requests. module Harness.Http ( get_, - postValue_, + postValue, healthCheck, Http.RequestHeaders, ) @@ -32,8 +32,8 @@ get_ url = do -- | Post the JSON to the given URL, and produces a very descriptive -- exception on failure. -postValue_ :: HasCallStack => String -> Http.RequestHeaders -> Value -> IO Value -postValue_ url headers value = do +postValue :: HasCallStack => String -> Http.RequestHeaders -> Value -> IO Value +postValue url headers value = do let request = Http.setRequestHeaders headers $ Http.setRequestMethod Http.methodPost $ diff --git a/server/tests-hspec/Harness/RemoteServer.hs b/server/tests-hspec/Harness/RemoteServer.hs index 6bc54861c71..168051fa32a 100644 --- a/server/tests-hspec/Harness/RemoteServer.hs +++ b/server/tests-hspec/Harness/RemoteServer.hs @@ -3,6 +3,7 @@ module Harness.RemoteServer ( run, generateInterpreter, generateQueryInterpreter, + graphqlEndpoint, ) where @@ -162,6 +163,18 @@ generateQueryInterpreter :: Interpreter generateQueryInterpreter queryResolver = generateInterpreter queryResolver Undefined +-- | Extracts the full GraphQL endpoint URL from a given remote server's 'Server'. +-- +-- @ +-- > graphqlEndpoint (Server 8080 "http://localhost" someThreadId) +-- "http://localhost:8080/graphql" +-- @ +-- +-- NOTE: the resulting endpoint is only relevant for a 'Server' started by this +-- module's 'run' function; the GraphQL engine doesn't have a /graphql endoint. +graphqlEndpoint :: Server -> String +graphqlEndpoint server = serverUrl server ++ "/graphql" + ------------------------------------------------------------------------------- -- | An interpreter is a transformation function, applied to an incoming GraphQL diff --git a/server/tests-hspec/Harness/State.hs b/server/tests-hspec/Harness/State.hs index 939d4c72e0a..1419d7f572c 100644 --- a/server/tests-hspec/Harness/State.hs +++ b/server/tests-hspec/Harness/State.hs @@ -7,10 +7,11 @@ module Harness.State Server (..), getServer, serverUrl, + stopServer, ) where -import Control.Concurrent +import Control.Concurrent (ThreadId, killThread) import Data.Word import Hasura.Prelude hiding (State) @@ -41,3 +42,7 @@ getServer State {server} = server -- @ serverUrl :: Server -> String serverUrl Server {urlPrefix, port} = urlPrefix ++ ":" ++ show port + +-- | Forcibly stop a given 'Server'. +stopServer :: Server -> IO () +stopServer Server {threadId} = killThread threadId diff --git a/server/tests-hspec/Harness/Test/Context.hs b/server/tests-hspec/Harness/Test/Context.hs index 436bfd0872e..430675e1757 100644 --- a/server/tests-hspec/Harness/Test/Context.hs +++ b/server/tests-hspec/Harness/Test/Context.hs @@ -191,10 +191,12 @@ data Context a = Context -- | A name describing the given context. data ContextName = Backend BackendType + | RemoteGraphQLServer | Combine ContextName ContextName instance Show ContextName where show (Backend backend) = show backend + show RemoteGraphQLServer = "RemoteGraphQLServer" show (Combine name1 name2) = show name1 ++ "-" ++ show name2 -- | Default function for 'mkLocalState' when there's no local state. diff --git a/server/tests-hspec/SpecHook.hs b/server/tests-hspec/SpecHook.hs index a0ddec80ddd..9b4d8c90656 100644 --- a/server/tests-hspec/SpecHook.hs +++ b/server/tests-hspec/SpecHook.hs @@ -4,8 +4,8 @@ module SpecHook where import Control.Exception.Safe (bracket) -import Harness.GraphqlEngine (startServerThread, stopServer) -import Harness.State (State (..)) +import Harness.GraphqlEngine (startServerThread) +import Harness.State (State (..), stopServer) import System.Environment (lookupEnv) import Test.Hspec (Spec, SpecWith, aroundAllWith) import Text.Read (readMaybe) diff --git a/server/tests-hspec/Test/RemoteRelationship/FromRemoteSchemaSpec.hs b/server/tests-hspec/Test/RemoteRelationship/FromRemoteSchemaSpec.hs new file mode 100644 index 00000000000..d43f0120994 --- /dev/null +++ b/server/tests-hspec/Test/RemoteRelationship/FromRemoteSchemaSpec.hs @@ -0,0 +1,747 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE QuasiQuotes #-} + +-- | Tests for remote relationships from remote schemas. Unlike the "ToX" +-- modules, this module specifically cares about the remote schema on the LHS: +-- - testing the metadata API +-- - testing how we generate queries to remote schemas for the purpose of +-- making joins against them. +module Test.RemoteRelationship.FromRemoteSchemaSpec (spec) where + +import Data.Functor ((<&>)) +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) +import Harness.Quoter.Yaml (shouldReturnYaml, yaml) +import Harness.RemoteServer qualified as RemoteServer +import Harness.State (Server, State, stopServer) +import Harness.Test.Context (Context (..)) +import Harness.Test.Context qualified as Context +import Harness.Test.Schema qualified as Schema +import Test.Hspec (SpecWith, describe, it) +import Prelude + +-------------------------------------------------------------------------------- +-- Preamble + +spec :: SpecWith State +spec = Context.runWithLocalState [context] tests + where + context = + Context + { name = Context.RemoteGraphQLServer, + -- start only one remote server + mkLocalState = \_state -> + RemoteServer.run $ + RemoteServer.generateQueryInterpreter $ + Query + { object = objectResolver, + writer = writerResolver, + artist = artistResolver, + objects = objectsResolver, + articles = articlesResolver + }, + -- set that remote server as both source and target, for convenience + -- start a RHS Postgres for Metadata tests only + setup = \(state, server) -> do + GraphqlEngine.clearMetadata state + addRemoteSchema state "remote" server + addRelationships state + rhsPostgresSetup state, + -- shutdown the server + teardown = \(state, server) -> do + GraphqlEngine.clearMetadata state + stopServer server + rhsPostgresTeardown, + -- no custom options + customOptions = Nothing + } + +-- | Add a remote schema to the engine with the given name. +addRemoteSchema :: State -> String -> Server -> IO () +addRemoteSchema state rsName remoteServer = do + let remoteSchemaEndpoint = RemoteServer.graphqlEndpoint remoteServer + GraphqlEngine.postMetadata_ + state + [yaml| +type: add_remote_schema +args: + name: *rsName + definition: + url: *remoteSchemaEndpoint + |] + +-- | Create the remote relationships. +addRelationships :: State -> IO () +addRelationships state = do + GraphqlEngine.postMetadata_ + state + [yaml| +type: bulk +args: +- type: create_remote_schema_remote_relationship + args: + remote_schema: remote + type_name: Writer + name: articles + definition: + to_remote_schema: + remote_schema: remote + lhs_fields: [wIds] + remote_field: + articles: + arguments: + ids: $wIds +- type: create_remote_schema_remote_relationship + args: + remote_schema: remote + type_name: Artist + name: articles + definition: + to_remote_schema: + remote_schema: remote + lhs_fields: [aIds] + remote_field: + articles: + arguments: + ids: $aIds +- type: create_remote_schema_remote_relationship + args: + remote_schema: remote + type_name: Article + name: artist + definition: + to_remote_schema: + remote_schema: remote + lhs_fields: [aId] + remote_field: + artist: + arguments: + id: $aId +- type: create_remote_schema_remote_relationship + args: + remote_schema: remote + type_name: Article + name: writer + definition: + to_remote_schema: + remote_schema: remote + lhs_fields: [wId] + remote_field: + writer: + arguments: + id: $wId + |] + +-------------------------------------------------------------------------------- +-- Remote schema + +[gqlDocument| + +type Query { + object(id: Int!): Object + writer(id: Int!): Writer + artist(id: Int!): Artist + objects(ids: [Int!]!): [Object]! + articles(ids: [Int!]!): [Article]! +} + +union Object = Writer | Artist | Article + +type Writer { + id: Int! + name: String! + wIds: [Int!]! + local_articles: [Article!]! +} + +type Artist { + id: Int! + name: String! + aIds: [Int!]! + local_articles: [Article!]! + self: Artist! +} + +type Article { + id: Int! + title: String! + aId: Int! + wId: Int! +} + +|] + +knownObjects :: Monad m => [(Int, Object m)] +knownObjects = + [ (101, ObjectWriter writer1), + (102, ObjectWriter writer2), + (201, ObjectArtist artist1), + (202, ObjectArtist artist2), + (301, ObjectArticle article1), + (302, ObjectArticle article2), + (303, ObjectArticle article3), + (304, ObjectArticle article4) + ] + where + writer1 = Writer (pure 101) (pure "Writer1") (pure [301, 302]) (pure [article1, article2]) + writer2 = Writer (pure 102) (pure "Writer2") (pure [303, 304]) (pure [article3, article4]) + artist1 = Artist (pure 201) (pure "Artist1") (pure [301, 303]) (pure [article1, article3]) (pure artist1) + artist2 = Artist (pure 202) (pure "Artist2") (pure [302, 304]) (pure [article2, article4]) (pure artist2) + article1 = Article (pure 301) (pure "Article1") (pure 201) (pure 101) + article2 = Article (pure 302) (pure "Article2") (pure 202) (pure 101) + article3 = Article (pure 303) (pure "Article3") (pure 201) (pure 102) + article4 = Article (pure 304) (pure "Article4") (pure 202) (pure 102) + +objectResolver :: Monad m => Arg "id" Int -> m (Maybe (Object m)) +objectResolver (Arg objectId) = pure $ lookup objectId knownObjects + +writerResolver :: Monad m => Arg "id" Int -> m (Maybe (Writer m)) +writerResolver (Arg objectId) = + pure $ case lookup objectId knownObjects of + Just (ObjectWriter w) -> Just w + _ -> Nothing + +artistResolver :: Monad m => Arg "id" Int -> m (Maybe (Artist m)) +artistResolver (Arg objectId) = + pure $ case lookup objectId knownObjects of + Just (ObjectArtist a) -> Just a + _ -> Nothing + +objectsResolver :: Monad m => Arg "ids" [Int] -> m [Maybe (Object m)] +objectsResolver (Arg objectIds) = pure [lookup objectId knownObjects | objectId <- objectIds] + +articlesResolver :: Monad m => Arg "ids" [Int] -> m [Maybe (Article m)] +articlesResolver (Arg objectIds) = + pure $ + objectIds <&> \objectId -> + case lookup objectId knownObjects of + Just (ObjectArticle a) -> Just a + _ -> Nothing + +-------------------------------------------------------------------------------- +-- RHS Postgres (for metadata only) + +track :: Schema.Table +track = + Schema.Table + "track" + [ Schema.column "id" Schema.TInt, + Schema.column "title" Schema.TStr, + Schema.columnNull "album_id" Schema.TInt + ] + ["id"] + [] + [ [Schema.VInt 1, Schema.VStr "track1_album1", Schema.VInt 1], + [Schema.VInt 2, Schema.VStr "track2_album1", Schema.VInt 1], + [Schema.VInt 3, Schema.VStr "track3_album1", Schema.VInt 1], + [Schema.VInt 4, Schema.VStr "track1_album2", Schema.VInt 2], + [Schema.VInt 5, Schema.VStr "track2_album2", Schema.VInt 2], + [Schema.VInt 6, Schema.VStr "track1_album3", Schema.VInt 3], + [Schema.VInt 7, Schema.VStr "track2_album3", Schema.VInt 3], + [Schema.VInt 8, Schema.VStr "track_no_album", Schema.VNull] + ] + +rhsPostgresSetup :: State -> IO () +rhsPostgresSetup state = do + let sourceName = "db" + sourceConfig = Postgres.defaultSourceConfiguration + GraphqlEngine.postMetadata_ + state + [yaml| +type: pg_add_source +args: + name: *sourceName + configuration: *sourceConfig +|] + -- setup tables only + Postgres.createTable track + Postgres.insertTable track + Schema.trackTable Context.Postgres sourceName track state + +rhsPostgresTeardown :: IO () +rhsPostgresTeardown = Postgres.dropTable track + +-------------------------------------------------------------------------------- +-- Tests + +tests :: Context.Options -> SpecWith (State, Server) +tests opts = do + -- tests metadata API + metadataAPITests + -- ensures setup is correct + noJoinsTests opts + simpleTests opts + -- joins on neither part of the union + joinArticleTests opts + -- joins on parts of the union + joinWriterTests opts + joinArtistTests opts + -- joins on deeply nested joins + deeplyNestedJoinTests opts + +metadataAPITests :: SpecWith (State, Server) +metadataAPITests = describe "metadata API" do + it "adds a RS-RS relationship" \(state, _) -> + GraphqlEngine.postMetadata_ + state + [yaml| +type: create_remote_schema_remote_relationship +args: + remote_schema: remote + type_name: Writer + name: nonsensical1 + definition: + to_remote_schema: + remote_schema: remote + lhs_fields: [wIds] + remote_field: + articles: + arguments: + ids: $wIds + |] + it "adds a RS-RD relationship" \(state, _) -> + GraphqlEngine.postMetadata_ + state + [yaml| +type: create_remote_schema_remote_relationship +args: + remote_schema: remote + type_name: Writer + name: nonsensical2 + definition: + to_source: + source: db + table: {schema: hasura, name: track} + relationship_type: object + field_mapping: + id: id + |] + it "updates a RS-RS relationship" \(state, _) -> + GraphqlEngine.postMetadata_ + state + [yaml| +type: update_remote_schema_remote_relationship +args: + remote_schema: remote + type_name: Writer + name: nonsensical1 + definition: + to_remote_schema: + remote_schema: remote + lhs_fields: [id] + remote_field: + artist: + arguments: + id: $id + |] + it "updates a RS-DB relationship" \(state, _) -> + GraphqlEngine.postMetadata_ + state + [yaml| +type: update_remote_schema_remote_relationship +args: + remote_schema: remote + type_name: Writer + name: nonsensical2 + definition: + to_source: + source: db + table: {schema: hasura, name: track} + relationship_type: array + field_mapping: + id: id + |] + it "deletes a RS-RS relationship" \(state, _) -> + GraphqlEngine.postMetadata_ + state + [yaml| +type: delete_remote_schema_remote_relationship +args: + remote_schema: remote + type_name: Writer + name: nonsensical1 + |] + it "deletes a RS-DB relationship" \(state, _) -> + GraphqlEngine.postMetadata_ + state + [yaml| +type: delete_remote_schema_remote_relationship +args: + remote_schema: remote + type_name: Writer + name: nonsensical2 + |] + +-- | Ensure we don't insert `__hasura_internal_typename` when there are no +-- joins. +noJoinsTests :: Context.Options -> SpecWith (State, Server) +noJoinsTests opts = describe "simple joins" do + it "select objects without remote joins" \(state, _) -> do + let query = + [graphql| + query { + obj101: object(id: 101) { + __typename + } + obj201: object(id: 201) { + __typename + } + obj301: object(id: 301) { + __typename + } + } + |] + expectedResponse = + [yaml| + data: + obj101: + __typename: Writer + obj201: + __typename: Artist + obj301: + __typename: Article + + |] + shouldReturnYaml + opts + (GraphqlEngine.postGraphql state query) + expectedResponse + +simpleTests :: Context.Options -> SpecWith (State, Server) +simpleTests opts = describe "simple joins" do + it "joins writer against articles" \(state, _) -> do + let query = + [graphql| + query { + writer(id: 101) { + name + articles { + title + } + } + } + |] + expectedResponse = + [yaml| + data: + writer: + name: "Writer1" + articles: + - title: Article1 + - title: Article2 + |] + shouldReturnYaml + opts + (GraphqlEngine.postGraphql state query) + expectedResponse + it "joins no writer against articles" \(state, _) -> do + let query = + [graphql| + query { + writer(id: 0) { + name + articles { + title + } + } + } + |] + expectedResponse = + [yaml| + data: + writer: null + |] + shouldReturnYaml + opts + (GraphqlEngine.postGraphql state query) + expectedResponse + it "joins artist against articles" \(state, _) -> do + let query = + [graphql| + query { + artist(id: 201) { + name + articles { + title + } + } + } + |] + expectedResponse = + [yaml| + data: + artist: + name: "Artist1" + articles: + - title: Article1 + - title: Article3 + |] + shouldReturnYaml + opts + (GraphqlEngine.postGraphql state query) + expectedResponse + it "joins no artist against articles" \(state, _) -> do + let query = + [graphql| + query { + artist(id: 0) { + name + articles { + title + } + } + } + |] + expectedResponse = + [yaml| + data: + artist: null + |] + shouldReturnYaml + opts + (GraphqlEngine.postGraphql state query) + expectedResponse + +joinArticleTests :: Context.Options -> SpecWith (State, Server) +joinArticleTests opts = describe "join from article object" do + it "does not join" \(state, _) -> do + let query = + [graphql| + query { + object(id: 301) { + ... on Article { + title + } + ... on Artist { + name + articles { + title + } + } + ... on Writer { + name + articles { + title + } + } + } + } + |] + expectedResponse = + [yaml| + data: + object: + # to circumvent https://github.com/morpheusgraphql/morpheus-graphql/issues/687 + __typename: Article + title: "Article1" + |] + shouldReturnYaml + opts + (GraphqlEngine.postGraphql state query) + expectedResponse + +joinWriterTests :: Context.Options -> SpecWith (State, Server) +joinWriterTests opts = describe "join from writer object" do + it "joins against articles" \(state, _) -> do + let query = + [graphql| + query { + object(id: 101) { + ... on Article { + title + } + ... on Artist { + name + articles { + title + } + } + ... on Writer { + name + articles { + title + } + } + } + } + |] + expectedResponse = + [yaml| + data: + object: + # to circumvent https://github.com/morpheusgraphql/morpheus-graphql/issues/687 + __typename: Writer + name: "Writer1" + articles: + - title: Article1 + - title: Article2 + |] + shouldReturnYaml + opts + (GraphqlEngine.postGraphql state query) + expectedResponse + +joinArtistTests :: Context.Options -> SpecWith (State, Server) +joinArtistTests opts = describe "join from artist object" do + it "joins against articles" \(state, _) -> do + let query = + [graphql| + query { + object(id: 201) { + ... on Article { + title + } + ... on Artist { + name + articles { + title + } + } + ... on Writer { + name + articles { + title + } + } + } + } + |] + expectedResponse = + [yaml| + data: + object: + # to circumvent https://github.com/morpheusgraphql/morpheus-graphql/issues/687 + __typename: Artist + name: "Artist1" + articles: + - title: Article1 + - title: Article3 + |] + shouldReturnYaml + opts + (GraphqlEngine.postGraphql state query) + expectedResponse + +deeplyNestedJoinTests :: Context.Options -> SpecWith (State, Server) +deeplyNestedJoinTests opts = describe "join from artist object" do + it "joins ambiguously nested articles depending on the full path" \(state, _) -> do + let query = + [graphql| + query { + objects(ids: [101, 201]) { + ... on Artist { + local_articles { # local join + title + foo: writer { # remote join + bar: wIds + baz: articles { # remote join + title + } + } + } + } + ... on Writer { + local_articles { # local join + title + foo: artist { # remote join + bar: aIds + baz: articles { # remote join + title + } + } + } + } + } + } + |] + expectedResponse = + [yaml| + data: + objects: + - local_articles: + - title: Article1 + foo: + bar: + - 301 + - 303 + baz: + - title: Article1 + - title: Article3 + - title: Article2 + foo: + bar: + - 302 + - 304 + baz: + - title: Article2 + - title: Article4 + # to circumvent https://github.com/morpheusgraphql/morpheus-graphql/issues/687 + __typename: Writer + - local_articles: + - title: Article1 + foo: + bar: + - 301 + - 302 + baz: + - title: Article1 + - title: Article2 + - title: Article3 + foo: + bar: + - 303 + - 304 + baz: + - title: Article3 + - title: Article4 + # to circumvent https://github.com/morpheusgraphql/morpheus-graphql/issues/687 + __typename: Artist + |] + shouldReturnYaml + opts + (GraphqlEngine.postGraphql state query) + expectedResponse + it "joins nested articles at different depths" \(state, _) -> do + let query = + [graphql| + query { + objects(ids: [102, 202]) { + ... on Artist { + bar: self { + baz: articles { + title + } + } + } + ... on Writer { + bar: articles { + title + } + } + } + } + |] + expectedResponse = + [yaml| + data: + objects: + - bar: + - title: Article3 + - title: Article4 + # to circumvent https://github.com/morpheusgraphql/morpheus-graphql/issues/687 + __typename: Writer + - bar: + baz: + - title: Article2 + - title: Article4 + # to circumvent https://github.com/morpheusgraphql/morpheus-graphql/issues/687 + __typename: Artist + |] + shouldReturnYaml + opts + (GraphqlEngine.postGraphql state query) + expectedResponse diff --git a/server/tests-hspec/Test/RemoteRelationship/XToDBArrayRelationshipSpec.hs b/server/tests-hspec/Test/RemoteRelationship/XToDBArrayRelationshipSpec.hs index d2b1c7b4567..76a695b8989 100644 --- a/server/tests-hspec/Test/RemoteRelationship/XToDBArrayRelationshipSpec.hs +++ b/server/tests-hspec/Test/RemoteRelationship/XToDBArrayRelationshipSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE QuasiQuotes #-} -- | Tests for array remote relationships to databases. Remote relationships are @@ -15,13 +16,24 @@ where import Control.Lens (findOf, has, only, (^?!)) import Data.Aeson (Value) import Data.Aeson.Lens (key, values, _String) -import Data.Foldable (for_) +import Data.Char (isUpper, toLower) +import Data.Foldable (for_, traverse_) +import Data.Function ((&)) +import Data.List (intercalate, sortBy) +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.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql (graphql) import Harness.Quoter.Yaml (shouldBeYaml, shouldReturnYaml, yaml) -import Harness.State (Server, State) +import Harness.RemoteServer qualified as RemoteServer +import Harness.State (Server, State, stopServer) import Harness.Test.Context (Context (..)) import Harness.Test.Context qualified as Context import Harness.Test.Schema qualified as Schema @@ -34,7 +46,7 @@ import Prelude spec :: SpecWith State spec = Context.runWithLocalState contexts tests where - lhsContexts = [lhsPostgres] + lhsContexts = [lhsPostgres, lhsRemoteServer] rhsContexts = [rhsPostgres] contexts = combine <$> lhsContexts <*> rhsContexts @@ -94,10 +106,15 @@ lhsPostgres tableName = customOptions = Nothing } -{- -lhsRemoteServer :: Value -> Context -lhsRemoteServer tableName = Context "from RS" (lhsRemoteSetup tableName) lhsRemoteTeardown --} +lhsRemoteServer :: LHSContext +lhsRemoteServer tableName = + Context + { name = Context.RemoteGraphQLServer, + mkLocalState = lhsRemoteServerMkLocalState, + setup = lhsRemoteServerSetup tableName, + teardown = lhsRemoteServerTeardown, + customOptions = Nothing + } -------------------------------------------------------------------------------- @@ -231,10 +248,197 @@ args: |] lhsPostgresTeardown :: (State, Maybe Server) -> IO () -lhsPostgresTeardown (state, _) = do - let sourceName = "source" - Schema.untrackTable Context.Postgres sourceName artist state - Postgres.dropTable artist +lhsPostgresTeardown _ = Postgres.dropTable artist + +-------------------------------------------------------------------------------- +-- LHS Remote Server + +-- | To circumvent Morpheus' default behaviour, which is to capitalize type +-- names and field names for Haskell records to be consistent with their +-- corresponding GraphQL equivalents, we define most of the schema manually with +-- the following options. +hasuraTypeOptions :: Morpheus.GQLTypeOptions +hasuraTypeOptions = + Morpheus.defaultTypeOptions + { -- transformation to apply to constructors, for enums; we simply map to + -- lower case: + -- Asc -> asc + Morpheus.constructorTagModifier = map toLower, + -- transformation to apply to field names; we drop all characters up to and + -- including the first underscore: + -- hta_where -> where + Morpheus.fieldLabelModifier = tail . dropWhile (/= '_'), + -- transformation to apply to type names; we split the name on uppercase + -- letters, intercalate with underscore, and map everything to lowercase: + -- HasuraTrack -> hasura_track + Morpheus.typeNameModifier = \_ -> + map toLower + . intercalate "_" + . split (dropBlanks $ keepDelimsL $ whenElt isUpper) + } + +data Query m = Query + { hasura_artist :: HasuraArtistArgs -> m [HasuraArtist m] + } + deriving (Generic) + +instance Typeable m => Morpheus.GQLType (Query m) + +data HasuraArtistArgs = HasuraArtistArgs + { aa_where :: Maybe HasuraArtistBoolExp, + aa_order_by :: Maybe [HasuraArtistOrderBy], + aa_limit :: Maybe Int + } + deriving (Generic) + +instance Morpheus.GQLType HasuraArtistArgs where + typeOptions _ _ = hasuraTypeOptions + +data HasuraArtist m = HasuraArtist + { a_id :: m (Maybe Int), + a_name :: m (Maybe Text) + } + deriving (Generic) + +instance Typeable m => Morpheus.GQLType (HasuraArtist m) where + typeOptions _ _ = hasuraTypeOptions + +data HasuraArtistOrderBy = HasuraArtistOrderBy + { aob_id :: Maybe OrderType, + aob_name :: Maybe OrderType + } + deriving (Generic) + +instance Morpheus.GQLType HasuraArtistOrderBy where + typeOptions _ _ = hasuraTypeOptions + +data HasuraArtistBoolExp = HasuraArtistBoolExp + { abe__and :: Maybe [HasuraArtistBoolExp], + abe__or :: Maybe [HasuraArtistBoolExp], + abe__not :: Maybe HasuraArtistBoolExp, + abe_id :: Maybe IntCompExp, + abe_name :: Maybe StringCompExp + } + deriving (Generic) + +instance Morpheus.GQLType HasuraArtistBoolExp where + typeOptions _ _ = hasuraTypeOptions + +data OrderType = Asc | Desc + deriving (Show, Generic) + +instance Morpheus.GQLType OrderType where + typeOptions _ _ = hasuraTypeOptions + +[gqlDocument| + +input IntCompExp { + _eq: Int +} + +input StringCompExp { + _eq: String +} + +|] + +lhsRemoteServerMkLocalState :: State -> IO (Maybe Server) +lhsRemoteServerMkLocalState _ = do + server <- + RemoteServer.run $ + RemoteServer.generateQueryInterpreter (Query {hasura_artist}) + pure $ Just server + where + -- Implements the @hasura_artist@ field of the @Query@ type. + hasura_artist (HasuraArtistArgs {..}) = do + let filterFunction = case aa_where of + Nothing -> const True + Just whereArg -> flip matchArtist whereArg + orderByFunction = case aa_order_by of + Nothing -> \_ _ -> EQ + Just orderByArg -> orderArtist orderByArg + limitFunction = case aa_limit of + Nothing -> Prelude.id + Just limitArg -> take limitArg + pure $ + artists + & filter filterFunction + & sortBy orderByFunction + & limitFunction + & map mkArtist + -- Returns True iif the given artist matches the given boolean expression. + matchArtist artistInfo@(artistId, artistName) (HasuraArtistBoolExp {..}) = + and + [ maybe True (all (matchArtist artistInfo)) abe__and, + maybe True (any (matchArtist artistInfo)) abe__or, + maybe True (not . matchArtist artistInfo) abe__not, + maybe True (matchMaybeInt artistId) abe_id, + maybe True (matchString artistName) abe_name + ] + matchString stringField StringCompExp {..} = Just stringField == _eq + matchMaybeInt maybeIntField IntCompExp {..} = maybeIntField == _eq + -- Returns an ordering between the two given artists. + orderArtist + orderByList + (artistId1, artistName1) + (artistId2, artistName2) = + flip foldMap orderByList \HasuraArtistOrderBy {..} -> + if + | Just idOrder <- aob_id -> + compareWithNullLast idOrder artistId1 artistId2 + | Just nameOrder <- aob_name -> case nameOrder of + Asc -> compare artistName1 artistName2 + Desc -> compare artistName2 artistName1 + | otherwise -> + error "empty artist_order object" + compareWithNullLast Desc x1 x2 = compareWithNullLast Asc x2 x1 + compareWithNullLast Asc Nothing Nothing = EQ + compareWithNullLast Asc (Just _) Nothing = LT + compareWithNullLast Asc Nothing (Just _) = GT + compareWithNullLast Asc (Just x1) (Just x2) = compare x1 x2 + artists = + [ (Just 1, "artist1"), + (Just 2, "artist2"), + (Just 3, "artist_no_albums"), + (Nothing, "artist_no_id") + ] + mkArtist (artistId, artistName) = + HasuraArtist + { a_id = pure artistId, + a_name = pure $ Just artistName + } + +lhsRemoteServerSetup :: Value -> (State, Maybe Server) -> IO () +lhsRemoteServerSetup tableName (state, maybeRemoteServer) = case maybeRemoteServer of + Nothing -> error "XToDBArrayRelationshipSpec: remote server local state did not succesfully create a server" + Just remoteServer -> do + let remoteSchemaEndpoint = GraphqlEngine.serverUrl remoteServer ++ "/graphql" + GraphqlEngine.postMetadata_ + state + [yaml| +type: bulk +args: +- type: add_remote_schema + args: + name: source + definition: + url: *remoteSchemaEndpoint +- type: create_remote_schema_remote_relationship + args: + remote_schema: source + type_name: hasura_artist + name: albums + definition: + to_source: + source: target + table: *tableName + relationship_type: array + field_mapping: + id: artist_id + |] + +lhsRemoteServerTeardown :: (State, Maybe Server) -> IO () +lhsRemoteServerTeardown (_, maybeServer) = traverse_ stopServer maybeServer -------------------------------------------------------------------------------- -- RHS Postgres @@ -294,16 +498,13 @@ args: |] rhsPostgresTeardown :: (State, ()) -> IO () -rhsPostgresTeardown (state, _) = do - let sourceName = "target" - Schema.untrackTable Context.Postgres sourceName album state - Postgres.dropTable album +rhsPostgresTeardown _ = Postgres.dropTable album -------------------------------------------------------------------------------- -- Tests tests :: Context.Options -> SpecWith (State, Maybe Server) -tests opts = describe "array-relationship" $ do +tests opts = describe "array-relationship" do schemaTests opts executionTests opts permissionTests opts @@ -311,7 +512,7 @@ tests opts = describe "array-relationship" $ do schemaTests :: Context.Options -> SpecWith (State, Maybe Server) schemaTests _opts = -- we introspect the schema and validate it - it "graphql-schema" $ \(state, _) -> do + it "graphql-schema" \(state, _) -> do let query = [graphql| fragment type_info on __Type { @@ -442,9 +643,9 @@ schemaTests _opts = -- | Basic queries using DB-to-DB joins executionTests :: Context.Options -> SpecWith (State, Maybe Server) -executionTests opts = describe "execution" $ do +executionTests opts = describe "execution" do -- fetches the relationship data - it "related-data" $ \(state, _) -> do + it "related-data" \(state, _) -> do let query = [graphql| query { @@ -471,7 +672,7 @@ executionTests opts = describe "execution" $ do expectedResponse -- when there are no matching rows, the relationship response should be [] - it "related-data-empty-array" $ \(state, _) -> do + it "related-data-empty-array" \(state, _) -> do let query = [graphql| query { @@ -496,7 +697,7 @@ executionTests opts = describe "execution" $ do expectedResponse -- when any of the join columns are null, the relationship should be null - it "related-data-null" $ \(state, _) -> do + it "related-data-null" \(state, _) -> do let query = [graphql| query { @@ -521,7 +722,7 @@ executionTests opts = describe "execution" $ do expectedResponse -- when the lhs response has both null and non-null values for join columns - it "related-data-non-null-and-null" $ \(state, _) -> do + it "related-data-non-null-and-null" \(state, _) -> do let query = [graphql| query { @@ -532,7 +733,7 @@ executionTests opts = describe "execution" $ do {name: {_eq: "artist_no_id"}} ] }, - order_by: {id: asc} + order_by: [{id: asc}] ) { name albums { @@ -565,15 +766,15 @@ executionTests opts = describe "execution" $ do -- | tests that describe an array relationship's data in the presence of permisisons permissionTests :: Context.Options -> SpecWith (State, Maybe Server) -permissionTests opts = describe "permission" $ do +permissionTests opts = describe "permission" do -- only the allowed rows on the target table are queryable - it "only-allowed-rows" $ \(state, _) -> do + it "only-allowed-rows" \(state, _) -> do let userHeaders = [("x-hasura-role", "role1"), ("x-hasura-artist-id", "1")] query = [graphql| query { artist: hasura_artist( - order_by: {id: asc} + order_by: [{id: asc}] ) { name albums { @@ -605,7 +806,7 @@ permissionTests opts = describe "permission" $ do -- we use an introspection query to check column permissions: -- 1. the type 'hasura_album' has only 'artist_id' and 'title', the allowed columns -- 2. the albums field in 'hasura_artist' type is of type 'hasura_album' - it "only-allowed-columns" $ \(state, _) -> do + it "only-allowed-columns" \(state, _) -> do let userHeaders = [("x-hasura-role", "role1"), ("x-hasura-artist-id", "1")] query = [graphql| @@ -643,7 +844,7 @@ permissionTests opts = describe "permission" $ do expectedResponse -- _aggregate field should not be generated when 'allow_aggregations' isn't set to 'true' - it "aggregations-not-allowed" $ \(state, _) -> do + it "aggregations-not-allowed" \(state, _) -> do let userHeaders = [("x-hasura-role", "role1")] query = [graphql| @@ -670,7 +871,7 @@ permissionTests opts = describe "permission" $ do expectedResponse -- _aggregate field should only be allowed when 'allow_aggregations' is set to 'true' - it "aggregations-allowed" $ \(state, _) -> do + it "aggregations-allowed" \(state, _) -> do let userHeaders = [("x-hasura-role", "role2")] query = [graphql| @@ -698,7 +899,7 @@ permissionTests opts = describe "permission" $ do expectedResponse -- permission limit should kick in when no query limit is specified - it "no-query-limit" $ \(state, _) -> do + it "no-query-limit" \(state, _) -> do let userHeaders = [("x-hasura-role", "role2"), ("x-hasura-artist-id", "1")] query = [graphql| @@ -727,7 +928,7 @@ permissionTests opts = describe "permission" $ do expectedResponse -- query limit should be applied when query limit <= permission limit - it "user-limit-less-than-permission-limit" $ \(state, _) -> do + it "user-limit-less-than-permission-limit" \(state, _) -> do let userHeaders = [("x-hasura-role", "role2"), ("x-hasura-artist-id", "1")] query = [graphql| @@ -755,7 +956,7 @@ permissionTests opts = describe "permission" $ do expectedResponse -- permission limit should be applied when query limit > permission limit - it "user-limit-greater-than-permission-limit" $ \(state, _) -> do + it "user-limit-greater-than-permission-limit" \(state, _) -> do let userHeaders = [("x-hasura-role", "role2"), ("x-hasura-artist-id", "1")] query = [graphql| @@ -784,7 +985,7 @@ permissionTests opts = describe "permission" $ do expectedResponse -- permission limit should only apply on 'nodes' but not on 'aggregate' - it "aggregations" $ \(state, _) -> do + it "aggregations" \(state, _) -> do let userHeaders = [("x-hasura-role", "role2"), ("x-hasura-artist-id", "1")] query = [graphql| @@ -821,7 +1022,7 @@ permissionTests opts = describe "permission" $ do expectedResponse -- query limit applies to both 'aggregate' and 'nodes' - it "aggregations-query-limit" $ \(state, _) -> do + it "aggregations-query-limit" \(state, _) -> do let userHeaders = [("x-hasura-role", "role2"), ("x-hasura-artist-id", "1")] query = [graphql| diff --git a/server/tests-hspec/Test/RemoteRelationship/XToDBObjectRelationshipSpec.hs b/server/tests-hspec/Test/RemoteRelationship/XToDBObjectRelationshipSpec.hs index 68b1adc5379..5295f3dfc4d 100644 --- a/server/tests-hspec/Test/RemoteRelationship/XToDBObjectRelationshipSpec.hs +++ b/server/tests-hspec/Test/RemoteRelationship/XToDBObjectRelationshipSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE QuasiQuotes #-} -- | Tests for object remote relationships to databases. Remote relationships @@ -14,11 +15,22 @@ module Test.RemoteRelationship.XToDBObjectRelationshipSpec 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.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.GraphqlEngine qualified as GraphqlEngine import Harness.Quoter.Graphql (graphql) import Harness.Quoter.Yaml (shouldReturnYaml, yaml) -import Harness.State (Server, State) +import Harness.RemoteServer qualified as RemoteServer +import Harness.State (Server, State, stopServer) import Harness.Test.Context (Context (..)) import Harness.Test.Context qualified as Context import Harness.Test.Schema qualified as Schema @@ -31,7 +43,7 @@ import Prelude spec :: SpecWith State spec = Context.runWithLocalState contexts tests where - lhsContexts = [lhsPostgres] + lhsContexts = [lhsPostgres, lhsRemoteServer] rhsContexts = [rhsPostgres] contexts = combine <$> lhsContexts <*> rhsContexts @@ -91,10 +103,15 @@ lhsPostgres tableName = customOptions = Nothing } -{- -lhsRemoteServer :: Value -> Context -lhsRemoteServer tableName = Context "from RS" (lhsRemoteSetup tableName) lhsRemoteTeardown --} +lhsRemoteServer :: LHSContext +lhsRemoteServer tableName = + Context + { name = Context.RemoteGraphQLServer, + mkLocalState = lhsRemoteServerMkLocalState, + setup = lhsRemoteServerSetup tableName, + teardown = lhsRemoteServerTeardown, + customOptions = Nothing + } -------------------------------------------------------------------------------- @@ -232,10 +249,210 @@ args: |] lhsPostgresTeardown :: (State, Maybe Server) -> IO () -lhsPostgresTeardown (state, _) = do - let sourceName = "source" - Schema.untrackTable Context.Postgres sourceName track state - Postgres.dropTable track +lhsPostgresTeardown _ = Postgres.dropTable track + +-------------------------------------------------------------------------------- +-- LHS Remote Server + +-- | To circumvent Morpheus' default behaviour, which is to capitalize type +-- names and field names for Haskell records to be consistent with their +-- corresponding GraphQL equivalents, we define most of the schema manually with +-- the following options. +hasuraTypeOptions :: Morpheus.GQLTypeOptions +hasuraTypeOptions = + Morpheus.defaultTypeOptions + { -- transformation to apply to constructors, for enums; we simply map to + -- lower case: + -- Asc -> asc + Morpheus.constructorTagModifier = map toLower, + -- transformation to apply to field names; we drop all characters up to and + -- including the first underscore: + -- hta_where -> where + Morpheus.fieldLabelModifier = tail . dropWhile (/= '_'), + -- transformation to apply to type names; we split the name on uppercase + -- letters, intercalate with underscore, and map everything to lowercase: + -- HasuraTrack -> hasura_track + Morpheus.typeNameModifier = \_ -> + map toLower + . intercalate "_" + . split (dropBlanks $ keepDelimsL $ whenElt isUpper) + } + +data Query m = Query + { hasura_track :: HasuraTrackArgs -> m [HasuraTrack m] + } + deriving (Generic) + +instance Typeable m => Morpheus.GQLType (Query m) + +data HasuraTrackArgs = HasuraTrackArgs + { ta_where :: Maybe HasuraTrackBoolExp, + ta_order_by :: Maybe [HasuraTrackOrderBy], + ta_limit :: Maybe Int + } + deriving (Generic) + +instance Morpheus.GQLType HasuraTrackArgs where + typeOptions _ _ = hasuraTypeOptions + +data HasuraTrack m = HasuraTrack + { t_id :: m (Maybe Int), + t_title :: m (Maybe Text), + t_album_id :: m (Maybe Int) + } + deriving (Generic) + +instance Typeable m => Morpheus.GQLType (HasuraTrack m) where + typeOptions _ _ = hasuraTypeOptions + +data HasuraTrackOrderBy = HasuraTrackOrderBy + { tob_id :: Maybe OrderType, + tob_title :: Maybe OrderType, + tob_album_id :: Maybe OrderType + } + deriving (Generic) + +instance Morpheus.GQLType HasuraTrackOrderBy where + typeOptions _ _ = hasuraTypeOptions + +data HasuraTrackBoolExp = HasuraTrackBoolExp + { tbe__and :: Maybe [HasuraTrackBoolExp], + tbe__or :: Maybe [HasuraTrackBoolExp], + tbe__not :: Maybe HasuraTrackBoolExp, + tbe_id :: Maybe IntCompExp, + tbe_title :: Maybe StringCompExp, + tbe_album_id :: Maybe IntCompExp + } + deriving (Generic) + +instance Morpheus.GQLType HasuraTrackBoolExp where + typeOptions _ _ = hasuraTypeOptions + +data OrderType = Asc | Desc + deriving (Show, Generic) + +instance Morpheus.GQLType OrderType where + typeOptions _ _ = hasuraTypeOptions + +[gqlDocument| + +input IntCompExp { + _eq: Int +} + +input StringCompExp { + _eq: String +} + +|] + +lhsRemoteServerMkLocalState :: State -> IO (Maybe Server) +lhsRemoteServerMkLocalState _ = do + server <- + RemoteServer.run $ + RemoteServer.generateQueryInterpreter (Query {hasura_track}) + pure $ Just server + where + -- Implements the @hasura_track@ field of the @Query@ type. + hasura_track (HasuraTrackArgs {..}) = do + let filterFunction = case ta_where of + Nothing -> const True + Just whereArg -> flip matchTrack whereArg + orderByFunction = case ta_order_by of + Nothing -> \_ _ -> EQ + Just orderByArg -> orderTrack orderByArg + limitFunction = case ta_limit of + Nothing -> Prelude.id + Just limitArg -> take limitArg + pure $ + tracks + & filter filterFunction + & sortBy orderByFunction + & limitFunction + & map mkTrack + -- Returns True iif the given track matches the given boolean expression. + matchTrack trackInfo@(trackId, trackTitle, maybeAlbumId) (HasuraTrackBoolExp {..}) = + and + [ maybe True (all (matchTrack trackInfo)) tbe__and, + maybe True (any (matchTrack trackInfo)) tbe__or, + maybe True (not . matchTrack trackInfo) tbe__not, + maybe True (matchInt trackId) tbe_id, + maybe True (matchString trackTitle) tbe_title, + maybe True (matchMaybeInt maybeAlbumId) tbe_album_id + ] + matchInt intField IntCompExp {..} = Just intField == _eq + matchString stringField StringCompExp {..} = Just stringField == _eq + matchMaybeInt maybeIntField IntCompExp {..} = maybeIntField == _eq + -- Returns an ordering between the two given tracks. + orderTrack + orderByList + (trackId1, trackTitle1, trackAlbumId1) + (trackId2, trackTitle2, trackAlbumId2) = + flip foldMap orderByList \HasuraTrackOrderBy {..} -> + if + | Just idOrder <- tob_id -> case idOrder of + Asc -> compare trackId1 trackId2 + Desc -> compare trackId2 trackId1 + | Just titleOrder <- tob_title -> case titleOrder of + Asc -> compare trackTitle1 trackTitle2 + Desc -> compare trackTitle2 trackTitle1 + | Just albumIdOrder <- tob_album_id -> + compareWithNullLast albumIdOrder trackAlbumId1 trackAlbumId2 + | otherwise -> + error "empty track_order object" + compareWithNullLast Desc x1 x2 = compareWithNullLast Asc x2 x1 + compareWithNullLast Asc Nothing Nothing = EQ + compareWithNullLast Asc (Just _) Nothing = LT + compareWithNullLast Asc Nothing (Just _) = GT + compareWithNullLast Asc (Just x1) (Just x2) = compare x1 x2 + tracks = + [ (1, "track1_album1", Just 1), + (2, "track2_album1", Just 1), + (3, "track3_album1", Just 1), + (4, "track1_album2", Just 2), + (5, "track2_album2", Just 2), + (6, "track1_album3", Just 3), + (7, "track2_album3", Just 3), + (8, "track_no_album", Nothing) + ] + mkTrack (trackId, title, albumId) = + HasuraTrack + { t_id = pure $ Just trackId, + t_title = pure $ Just title, + t_album_id = pure albumId + } + +lhsRemoteServerSetup :: Value -> (State, Maybe Server) -> IO () +lhsRemoteServerSetup tableName (state, maybeRemoteServer) = case maybeRemoteServer of + Nothing -> error "XToDBObjectRelationshipSpec: remote server local state did not succesfully create a server" + Just remoteServer -> do + let remoteSchemaEndpoint = GraphqlEngine.serverUrl remoteServer ++ "/graphql" + GraphqlEngine.postMetadata_ + state + [yaml| +type: bulk +args: +- type: add_remote_schema + args: + name: source + definition: + url: *remoteSchemaEndpoint +- type: create_remote_schema_remote_relationship + args: + remote_schema: source + type_name: hasura_track + name: album + definition: + to_source: + source: target + table: *tableName + relationship_type: object + field_mapping: + album_id: id + |] + +lhsRemoteServerTeardown :: (State, Maybe Server) -> IO () +lhsRemoteServerTeardown (_, maybeServer) = traverse_ stopServer maybeServer -------------------------------------------------------------------------------- -- RHS Postgres @@ -295,10 +512,7 @@ args: |] rhsPostgresTeardown :: (State, ()) -> IO () -rhsPostgresTeardown (state, _) = do - let sourceName = "target" - Schema.untrackTable Context.Postgres sourceName album state - Postgres.dropTable album +rhsPostgresTeardown _ = Postgres.dropTable album -------------------------------------------------------------------------------- -- Tests @@ -375,7 +589,7 @@ executionTests opts = describe "execution" $ do {title: {_eq: "track_no_album"}} ] }, - order_by: {id: asc} + order_by: [{id: asc}] ) { title album { @@ -411,7 +625,7 @@ permissionTests opts = describe "permission" $ do [graphql| query { track: hasura_track( - order_by: {id: asc} + order_by: [{id: asc}] ) { title album { diff --git a/server/tests-hspec/Test/RemoteRelationship/XToRemoteSchemaRelationshipSpec.hs b/server/tests-hspec/Test/RemoteRelationship/XToRemoteSchemaRelationshipSpec.hs index fb31faa080e..4031e4cdbef 100644 --- a/server/tests-hspec/Test/RemoteRelationship/XToRemoteSchemaRelationshipSpec.hs +++ b/server/tests-hspec/Test/RemoteRelationship/XToRemoteSchemaRelationshipSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE QuasiQuotes #-} -- | Tests for remote relationships to remote schemas. Remote relationships are @@ -12,15 +13,23 @@ 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.Split (dropBlanks, keepDelimsL, split, whenElt) import Data.Morpheus.Document (gqlDocument) -import Data.Morpheus.Types (Arg (..)) +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.Graphql (graphql) import Harness.Quoter.Yaml (shouldReturnYaml, yaml) import Harness.RemoteServer qualified as RemoteServer -import Harness.State (Server, State) +import Harness.State (Server, State, stopServer) import Harness.Test.Context (Context (..)) import Harness.Test.Context qualified as Context import Harness.Test.Schema qualified as Schema @@ -33,7 +42,7 @@ import Prelude spec :: SpecWith State spec = Context.runWithLocalState contexts tests where - contexts = map mkContext [lhsPostgres] + contexts = map mkContext [lhsPostgres, lhsRemoteServer] lhsPostgres = Context { name = Context.Backend Context.Postgres, @@ -42,6 +51,14 @@ spec = Context.runWithLocalState contexts tests teardown = lhsPostgresTeardown, customOptions = Nothing } + lhsRemoteServer = + Context + { name = Context.RemoteGraphQLServer, + mkLocalState = lhsRemoteServerMkLocalState, + setup = lhsRemoteServerSetup, + teardown = lhsRemoteServerTeardown, + customOptions = Nothing + } -- | Uses a given RHS context to create a combined context. mkContext :: Context (Maybe Server) -> Context LocalTestState @@ -154,6 +171,213 @@ lhsPostgresTeardown (state, _) = do Schema.untrackTable Context.Postgres sourceName track state Postgres.dropTable track +-------------------------------------------------------------------------------- +-- LHS Remote Server + +-- | To circumvent Morpheus' default behaviour, which is to capitalize type +-- names and field names for Haskell records to be consistent with their +-- corresponding GraphQL equivalents, we define most of the schema manually with +-- the following options. +hasuraTypeOptions :: Morpheus.GQLTypeOptions +hasuraTypeOptions = + Morpheus.defaultTypeOptions + { -- transformation to apply to constructors, for enums; we simply map to + -- lower case: + -- Asc -> asc + Morpheus.constructorTagModifier = map toLower, + -- transformation to apply to field names; we drop all characters up to and + -- including the first underscore: + -- hta_where -> where + Morpheus.fieldLabelModifier = tail . dropWhile (/= '_'), + -- transformation to apply to type names; we remove the leading "LHS" we + -- use to differentiate those types from the RHS ones, split the name on + -- uppercase letters, intercalate with underscore, and map everything to + -- lowercase: LHSHasuraTrack -> hasura_track + Morpheus.typeNameModifier = \_ -> + map toLower + . intercalate "_" + . split (dropBlanks $ keepDelimsL $ whenElt isUpper) + . drop 3 + } + +data LHSQuery m = LHSQuery + { q_hasura_track :: LHSHasuraTrackArgs -> m [LHSHasuraTrack m] + } + deriving (Generic) + +instance Typeable m => Morpheus.GQLType (LHSQuery m) where + typeOptions _ _ = hasuraTypeOptions + +data LHSHasuraTrackArgs = LHSHasuraTrackArgs + { ta_where :: Maybe LHSHasuraTrackBoolExp, + ta_order_by :: Maybe [LHSHasuraTrackOrderBy], + ta_limit :: Maybe Int + } + deriving (Generic) + +instance Morpheus.GQLType LHSHasuraTrackArgs where + typeOptions _ _ = hasuraTypeOptions + +data LHSHasuraTrack m = LHSHasuraTrack + { t_id :: m (Maybe Int), + t_title :: m (Maybe Text), + t_album_id :: m (Maybe Int) + } + deriving (Generic) + +instance Typeable m => Morpheus.GQLType (LHSHasuraTrack m) where + typeOptions _ _ = hasuraTypeOptions + +data LHSHasuraTrackOrderBy = LHSHasuraTrackOrderBy + { tob_id :: Maybe LHSOrderType, + tob_title :: Maybe LHSOrderType, + tob_album_id :: Maybe LHSOrderType + } + deriving (Generic) + +instance Morpheus.GQLType LHSHasuraTrackOrderBy where + typeOptions _ _ = hasuraTypeOptions + +data LHSHasuraTrackBoolExp = LHSHasuraTrackBoolExp + { tbe__and :: Maybe [LHSHasuraTrackBoolExp], + tbe__or :: Maybe [LHSHasuraTrackBoolExp], + tbe__not :: Maybe LHSHasuraTrackBoolExp, + tbe_id :: Maybe IntCompExp, + tbe_title :: Maybe StringCompExp, + tbe_album_id :: Maybe IntCompExp + } + deriving (Generic) + +instance Morpheus.GQLType LHSHasuraTrackBoolExp where + typeOptions _ _ = hasuraTypeOptions + +data LHSOrderType = Asc | Desc + deriving (Show, Generic) + +instance Morpheus.GQLType LHSOrderType where + typeOptions _ _ = hasuraTypeOptions + +[gqlDocument| + +input IntCompExp { + _eq: Int +} + +input StringCompExp { + _eq: String +} + +|] + +lhsRemoteServerMkLocalState :: State -> IO (Maybe Server) +lhsRemoteServerMkLocalState _ = do + server <- + RemoteServer.run $ + RemoteServer.generateQueryInterpreter (LHSQuery {q_hasura_track = hasura_track}) + pure $ Just server + where + -- Implements the @hasura_track@ field of the @Query@ type. + hasura_track (LHSHasuraTrackArgs {..}) = do + let filterFunction = case ta_where of + Nothing -> const True + Just whereArg -> flip matchTrack whereArg + orderByFunction = case ta_order_by of + Nothing -> \_ _ -> EQ + Just orderByArg -> orderTrack orderByArg + limitFunction = case ta_limit of + Nothing -> Prelude.id + Just limitArg -> take limitArg + pure $ + tracks + & filter filterFunction + & sortBy orderByFunction + & limitFunction + & map mkTrack + -- Returns True iif the given track matches the given boolean expression. + matchTrack trackInfo@(trackId, trackTitle, maybeAlbumId) (LHSHasuraTrackBoolExp {..}) = + and + [ maybe True (all (matchTrack trackInfo)) tbe__and, + maybe True (any (matchTrack trackInfo)) tbe__or, + maybe True (not . matchTrack trackInfo) tbe__not, + maybe True (matchInt trackId) tbe_id, + maybe True (matchString trackTitle) tbe_title, + maybe True (matchMaybeInt maybeAlbumId) tbe_album_id + ] + matchInt intField IntCompExp {..} = Just intField == _eq + matchString stringField StringCompExp {..} = Just stringField == _eq + matchMaybeInt maybeIntField IntCompExp {..} = maybeIntField == _eq + -- Returns an ordering between the two given tracks. + orderTrack + orderByList + (trackId1, trackTitle1, trackAlbumId1) + (trackId2, trackTitle2, trackAlbumId2) = + flip foldMap orderByList \LHSHasuraTrackOrderBy {..} -> + if + | Just idOrder <- tob_id -> case idOrder of + Asc -> compare trackId1 trackId2 + Desc -> compare trackId2 trackId1 + | Just titleOrder <- tob_title -> case titleOrder of + Asc -> compare trackTitle1 trackTitle2 + Desc -> compare trackTitle2 trackTitle1 + | Just albumIdOrder <- tob_album_id -> + compareWithNullLast albumIdOrder trackAlbumId1 trackAlbumId2 + | otherwise -> + error "empty track_order object" + compareWithNullLast Desc x1 x2 = compareWithNullLast Asc x2 x1 + compareWithNullLast Asc Nothing Nothing = EQ + compareWithNullLast Asc (Just _) Nothing = LT + compareWithNullLast Asc Nothing (Just _) = GT + compareWithNullLast Asc (Just x1) (Just x2) = compare x1 x2 + tracks = + [ (1, "track1_album1", Just 1), + (2, "track2_album1", Just 1), + (3, "track3_album1", Just 1), + (4, "track1_album2", Just 2), + (5, "track2_album2", Just 2), + (6, "track1_album3", Just 3), + (7, "track2_album3", Just 3), + (8, "track_no_album", Nothing) + ] + mkTrack (trackId, title, albumId) = + LHSHasuraTrack + { t_id = pure $ Just trackId, + t_title = pure $ Just title, + t_album_id = pure albumId + } + +lhsRemoteServerSetup :: (State, Maybe Server) -> IO () +lhsRemoteServerSetup (state, maybeRemoteServer) = case maybeRemoteServer of + Nothing -> error "XToDBObjectRelationshipSpec: remote server local state did not succesfully create a server" + Just remoteServer -> do + let remoteSchemaEndpoint = GraphqlEngine.serverUrl remoteServer ++ "/graphql" + GraphqlEngine.postMetadata_ + state + [yaml| +type: bulk +args: +- type: add_remote_schema + args: + name: source + definition: + url: *remoteSchemaEndpoint +- type: create_remote_schema_remote_relationship + args: + remote_schema: source + type_name: hasura_track + name: album + definition: + to_remote_schema: + remote_schema: target + lhs_fields: [album_id] + remote_field: + album: + arguments: + album_id: $album_id + |] + +lhsRemoteServerTeardown :: (State, Maybe Server) -> IO () +lhsRemoteServerTeardown (_, maybeServer) = traverse_ stopServer maybeServer + -------------------------------------------------------------------------------- -- RHS Remote Server @@ -203,21 +427,21 @@ args: |] rhsRemoteSchemaTeardown :: (State, Server) -> IO () -rhsRemoteSchemaTeardown (_, server) = GraphqlEngine.stopServer server +rhsRemoteSchemaTeardown (_, server) = stopServer server -------------------------------------------------------------------------------- -- Tests tests :: Context.Options -> SpecWith (State, LocalTestState) -tests opts = describe "remote-schema-relationship" $ do +tests opts = describe "remote-schema-relationship" do schemaTests opts executionTests opts -- | Basic queries using *-to-DB joins executionTests :: Context.Options -> SpecWith (State, LocalTestState) -executionTests opts = describe "execution" $ do +executionTests opts = describe "execution" do -- fetches the relationship data - it "related-data" $ \(state, _) -> do + it "related-data" \(state, _) -> do let query = [graphql| query { @@ -243,7 +467,7 @@ executionTests opts = describe "execution" $ do expectedResponse -- when any of the join columns are null, the relationship should be null - it "related-data-null" $ \(state, _) -> do + it "related-data-null" \(state, _) -> do let query = [graphql| query { @@ -268,7 +492,7 @@ executionTests opts = describe "execution" $ do expectedResponse -- when the lhs response has both null and non-null values for join columns - it "related-data-non-null-and-null" $ \(state, _) -> do + it "related-data-non-null-and-null" \(state, _) -> do let query = [graphql| query { @@ -279,7 +503,7 @@ executionTests opts = describe "execution" $ do {title: {_eq: "track_no_album"}} ] }, - order_by: {id: asc} + order_by: [{id: asc}] ) { title album { @@ -309,7 +533,7 @@ schemaTests opts = -- 1. a field 'album' is added to the track table -- 1. track's where clause does not have 'album' field -- 2. track's order_by clause does nat have 'album' field - it "graphql-schema" $ \(state, _) -> do + it "graphql-schema" \(state, _) -> do let query = [graphql| query { diff --git a/server/tests-py/test_schema_stitching.py b/server/tests-py/test_schema_stitching.py index 01696b62d25..f2d2b473ee9 100644 --- a/server/tests-py/test_schema_stitching.py +++ b/server/tests-py/test_schema_stitching.py @@ -197,7 +197,7 @@ class TestRemoteSchemaBasic: """add 2 remote schemas with same node or types""" q = mk_add_remote_q('simple 2', 'http://localhost:5000/hello-graphql') st_code, resp = hge_ctx.v1q(q) - assert st_code == 400 + assert st_code == 400, resp assert resp['code'] == 'unexpected' @pytest.mark.allow_server_upgrade_test @@ -346,7 +346,7 @@ class TestAddRemoteSchemaTbls: """add remote schema which conflicts with hasura tables""" q = mk_add_remote_q('simple2', 'http://localhost:5000/hello-graphql') st_code, resp = hge_ctx.v1q(q) - assert st_code == 400 + assert st_code == 400, resp assert resp['code'] == 'invalid-configuration' @pytest.mark.allow_server_upgrade_test