From 6e1761f8f9f2878c9ee12d25a394ac50af3a85c5 Mon Sep 17 00:00:00 2001 From: Antoine Leblanc Date: Wed, 9 Mar 2022 03:17:28 +0000 Subject: [PATCH] Enable remote joins from remote schemas in the execution engine. ### Description This PR adds the ability to perform remote joins from remote schemas in the engine. To do so, we alter the definition of an `ExecutionStep` targeting a remote schema: the `ExecStepRemote` constructor now expects a `Maybe RemoteJoins`. This new argument is used when processing the execution step, in the transport layer (either `Transport.HTTP` or `Transport.WebSocket`). For this `Maybe RemoteJoins` to be extracted from a parsed query, this PR also extends the `Execute.RemoteJoin.Collect` module, to implement "collection" from a selection set. Not only do those new functions extract the remote joins, but they also apply all necessary transformations to the selection sets (such as inserting the necessary "phantom" fields used as join keys). Finally in `Execute.RemoteJoin.Join`, we make two changes. First, we now always look for nested remote joins, regardless of whether the join we just performed went to a source or a remote schema; and second we adapt our join tree logic according to the special cases that were added to deal with remote server edge cases. Additionally, this PR refactors / cleans / documents `Execute.RemoteJoin.RemoteServer`. This is not required as part of this change and could be moved to a separate PR if needed (a similar cleanup of `Join` is done independently in #3894). It also introduces a draft of a new documentation page for this project, that will be refined in the release PR that ships the feature (either #3069 or a copy of it). While this PR extends the engine, it doesn't plug such relationships in the schema, meaning that, as of this PR, the new code paths in `Join` are technically unreachable. Adding the corresponding schema code and, ultimately, enabling the metadata API will be done in subsequent PRs. ### Keeping track of concrete type names The main change this PR makes to the existing `Join` code is to handle a new reserved field we sometimes use when targeting remote servers: the `__hasura_internal_typename` field. In short, a GraphQL selection set can sometimes "branch" based on the concrete "runtime type" of the object on which the selection happens: ```graphql query { author(id: 53478) { ... on Writer { name articles { title } } ... on Artist { name articles { title } } } } ``` If both of those `articles` are remote joins, we need to be able, when we get the answer, to differentiate between the two different cases. We do this by asking for `__typename`, to be able to decide if we're in the `Writer` or the `Artist` branch of the query. To avoid further processing / customization of results, we only insert this `__hasura_internal_typename: __typename` field in the query in the case of unions of interfaces AND if we have the guarantee that we will processing the request as part of the remote joins "folding": that is, if there's any remote join in this branch in the tree. Otherwise, we don't insert the field, and we leave that part of the response untouched. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3810 GitOrigin-RevId: 89aaf16274d68e26ad3730b80c2d2fdc2896b96c --- server/documentation/README.md | 1 + .../documentation/remote_joins_execution.md | 162 +++++++ .../src-lib/Data/HashMap/Strict/NonEmpty.hs | 17 + .../src-lib/Hasura/GraphQL/Execute/Backend.hs | 1 + .../Hasura/GraphQL/Execute/Mutation.hs | 4 +- .../src-lib/Hasura/GraphQL/Execute/Query.hs | 3 +- .../src-lib/Hasura/GraphQL/Execute/Remote.hs | 32 +- .../GraphQL/Execute/RemoteJoin/Collect.hs | 176 ++++++- .../Hasura/GraphQL/Execute/RemoteJoin/Join.hs | 80 ++-- .../Execute/RemoteJoin/RemoteSchema.hs | 432 +++++++++--------- .../GraphQL/Execute/RemoteJoin/Types.hs | 188 +++++--- server/src-lib/Hasura/GraphQL/Schema.hs | 12 +- .../src-lib/Hasura/GraphQL/Schema/Remote.hs | 58 +-- .../GraphQL/Schema/RemoteRelationship.hs | 2 +- .../src-lib/Hasura/GraphQL/Transport/HTTP.hs | 27 +- .../Hasura/GraphQL/Transport/WebSocket.hs | 28 +- server/src-lib/Hasura/RQL/IR/RemoteSchema.hs | 4 +- server/src-lib/Hasura/RQL/IR/Root.hs | 6 +- .../src-lib/Hasura/RQL/Types/SchemaCache.hs | 8 +- .../Hasura/GraphQL/Schema/RemoteTest.hs | 33 +- 20 files changed, 861 insertions(+), 413 deletions(-) create mode 100644 server/documentation/remote_joins_execution.md diff --git a/server/documentation/README.md b/server/documentation/README.md index 56486c25931..6736d9de961 100644 --- a/server/documentation/README.md +++ b/server/documentation/README.md @@ -23,6 +23,7 @@ code; we automatically update it on every push to a branch of interest: * how to understand our [GraphQL schema](schema.md) * how to perform [database migrations](migration-guidelines.md) +* how the [execution of remote joins](remote_joins_execution.md) works TODO: we can either list individual topics here, or point to architecture/ and have a README file there. diff --git a/server/documentation/remote_joins_execution.md b/server/documentation/remote_joins_execution.md new file mode 100644 index 00000000000..5f11e930de2 --- /dev/null +++ b/server/documentation/remote_joins_execution.md @@ -0,0 +1,162 @@ +## Table of contents + + + + + +- [The join tree](#the-join-tree) +- [Collect](#collect) +- [Join](#join) +- [Ambiguous schemas](#ambiguous-schemas) + + + +## Executing remote joins + +When a request has been parsed, and is ready to be executed, we start by +building a `JoinTree`: a structure close to a [prefix +tree](https://en.wikipedia.org/wiki/Trie), containing all the paths in the +response that will require remote joins. We call this phase the +[collection](#collection) phase: it constructs the build tree, and transforms +the request as needed. + +After executing the core step of the request, if there is indeed a join tree, +then we start the [join](#join) phase: we fold that tree, expending the response +with the result of each subsequent request. + +### The join tree + +As mentioned, the join tree is almost like a prefix tree; the key difference is +that we don't store values at arbitrary points of the tree, only at the +leaves. Furthermore, while most prefix trees are indexed by character, in our +case we index joins by the *path through the response*. + +For instance, imagine that we send the following request: + +```graphql +query { + authors { + name + articles { # remote join + title + } + } +} +``` + +the join tree we would emit would have the following shape: + +```yaml +(Nothing, authors): + (Nothing, articles): +``` + +Recursively, all the way down, each join information might contain its own join +tree if there are any nested remote relationship. + +Each key in this join tree is a pair: it contains the name of the field, but +also contains an optional type information: this is used to deal with [ambiguous +schemas](#ambiguous-schemas). + +### Collect + +Implemented in +[Hasura.GraphQL.Execute.RemoteJoin.Collect](https://github.com/hasura/graphql-engine/blob/master/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Collect.hs), +this phase identifies the remote joins in a request, and transforms the request +accordingly. If a selection set contains a field that is a remote join, we alter +the selection set: + - the field that maps to a remote join is replaced by a placeholder value, so + that we can keep track of the order in the selection set (since that order + must not be altered) + - we add "phantom fields": fields that were not requested by the user, but + that we need to include, as they are the keys on which the join is performed + +In the case where the request goes to a remote schema, we might need additional +transformations (see the section on [ambiguous schemas](#ambiguous-schemas)). + +From a practical perspective, the collection is a glorified `traverse`, +operating in the `Collector` monad, which itself is a `Writer` monad: whenever +we encounter a remote join, we `tell` it to the collector, and continue our +traversal. Every time we traverse a field, we use `censor` to wrap the resulting +joins in a sub-tree. Remote joins are aggregated using the `Semigroup` instance +of `JoinTree`. + +### Join + +Implemented in +[Hasura.GraphQL.Execute.RemoteJoin.Join](https://github.com/hasura/graphql-engine/blob/master/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Join.hs), +we post-process the root request by "folding" the tree of joins: we traverse the +join tree alongside the response: for each field in the response that maps to a +leaf of the join tree, we recursively do the same thing: issue a query, traverse +its own join tree... and on the way back, we replace the value of field by the +result of the join. + +Depending on whether the target is a remote schema or a local source, we call +either `makeRemoteSchemaJoinCall` or `makeSourceJoinCall`, defined in +[Hasura.GraphQL.Execute.RemoteJoin.RemoteServer](https://github.com/hasura/graphql-engine/blob/master/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/RemoteServer.hs) +and +[Hasura.GraphQL.Execute.RemoteJoin.Source](https://github.com/hasura/graphql-engine/blob/master/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Source.hs) +respectively. + +### Ambiguous schemas + +This process is made more complicated by the fact that remote schemas, via +unions and interfaces, can be ambiguous. Consider the following request: + +```graphql +query { + node(id: $some_id) { + ... on Article { + # foo is a field, returns data of type `t` + foo { + # r1 is a REMOTE relationship, returns data of type `u` + bar: r1 { + } + } + } + ... on Author { + id + # foo is a field, returns data of type `t` + foo { + # r2 is a REMOTE relationship, returns data of type `u` + bar: r2 { + } + } + } + } +} +``` + +There are several complications with this request: + - there are two remote joins that would need to be at the same point in the + join tree, `node.foo.bar`; + - we need to identify which of the two relationships it is when processing the + joins; but we can't do so using information about `foo`, since its + `__typename` will be `t` in both cases. + +To fix this, we have altered the join tree: instead of using the field name as +key at each level, we use instead a combination of optional type name and field +name. We identify as "ambiguous" all selection sets of a union or an interface +that either directly contain remote joins, or whose subselections contain remote +joins. Whenever we encounter such a selection set, we use its type name in the +corresponding keys in the join tree, and we add one more phantom field to the +selection set: `__hasura_internal_typename`, which extracts the `__typename`. + +When processing the joins, we look for the presence of this field: if it is +there, we remove it from the response, and we do the join tree lookup using its +value, instead of using `Nothing`. + +In practice, the join tree for the aforementioned query would therefore be: +```yaml +(Nothing, node): + (Article, foo): + (Nothing, bar): + (Author, foo): + (Nothing, bar): +``` diff --git a/server/src-lib/Data/HashMap/Strict/NonEmpty.hs b/server/src-lib/Data/HashMap/Strict/NonEmpty.hs index 69fcf3bbe95..710508564a4 100644 --- a/server/src-lib/Data/HashMap/Strict/NonEmpty.hs +++ b/server/src-lib/Data/HashMap/Strict/NonEmpty.hs @@ -12,6 +12,10 @@ module Data.HashMap.Strict.NonEmpty -- * Basic interface lookup, (!?), + keys, + + -- * Compose + unionWith, -- * Transformations mapKeys, @@ -72,6 +76,19 @@ lookup k (NEHashMap m) = M.lookup k m (!?) :: (Eq k, Hashable k) => NEHashMap k v -> k -> Maybe v (!?) = flip lookup +-- | Return a list of this map's keys. +keys :: NEHashMap k v -> [k] +keys = M.keys . unNEHashMap + +------------------------------------------------------------------------------- + +-- | The union of two maps. +-- +-- If a key occurs in both maps, the provided function (first argument) will be +-- used to compute the result. +unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> NEHashMap k v -> NEHashMap k v -> NEHashMap k v +unionWith fun (NEHashMap m1) (NEHashMap m2) = NEHashMap $ M.unionWith fun m1 m2 + ------------------------------------------------------------------------------- -- | @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@. diff --git a/server/src-lib/Hasura/GraphQL/Execute/Backend.hs b/server/src-lib/Hasura/GraphQL/Execute/Backend.hs index dbb8e2472de..c8f0366a81a 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Backend.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Backend.hs @@ -240,6 +240,7 @@ data ExecutionStep where !RemoteSchemaInfo -> !ResultCustomizer -> !GH.GQLReqOutgoing -> + Maybe RemoteJoins -> ExecutionStep -- | Output a plain JSON object ExecStepRaw :: diff --git a/server/src-lib/Hasura/GraphQL/Execute/Mutation.hs b/server/src-lib/Hasura/GraphQL/Execute/Mutation.hs index e12970b26bd..91f3dcf9a45 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Mutation.hs @@ -128,7 +128,9 @@ convertMutationSelectionSet pure $ ExecStepDB [] (AB.mkAnyBackend dbStepInfo) remoteJoins RFRemote remoteField -> do RemoteSchemaRootField remoteSchemaInfo resultCustomizer resolvedRemoteField <- runVariableCache $ resolveRemoteField userInfo remoteField - pure $ buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeMutation [G.SelectionField $ convertGraphQLField resolvedRemoteField] (GH._grOperationName gqlUnparsed) + let (noRelsRemoteField, remoteJoins) = RJ.getRemoteJoinsGraphQLField resolvedRemoteField + pure $ + buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeMutation noRelsRemoteField remoteJoins (GH._grOperationName gqlUnparsed) RFAction action -> do let (noRelsDBAST, remoteJoins) = RJ.getRemoteJoinsActionMutation action (actionName, _fch) <- pure $ case noRelsDBAST of diff --git a/server/src-lib/Hasura/GraphQL/Execute/Query.hs b/server/src-lib/Hasura/GraphQL/Execute/Query.hs index d3e43d57e5d..0d59958c09b 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Query.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Query.hs @@ -114,7 +114,8 @@ convertQuerySelSet pure $ ExecStepDB [] (AB.mkAnyBackend dbStepInfo) remoteJoins RFRemote rf -> do RemoteSchemaRootField remoteSchemaInfo resultCustomizer remoteField <- runVariableCache $ for rf $ resolveRemoteVariable userInfo - pure $ buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeQuery [G.SelectionField $ convertGraphQLField remoteField] (GH._grOperationName gqlUnparsed) + let (noRelsRemoteField, remoteJoins) = RJ.getRemoteJoinsGraphQLField remoteField + pure $ buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeQuery noRelsRemoteField remoteJoins (GH._grOperationName gqlUnparsed) RFAction action -> do let (noRelsDBAST, remoteJoins) = RJ.getRemoteJoinsActionQuery action (actionExecution, actionName, fch) <- pure $ case noRelsDBAST of diff --git a/server/src-lib/Hasura/GraphQL/Execute/Remote.hs b/server/src-lib/Hasura/GraphQL/Execute/Remote.hs index 814f0a195dc..434a1e21b8f 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Remote.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Remote.hs @@ -2,8 +2,7 @@ module Hasura.GraphQL.Execute.Remote ( buildExecStepRemote, - collectVariablesFromSelectionSet, - collectVariables, + getVariableDefinitionAndValue, resolveRemoteVariable, resolveRemoteField, runVariableCache, @@ -17,17 +16,18 @@ import Data.Text qualified as T import Data.Text.Extended import Hasura.Base.Error import Hasura.GraphQL.Execute.Backend +import Hasura.GraphQL.Execute.RemoteJoin.Types (RemoteJoins) import Hasura.GraphQL.Parser import Hasura.GraphQL.Transport.HTTP.Protocol import Hasura.GraphQL.Transport.HTTP.Protocol qualified as GH import Hasura.Prelude -import Hasura.RQL.IR.RemoteSchema +import Hasura.RQL.IR.RemoteSchema qualified as IR import Hasura.RQL.Types import Hasura.Session import Language.GraphQL.Draft.Syntax qualified as G -mkVariableDefinitionAndValue :: Variable -> (G.VariableDefinition, (G.Name, J.Value)) -mkVariableDefinitionAndValue var@(Variable varInfo gType varValue) = +getVariableDefinitionAndValue :: Variable -> (G.VariableDefinition, (G.Name, J.Value)) +getVariableDefinitionAndValue var@(Variable varInfo gType varValue) = (varDefn, (varName, varJSONValue)) where varName = getName var @@ -60,29 +60,25 @@ collectVariables :: collectVariables = Set.unions . fmap (foldMap Set.singleton) -collectVariablesFromSelectionSet :: - G.SelectionSet G.NoFragments Variable -> - [(G.VariableDefinition, (G.Name, J.Value))] -collectVariablesFromSelectionSet = - map mkVariableDefinitionAndValue . Set.toList . collectVariables - buildExecStepRemote :: RemoteSchemaInfo -> ResultCustomizer -> G.OperationType -> - G.SelectionSet G.NoFragments Variable -> + IR.GraphQLField Void Variable -> + Maybe RemoteJoins -> Maybe OperationName -> ExecutionStep -buildExecStepRemote remoteSchemaInfo resultCustomizer tp selSet operationName = - let unresolvedSelSet = unresolveVariables selSet - allVars = map mkVariableDefinitionAndValue $ Set.toList $ collectVariables selSet +buildExecStepRemote remoteSchemaInfo resultCustomizer tp rootField remoteJoins operationName = + let selSet = [G.SelectionField $ IR.convertGraphQLField rootField] + unresolvedSelSet = unresolveVariables selSet + allVars = map getVariableDefinitionAndValue $ Set.toList $ collectVariables selSet varValues = Map.fromList $ map snd allVars varValsM = bool (Just varValues) Nothing $ Map.null varValues varDefs = map fst allVars _grQuery = G.TypedOperationDefinition tp (_unOperationName <$> operationName) varDefs [] unresolvedSelSet _grVariables = varValsM _grOperationName = operationName - in ExecStepRemote remoteSchemaInfo resultCustomizer GH.GQLReq {..} + in ExecStepRemote remoteSchemaInfo resultCustomizer GH.GQLReq {..} remoteJoins -- | Association between keys uniquely identifying some remote JSON variable and -- an 'Int' identifier that will be used to construct a valid variable name to @@ -223,8 +219,8 @@ resolveRemoteVariable userInfo = \case resolveRemoteField :: (MonadError QErr m) => UserInfo -> - RemoteSchemaRootField Void RemoteSchemaVariable -> - StateT RemoteJSONVariableMap m (RemoteSchemaRootField Void Variable) + IR.RemoteSchemaRootField r RemoteSchemaVariable -> + StateT RemoteJSONVariableMap m (IR.RemoteSchemaRootField r Variable) resolveRemoteField userInfo = traverse (resolveRemoteVariable userInfo) -- | TODO: Documentation. diff --git a/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Collect.hs b/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Collect.hs index 3a835c48064..d99bb2cde4b 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Collect.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Collect.hs @@ -4,12 +4,14 @@ module Hasura.GraphQL.Execute.RemoteJoin.Collect getRemoteJoinsMutationDB, getRemoteJoinsActionQuery, getRemoteJoinsActionMutation, + getRemoteJoinsGraphQLField, ) where -import Control.Lens (Traversal', preview, _2) +import Control.Lens (Traversal', preview, (^?), _2) import Control.Monad.Writer import Data.HashMap.Strict qualified as Map +import Data.HashMap.Strict.InsOrd qualified as OMap import Data.HashMap.Strict.NonEmpty (NEHashMap) import Data.HashMap.Strict.NonEmpty qualified as NEMap import Data.Text qualified as T @@ -63,15 +65,15 @@ newtype Collector a = Collector {runCollector :: (a, Maybe RemoteJoins)} -- | Collect some remote joins appearing at the given field names in the current -- context. -collect :: NEHashMap FieldName RemoteJoin -> Collector () +collect :: NEHashMap QualifiedFieldName RemoteJoin -> Collector () collect = tell . Just . JoinTree . fmap Leaf -- | Keep track of the given field name in the current path from the root of the -- selection set. -withField :: FieldName -> Collector a -> Collector a -withField name = censor (fmap wrap) +withField :: Maybe Text -> Text -> Collector a -> Collector a +withField typeName fieldName = censor (fmap wrap) where - wrap rjs = JoinTree $ NEMap.singleton name (Tree rjs) + wrap rjs = JoinTree $ NEMap.singleton (QualifiedFieldName typeName fieldName) (Tree rjs) -- | Collects remote joins from the AST and also adds the necessary join fields getRemoteJoins :: @@ -123,7 +125,7 @@ getRemoteJoinsMutationOutput = MOutSinglerowObject <$> transformAnnFields annFields where transfromMutationFields fields = - for fields $ \(fieldName, field') -> withField fieldName do + for fields $ \(fieldName, field') -> withField Nothing (getFieldNameTxt fieldName) do (fieldName,) <$> case field' of MCount -> pure MCount MExp t -> pure $ MExp t @@ -186,7 +188,7 @@ getRemoteJoinsActionQuery = \case in (async {_aaaqFields = fields'}, remoteJoins) transformAsyncFields fields = - for fields $ \(fieldName, field) -> withField fieldName do + for fields $ \(fieldName, field) -> withField Nothing (getFieldNameTxt fieldName) do (fieldName,) <$> case field of AsyncTypename t -> pure $ AsyncTypename t AsyncOutput outputFields -> @@ -217,7 +219,7 @@ transformAggregateSelect :: Collector (AnnAggregateSelectG b Void (UnpreparedValue b)) transformAggregateSelect select@AnnSelectG {_asnFields = aggFields} = do transformedFields <- for aggFields \(fieldName, aggField) -> - withField fieldName $ case aggField of + withField Nothing (getFieldNameTxt fieldName) $ case aggField of TAFAgg agg -> pure (fieldName, TAFAgg agg) TAFExp t -> pure (fieldName, TAFExp t) TAFNodes nodesAgg annFields -> do @@ -232,7 +234,7 @@ transformConnectionSelect :: Collector (ConnectionSelect b Void (UnpreparedValue b)) transformConnectionSelect connSelect@ConnectionSelect {..} = do transformedFields <- for (_asnFields _csSelect) \(fieldName, connField) -> - withField fieldName $ case connField of + withField Nothing (getFieldNameTxt fieldName) $ case connField of ConnectionTypename t -> pure (fieldName, ConnectionTypename t) ConnectionPageInfo p -> pure (fieldName, ConnectionPageInfo p) ConnectionEdges edges -> do @@ -246,7 +248,7 @@ transformConnectionSelect connSelect@ConnectionSelect {..} = do [(FieldName, EdgeField b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))] -> Collector [(FieldName, EdgeField b Void (UnpreparedValue b))] transformEdges edgeFields = for edgeFields \(fieldName, edgeField) -> - withField fieldName $ case edgeField of + withField Nothing (getFieldNameTxt fieldName) $ case edgeField of EdgeTypename t -> pure (fieldName, EdgeTypename t) EdgeCursor -> pure (fieldName, EdgeCursor) EdgeNode annFields -> do @@ -274,16 +276,17 @@ createRemoteJoin joinColumnAliases remoteRelationship = case remoteRelationship of RemoteSchemaField RemoteSchemaSelect {..} -> let inputArgsToMap = Map.fromList . map (_rfaArgument &&& _rfaValue) + (transformedSchemaRelationship, schemaRelationshipJoins) = + getRemoteJoinsGraphQLSelectionSet _rselSelection remoteJoin = - RemoteJoinRemoteSchema $ - RemoteSchemaJoin - (inputArgsToMap _rselArgs) - _rselResultCustomizer - (convertSelectionSet _rselSelection) - joinColumnAliases - _rselFieldCall - _rselRemoteSchema - in remoteJoin + RemoteSchemaJoin + (inputArgsToMap _rselArgs) + _rselResultCustomizer + transformedSchemaRelationship + joinColumnAliases + _rselFieldCall + _rselRemoteSchema + in RemoteJoinRemoteSchema remoteJoin schemaRelationshipJoins RemoteSourceField anySourceSelect -> AB.dispatchAnyBackend @Backend anySourceSelect \RemoteSourceSelect {..} -> let (transformedSourceRelationship, sourceRelationshipJoins) = @@ -317,7 +320,7 @@ transformAnnFields :: transformAnnFields fields = do -- Produces a list of transformed fields that may or may not have an -- associated remote join. - annotatedFields <- for fields \(fieldName, field') -> withField fieldName do + annotatedFields <- for fields \(fieldName, field') -> withField Nothing (getFieldNameTxt fieldName) do (fieldName,) <$> case field' of -- AnnFields which do not need to be transformed. AFNodeId x qt pkeys -> pure (AFNodeId x qt pkeys, Nothing) @@ -358,7 +361,7 @@ transformAnnFields fields = do let transformedFields = (fmap . fmap) fst annotatedFields remoteJoins = annotatedFields & mapMaybe \(fieldName, (_, mRemoteJoin)) -> - (fieldName,) <$> mRemoteJoin + (QualifiedFieldName Nothing (getFieldNameTxt fieldName),) <$> mRemoteJoin case NEMap.fromList remoteJoins of Nothing -> pure transformedFields @@ -459,7 +462,7 @@ transformActionFields :: transformActionFields fields = do -- Produces a list of transformed fields that may or may not have an -- associated remote join. - annotatedFields <- for fields \(fieldName, field') -> withField fieldName do + annotatedFields <- for fields \(fieldName, field') -> withField Nothing (getFieldNameTxt fieldName) do (fieldName,) <$> case field' of -- ActionFields which do not need to be transformed. ACFScalar c -> pure (ACFScalar c, Nothing) @@ -480,7 +483,7 @@ transformActionFields fields = do let transformedFields = (fmap . fmap) fst annotatedFields remoteJoins = annotatedFields & mapMaybe \(fieldName, (_, mRemoteJoin)) -> - (fieldName,) <$> mRemoteJoin + (QualifiedFieldName Nothing (getFieldNameTxt fieldName),) <$> mRemoteJoin case NEMap.fromList remoteJoins of Nothing -> pure transformedFields @@ -571,3 +574,130 @@ getRemoteJoinsSourceRelation = runCollector . transformSourceRelation SourceRelationshipArray <$> transformSelect simpleSelect SourceRelationshipArrayAggregate aggregateSelect -> SourceRelationshipArrayAggregate <$> transformAggregateSelect aggregateSelect + +transformGraphQLSelectionSet :: + SelectionSet (RemoteRelationshipField UnpreparedValue) var -> + Collector (SelectionSet Void var) +transformGraphQLSelectionSet = \case + SelectionSetNone -> pure SelectionSetNone + SelectionSetObject s -> SelectionSetObject <$> transformObjectSelectionSet Nothing s + SelectionSetUnion s -> SelectionSetUnion <$> transformAbstractTypeSelectionSet s + SelectionSetInterface s -> SelectionSetInterface <$> transformAbstractTypeSelectionSet s + where + transformAbstractTypeSelectionSet DeduplicatedSelectionSet {..} = do + transformedMemberSelectionSets <- + _atssMemberSelectionSets & Map.traverseWithKey \typeName objectSelectionSet -> + transformObjectSelectionSet (Just typeName) objectSelectionSet + pure + DeduplicatedSelectionSet + { _atssMemberSelectionSets = transformedMemberSelectionSets, + .. + } + +transformObjectSelectionSet :: + -- | The type name on which this selection set is defined; this is only + -- expected to be provided for unions and interfaces, not for regular objects, + -- as this is used to determine whether a selection set is potentially + -- "ambiguous" or not, and regular objects cannot. This will be used as the + -- type name in the 'QualifiedFieldName' key of the join tree if this + -- selection set or its subselections contain remote joins. + Maybe G.Name -> + ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var -> + Collector (ObjectSelectionSet Void var) +transformObjectSelectionSet typename selectionSet = do + -- we need to keep track of whether any subfield contained a remote join + (annotatedFields, subfieldsContainRemoteJoins) <- + listens isJust $ + flip OMap.traverseWithKey selectionSet \alias field -> + withField (G.unName <$> typename) (G.unName alias) do + case field of + FieldGraphQL f -> (,Nothing) <$> transformGraphQLField f + FieldRemote SchemaRemoteRelationshipSelect {..} -> do + pure + ( mkPlaceholderField alias, + Just $ createRemoteJoin joinColumnAliases _srrsRelationship + ) + let internalTypeAlias = $$(G.litName "__hasura_internal_typename") + remoteJoins = OMap.mapMaybe snd annotatedFields + additionalFields = + if + | isJust typename && (not (null remoteJoins) || subfieldsContainRemoteJoins) -> + -- We are in a situation in which the type name matters, and we know + -- that there is at least one remote join in this part of tree, meaning + -- we might need to branch on the typename when traversing the join + -- tree: we insert a custom field that will return the type name. + OMap.singleton internalTypeAlias $ + mkGraphQLField + (Just internalTypeAlias) + $$(G.litName "__typename") + mempty + mempty + SelectionSetNone + | otherwise -> + -- Either the typename doesn't matter, or this tree doesn't have remote + -- joins; this selection set isn't "ambiguous". + mempty + transformedFields = fmap fst annotatedFields <> additionalFields + case NEMap.fromList $ OMap.toList remoteJoins of + Nothing -> pure $ fmap FieldGraphQL transformedFields + Just neRemoteJoins -> do + collect $ NEMap.mapKeys (\fieldGName -> QualifiedFieldName (G.unName <$> typename) (G.unName fieldGName)) neRemoteJoins + pure $ + fmap + FieldGraphQL + (transformedFields <> OMap.fromList [(_fAlias fld, fld) | fld <- toList phantomFields]) + where + nameToField = FieldName . G.unName + allAliases = map (nameToField . fst) $ OMap.toList selectionSet + + mkPlaceholderField alias = + mkGraphQLField (Just alias) $$(G.litName "__typename") mempty mempty SelectionSetNone + + -- A map of graphql scalar fields (without any arguments) to their aliases + -- in the selection set. We do not yet support lhs join fields which take + -- arguments. To be consistent with that, we ignore fields with arguments + noArgsGraphQLFields = + Map.fromList $ + flip mapMaybe (OMap.toList selectionSet) \(alias, field) -> case field of + FieldGraphQL f -> + if null (_fArguments f) + then Just (_fName f, FieldName $ G.unName alias) + else Nothing + FieldRemote _ -> Nothing + + annotateLHSJoinField fieldName lhsJoinField = + let columnAlias = + getJoinColumnAlias fieldName lhsJoinField noArgsGraphQLFields allAliases + in ( mkGraphQLField + (Just $ G.unsafeMkName $ getFieldNameTxt $ getAliasFieldName columnAlias) + lhsJoinField + mempty + mempty + SelectionSetNone, + columnAlias + ) + + (joinColumnAliases, phantomFields) = + let lhsJoinFields = + Map.unions $ map _srrsLHSJoinFields $ mapMaybe (^? _FieldRemote) $ toList selectionSet + annotatedJoinColumns = Map.mapWithKey annotateLHSJoinField lhsJoinFields + in (fmap snd annotatedJoinColumns, fmap fst annotatedJoinColumns) + +transformGraphQLField :: + GraphQLField (RemoteRelationshipField UnpreparedValue) var -> + Collector (GraphQLField Void var) +transformGraphQLField GraphQLField {..} = do + transformedSelectionSet <- transformGraphQLSelectionSet _fSelectionSet + pure $ GraphQLField {_fSelectionSet = transformedSelectionSet, ..} + +getRemoteJoinsGraphQLSelectionSet :: + SelectionSet (RemoteRelationshipField UnpreparedValue) var -> + (SelectionSet Void var, Maybe RemoteJoins) +getRemoteJoinsGraphQLSelectionSet = + runCollector . transformGraphQLSelectionSet + +getRemoteJoinsGraphQLField :: + GraphQLField (RemoteRelationshipField UnpreparedValue) var -> + (GraphQLField Void var, Maybe RemoteJoins) +getRemoteJoinsGraphQLField = + runCollector . transformGraphQLField diff --git a/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Join.hs b/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Join.hs index 7c8cfb60aa5..d9298c95b77 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Join.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Join.hs @@ -3,6 +3,7 @@ module Hasura.GraphQL.Execute.RemoteJoin.Join ) where +import Control.Lens (view, _3) import Data.Aeson qualified as J import Data.Aeson.Ordered qualified as JO import Data.Environment qualified as Env @@ -24,6 +25,7 @@ import Hasura.GraphQL.Execute.RemoteJoin.RemoteSchema qualified as RS import Hasura.GraphQL.Execute.RemoteJoin.Types import Hasura.GraphQL.Logging (MonadQueryLog) import Hasura.GraphQL.Namespace +import Hasura.GraphQL.RemoteServer (execRemoteGQ) import Hasura.GraphQL.Transport.Backend qualified as TB import Hasura.GraphQL.Transport.HTTP.Protocol (GQLReqUnparsed) import Hasura.GraphQL.Transport.Instances () @@ -97,21 +99,17 @@ processRemoteJoins_ :: RemoteJoins -> GQLReqUnparsed -> m (f JO.Value) -processRemoteJoins_ requestId logger env manager reqHdrs userInfo lhs joinTree gqlreq = do +processRemoteJoins_ requestId logger env manager requestHeaders userInfo lhs joinTree gqlreq = do (compositeValue, joins) <- collectJoinArguments (assignJoinIds joinTree) lhs joinIndices <- fmap IntMap.catMaybes $ for joins $ \JoinArguments {..} -> do let joinArguments = IntMap.fromList $ map swap $ Map.toList _jalArguments - case _jalJoin of - RemoteJoinRemoteSchema remoteSchemaJoin -> do - -- construct a remote call for - remoteCall <- RS.buildRemoteSchemaCall userInfo remoteSchemaJoin joinArguments - -- A remote call could be Nothing if there are no join arguments - for remoteCall $ \rsc@(RS.RemoteSchemaCall _ _ _ responsePaths) -> do - remoteResponse <- - RS.getRemoteSchemaResponse env manager reqHdrs userInfo rsc - -- extract the join values from the remote's response - RS.buildJoinIndex remoteResponse responsePaths + previousStep <- case _jalJoin of + RemoteJoinRemoteSchema remoteSchemaJoin childJoinTree -> do + let remoteSchemaInfo = rsDef $ _rsjRemoteSchema remoteSchemaJoin + networkCall = fmap (view _3) . execRemoteGQ env manager userInfo requestHeaders remoteSchemaInfo + maybeJoinIndex <- RS.makeRemoteSchemaJoinCall networkCall userInfo remoteSchemaJoin joinArguments + pure $ fmap (childJoinTree,) maybeJoinIndex RemoteJoinSource sourceJoin childJoinTree -> AB.dispatchAnyBackend @TB.BackendTransport sourceJoin \(RemoteSourceJoin {..} :: RemoteSourceJoin b) -> do let rows = flip map (IntMap.toList joinArguments) $ \(argumentId, argument) -> Map.insert "__argument_id__" (J.toJSON argumentId) $ @@ -150,26 +148,26 @@ processRemoteJoins_ requestId logger env manager reqHdrs userInfo lhs joinTree g _rsjSourceConfig (EB.dbsiAction stepInfo) (EB.dbsiPreparedQuery stepInfo) - - preRemoteJoinResults <- buildSourceDataJoinIndex sourceResponse - forRemoteJoins childJoinTree preRemoteJoinResults $ \childRemoteJoins -> do - results <- - processRemoteJoins_ - requestId - logger - env - manager - reqHdrs - userInfo - (IntMap.elems preRemoteJoinResults) - childRemoteJoins - gqlreq - pure $ IntMap.fromAscList $ zip (IntMap.keys preRemoteJoinResults) results + (childJoinTree,) <$> buildSourceDataJoinIndex sourceResponse + for previousStep $ \(childJoinTree, joinIndex) -> do + forRemoteJoins childJoinTree joinIndex $ \childRemoteJoins -> do + results <- + processRemoteJoins_ + requestId + logger + env + manager + requestHeaders + userInfo + (IntMap.elems joinIndex) + childRemoteJoins + gqlreq + pure $ IntMap.fromAscList $ zip (IntMap.keys joinIndex) results joinResults joinIndices compositeValue -- | Attempt to construct a 'JoinIndex' from some 'EncJSON' source response. -buildSourceDataJoinIndex :: (MonadError QErr m) => EncJSON -> m JoinIndex +buildSourceDataJoinIndex :: (MonadError QErr m) => EncJSON -> m (IntMap.IntMap JO.Value) buildSourceDataJoinIndex response = do json <- JO.eitherDecode (encJToLBS response) `onLeft` \err -> @@ -379,22 +377,36 @@ collectJoinArguments joinTree lhs = do m (InsOrdHashMap Text (CompositeValue ReplacementToken)) traverseObject joinTree_ object = do - let phantomFields = + let joinTreeNodes = unJoinTree joinTree_ + phantomFields = HS.fromList $ map getFieldNameTxt $ concatMap (getPhantomFields . snd) $ toList joinTree_ - joinTreeNodes = - Map.mapKeys getFieldNameTxt $ - NEMap.toHashMap $ - unJoinTree joinTree_ + -- If we need the typename to disambiguate branches in the join tree, it + -- will be present in the answer as a placeholder internal field. + -- + -- We currently have no way of checking whether we explicitly requested + -- that field, and it would be possible for a malicious user to attempt to + -- spoof that value by explicitly requesting a value they control. + -- However, there's no actual risk: we only use that value for lookups + -- inside the join tree, and if we didn't request this field, the keys in + -- the join tree map will explicitly require a typename NOT to be + -- provided. Meaning that any spoofing attempt will just, at worst, result + -- in remote joins not being performed. + -- + -- We always remove that key from the resulting object. + joinTypeName <- case JO.lookup "__hasura_internal_typename" object of + Nothing -> pure Nothing + Just (JO.String typename) -> pure $ Just typename + Just value -> throw500 $ "The reserved __hasura_internal_typename field contains an unexpected value: " <> tshow value -- during this traversal we assume that the remote join column has some -- placeholder value in the response. If this weren't present it would -- involve a lot more book-keeping to preserve the order of the original -- selection set in the response compositeObject <- for (JO.toList object) $ \(fieldName, value_) -> - (fieldName,) <$> case Map.lookup fieldName joinTreeNodes of + (fieldName,) <$> case NEMap.lookup (QualifiedFieldName joinTypeName fieldName) joinTreeNodes of Just (Leaf (joinId, remoteJoin)) -> do joinArgument <- forM (getJoinColumnMapping remoteJoin) $ \alias -> do let aliasTxt = getFieldNameTxt $ getAliasFieldName alias @@ -410,7 +422,7 @@ collectJoinArguments joinTree lhs = do Just (Tree joinSubTree) -> Just <$> traverseValue joinSubTree value_ Nothing -> - if HS.member fieldName phantomFields + if HS.member fieldName phantomFields || fieldName == "__hasura_internal_typename" then pure Nothing else pure $ Just $ CVOrdValue value_ diff --git a/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/RemoteSchema.hs b/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/RemoteSchema.hs index da845ca0801..8699574ea5b 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/RemoteSchema.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/RemoteSchema.hs @@ -1,7 +1,22 @@ +-- | How to construct and execute a call to a remote schema for a remote join. +-- +-- There are three steps required to do this: +-- 1. construct the call: given the requested fields, the phantom fields, the +-- values extracted by the LHS, construct a GraphQL query +-- 2. execute that GraphQL query over the network +-- 3. build a index of the variables out of the response +-- +-- This can be done as one function, but we also export the individual steps for +-- debugging / test purposes. We congregate all intermediary state in the opaque +-- 'RemoteSchemaCall' type. module Hasura.GraphQL.Execute.RemoteJoin.RemoteSchema - ( buildRemoteSchemaCall, - RemoteSchemaCall (..), - getRemoteSchemaResponse, + ( -- * Executing a remote join + makeRemoteSchemaJoinCall, + + -- * Individual steps + RemoteSchemaCall, + buildRemoteSchemaCall, + executeRemoteSchemaCall, buildJoinIndex, ) where @@ -9,96 +24,103 @@ where import Control.Lens (view, _2, _3) import Data.Aeson qualified as A import Data.Aeson.Ordered qualified as AO -import Data.Environment qualified as Env +import Data.ByteString.Lazy qualified as BL import Data.HashMap.Strict qualified as Map import Data.IntMap.Strict qualified as IntMap import Data.List.NonEmpty qualified as NE import Data.Text qualified as T import Data.Text.Extended (commaSeparated, toTxt, (<<>)) import Data.Validation (Validation (..), toEither) +import GHC.Stack (HasCallStack) import Hasura.Base.Error import Hasura.GraphQL.Execute.Remote - ( collectVariablesFromSelectionSet, + ( getVariableDefinitionAndValue, resolveRemoteVariable, runVariableCache, ) import Hasura.GraphQL.Execute.RemoteJoin.Types import Hasura.GraphQL.Parser qualified as P -import Hasura.GraphQL.RemoteServer (execRemoteGQ) import Hasura.GraphQL.Transport.HTTP.Protocol (GQLReq (..), GQLReqOutgoing) import Hasura.Prelude +import Hasura.RQL.IR.RemoteSchema (convertSelectionSet) import Hasura.RQL.Types import Hasura.Session -import Hasura.Tracing qualified as Tracing import Language.GraphQL.Draft.Syntax qualified as G -import Network.HTTP.Client qualified as HTTP -import Network.HTTP.Types qualified as HTTP --- XXX(jkachmar): Think about reworking 'ResponsePath' to be 'Alias, Maybe [G.Name]' +------------------------------------------------------------------------------- +-- Executing a remote join + +-- | Construct and execute a call to a remote schema for a remote join. +makeRemoteSchemaJoinCall :: + (MonadError QErr m) => + -- | Function to send a request over the network. + (GQLReqOutgoing -> m BL.ByteString) -> + -- | User information. + UserInfo -> + -- | Information about that remote join. + RemoteSchemaJoin -> + -- | Mapping from 'JoinArgumentId' to its corresponding 'JoinArgument'. + IntMap.IntMap JoinArgument -> + -- | The resulting join index (see 'buildJoinIndex') if any. + m (Maybe (IntMap.IntMap AO.Value)) +makeRemoteSchemaJoinCall networkFunction userInfo remoteSchemaJoin joinArguments = do + -- step 1: construct the internal intermediary representation + maybeRemoteCall <- buildRemoteSchemaCall remoteSchemaJoin joinArguments userInfo + -- if there actually is a remote call: + for maybeRemoteCall \remoteCall -> do + -- step 2: execute it over the network + responseValue <- executeRemoteSchemaCall networkFunction remoteCall + -- step 3: build the join index + buildJoinIndex remoteCall responseValue + +------------------------------------------------------------------------------- +-- Internal representation + +-- | Intermediate type containing all of the information required to perform +-- a remote schema call, constructed from the static join information. +data RemoteSchemaCall = RemoteSchemaCall + { rscCustomizer :: ResultCustomizer, + rscGQLRequest :: GQLReqOutgoing, + rscResponsePaths :: IntMap.IntMap ResponsePath + } -- | Used to extract the value from a remote schema response. -- -- For example: if a remote relationship is defined to retrieve data from some -- deeply nested field, this is the path towards that deeply nested field. newtype ResponsePath = ResponsePath (NE.NonEmpty G.Name) - -- (Alias, Maybe [G.Name]) deriving stock (Eq, Show) --- | The name that we generate when performing a remote join, which shall always --- be the first field in a 'ResponsePath'. -type Alias = G.Name +------------------------------------------------------------------------------- +-- Step 1: building the remote call --- NOTE: Ideally this should be done at the remote relationship validation --- layer. --- --- When validating remote relationships, we should store the validated names so --- that we don't need to continually re-validate them downstream. -parseGraphQLName :: (MonadError QErr m) => Text -> m G.Name -parseGraphQLName txt = - G.mkName txt `onNothing` (throw400 RemoteSchemaError $ errMsg) - where - errMsg = txt <> " is not a valid GraphQL name" - --- | Intermediate type containing all of the information required to perform --- a remote schema call. --- --- See 'buildRemoteSchemaCall' for details. -data RemoteSchemaCall = RemoteSchemaCall - { _rscInfo :: !RemoteSchemaInfo, - _rscCustomizer :: !ResultCustomizer, - _rscGQLRequest :: !GQLReqOutgoing, - _rscResponsePaths :: !(IntMap.IntMap ResponsePath) - } - --- | Constructs an outgoing response from the remote relationships definition --- (i.e. 'RemoteSchemaJoin') and the arguments collected from the database's --- response. --- --- NOTE: We need to pass along some additional information with the raw outgoing --- GraphQL request, hence the 'RemoteSchemaCall' type. +-- | Constructs a 'RemoteSchemaCall' from some static information, such as the +-- definition of the join, and dynamic information such as the user's +-- information and the map of join arguments. buildRemoteSchemaCall :: (MonadError QErr m) => - UserInfo -> RemoteSchemaJoin -> IntMap.IntMap JoinArgument -> + UserInfo -> m (Maybe RemoteSchemaCall) -buildRemoteSchemaCall userInfo RemoteSchemaJoin {..} arguments = do +buildRemoteSchemaCall RemoteSchemaJoin {..} arguments userInfo = do -- for each join argument, we generate a unique field, with the alias -- "f" <> argumentId fields <- flip IntMap.traverseWithKey arguments $ \argumentId (JoinArgument argument) -> do graphqlArgs <- fmap Map.fromList $ - for (Map.toList argument) $ - \(FieldName columnName, value) -> - (,) <$> parseGraphQLName columnName <*> ordJSONValueToGValue value + for (Map.toList argument) \(FieldName columnName, value) -> do + graphQLName <- parseGraphQLName columnName + graphQLValue <- ordJSONValueToGValue value + pure (graphQLName, graphQLValue) -- Creating the alias should never fail. let aliasText = T.pack $ "f" <> show argumentId alias <- G.mkName aliasText `onNothing` throw500 ("'" <> aliasText <> "' is not a valid GraphQL name!") - let responsePath = alias NE.:| map fcName (toList $ NE.tail _rsjFieldCall) + let responsePath = alias NE.:| fmap fcName (NE.tail _rsjFieldCall) rootField = fcName $ NE.head _rsjFieldCall resultCustomizer = applyAliasMapping (singletonAliasMapping rootField alias) _rsjResultCustomizer - gqlField <- fieldCallsToField _rsjArgs graphqlArgs _rsjSelSet alias _rsjFieldCall + gqlField <- fieldCallsToField _rsjArgs graphqlArgs (convertSelectionSet _rsjSelSet) alias _rsjFieldCall pure (gqlField, responsePath, resultCustomizer) -- this constructs the actual GraphQL Request that can be sent to the remote @@ -108,136 +130,7 @@ buildRemoteSchemaCall userInfo RemoteSchemaJoin {..} arguments = do \(field, _, _) -> traverse (resolveRemoteVariable userInfo) field let customizer = foldMap (view _3) fields responsePath = fmap (ResponsePath . view _2) fields - pure $ RemoteSchemaCall _rsjRemoteSchema customizer gqlRequest responsePath - --- | Construct a 'JoinIndex' from the remote source's 'AO.Value' response. --- --- If the response does not have value at any of the provided 'ResponsePath's, --- throw a generic 'QErr'. --- --- NOTE(jkachmar): If we switch to an 'Applicative' validator, we can collect --- more than one missing 'ResponsePath's (rather than short-circuiting on the --- first missing value). -buildJoinIndex :: - (Monad m, MonadError QErr m) => - AO.Object -> - IntMap.IntMap ResponsePath -> - m JoinIndex -buildJoinIndex response responsePaths = - for responsePaths $ \path -> extractAtPath (AO.Object response) path - -getRemoteSchemaResponse :: - ( MonadError QErr m, - MonadIO m, - Tracing.MonadTrace m - ) => - Env.Environment -> - HTTP.Manager -> - [HTTP.Header] -> - UserInfo -> - RemoteSchemaCall -> - m AO.Object -getRemoteSchemaResponse env manager requestHeaders userInfo (RemoteSchemaCall rsi customizer req _) = do - (_, _, respBody) <- execRemoteGQ env manager userInfo requestHeaders (rsDef rsi) req - resp <- - AO.eitherDecode respBody - `onLeft` (\e -> throw500 $ "Remote server response is not valid JSON: " <> T.pack e) - respObj <- AO.asObject resp `onLeft` throw500 - let errors = AO.lookup "errors" respObj - if - | isNothing errors || errors == Just AO.Null -> - case AO.lookup "data" respObj of - Nothing -> throw500 "\"data\" field not found in remote response" - Just v -> - let v' = applyResultCustomizer customizer v - in AO.asObject v' `onLeft` throw500 - | otherwise -> - throwError - (err400 Unexpected "Errors from remote server") - { qeInternal = Just $ ExtraInternal $ A.object ["errors" A..= (AO.fromOrdered <$> errors)] - } - --- | Attempt to extract a deeply nested value from a remote source's 'AO.Value' --- response, according to the JSON path provided by 'ResponsePath'. -extractAtPath :: - forall m. - MonadError QErr m => - AO.Value -> - ResponsePath -> - m AO.Value -extractAtPath initValue (ResponsePath rPath) = - go initValue (map G.unName . NE.toList $ rPath) - where - go :: AO.Value -> [Text] -> m AO.Value - go value path = case path of - [] -> pure value - k : ks -> case value of - AO.Object obj -> do - objValue <- - AO.lookup k obj - `onNothing` throw500 ("failed to lookup key '" <> toTxt k <> "' in response") - go objValue ks - _ -> - throw500 $ - "unexpected non-object json value found while path not empty: " - <> commaSeparated path - -ordJSONValueToGValue :: (MonadError QErr n) => AO.Value -> n (G.Value Void) -ordJSONValueToGValue = - either (throw400 ValidationFailed) pure . P.jsonToGraphQL . AO.fromOrdered - -convertFieldWithVariablesToName :: G.Field G.NoFragments P.Variable -> G.Field G.NoFragments G.Name -convertFieldWithVariablesToName = fmap P.getName - -inputValueToJSON :: P.InputValue Void -> A.Value -inputValueToJSON = \case - P.JSONValue j -> j - P.GraphQLValue g -> graphQLValueToJSON g - --- | TODO: Documentation. -collectVariablesFromValue :: - G.Value P.Variable -> HashMap G.VariableDefinition A.Value -collectVariablesFromValue = foldMap' \var@(P.Variable _ gType val) -> - let name = P.getName var - jsonVal = inputValueToJSON val - defaultVal = getDefaultValue val - in Map.singleton (G.VariableDefinition name gType defaultVal) jsonVal - where - getDefaultValue :: P.InputValue Void -> Maybe (G.Value Void) - getDefaultValue = \case - P.JSONValue _ -> Nothing - P.GraphQLValue g -> Just g - --- | TODO: Documentation. -collectVariablesFromField :: - G.Field G.NoFragments P.Variable -> HashMap G.VariableDefinition A.Value -collectVariablesFromField (G.Field _ _ arguments _ selSet) = - let argumentVariables = fmap collectVariablesFromValue arguments - selSetVariables = - (fmap . fmap) snd $ collectVariablesFromSelectionSet selSet - in fold' (Map.elems argumentVariables) <> Map.fromList selSetVariables - --- | TODO: Documentation. --- --- Extension of the documentation required for 'collectVariablesFromField' and --- 'collectVariablesFromValue'. -fieldsToRequest :: NonEmpty (G.Field G.NoFragments P.Variable) -> GQLReqOutgoing -fieldsToRequest gFields = - let variableInfos = foldMap collectVariablesFromField gFields - in GQLReq - { _grOperationName = Nothing, - _grVariables = - mapKeys G._vdName variableInfos <$ guard (not $ Map.null variableInfos), - _grQuery = - G.TypedOperationDefinition - { G._todSelectionSet = - NE.toList $ G.SelectionField . convertFieldWithVariablesToName <$> gFields, - G._todVariableDefinitions = Map.keys variableInfos, - G._todType = G.OperationTypeQuery, - G._todName = Nothing, - G._todDirectives = [] - } - } + pure $ RemoteSchemaCall customizer gqlRequest responsePath -- | Fold nested 'FieldCall's into a bare 'Field', inserting the passed -- selection set at the leaf of the tree we construct. @@ -251,7 +144,7 @@ fieldCallsToField :: -- | Inserted at leaf of nested FieldCalls G.SelectionSet G.NoFragments RemoteSchemaVariable -> -- | Top-level name to set for this Field - Alias -> + G.Name -> NonEmpty FieldCall -> m (G.Field G.NoFragments RemoteSchemaVariable) fieldCallsToField rrArguments variables finalSelSet topAlias = @@ -269,7 +162,7 @@ fieldCallsToField rrArguments variables finalSelSet topAlias = Nothing -> let arguments = Map.unionWith - mergeValue + combineValues graphQLarguments -- converting (G.Value Void) -> (G.Value Variable) to merge the -- 'rrArguments' with the 'variables' @@ -290,54 +183,165 @@ fieldCallsToField rrArguments variables finalSelSet topAlias = -- FIXME: check that this is correct! throw500 "internal error: encountered an already expanded variable when folding remote field arguments" --- FIXME: better error message - --- This is a kind of "deep merge". --- For e.g. suppose the input argument of the remote field is something like: --- `where: { id : 1}` --- And during execution, client also gives the input arg: `where: {name: "tiru"}` --- We need to merge the input argument to where: {id : 1, name: "tiru"} -mergeValue :: G.Value RemoteSchemaVariable -> G.Value RemoteSchemaVariable -> G.Value RemoteSchemaVariable -mergeValue lVal rVal = case (lVal, rVal) of - (G.VList l, G.VList r) -> - G.VList $ l <> r - (G.VObject l, G.VObject r) -> - G.VObject $ Map.unionWith mergeValue l r - (_, _) -> - error $ - "can only merge a list with another list or an " - <> "object with another object" - --- | Create an argument map using the inputs taken from the hasura database. +-- | Create an argument map using the inputs taken from the left hand side. createArguments :: (MonadError QErr m) => Map.HashMap G.Name (G.Value Void) -> RemoteArguments -> m (HashMap G.Name (G.Value Void)) createArguments variables (RemoteArguments arguments) = - toEither (substituteVariables variables arguments) + toEither (traverse substituteVariables arguments) `onLeft` (\errors -> throw400 Unexpected $ "Found errors: " <> commaSeparated errors) - --- | Substitute values in the argument list. -substituteVariables :: - -- | Values of the variables to substitute. - HashMap G.Name (G.Value Void) -> - -- | Template which contains the variables. - HashMap G.Name (G.Value G.Name) -> - Validation [Text] (HashMap G.Name (G.Value Void)) -substituteVariables values = traverse go where - go = \case + substituteVariables = \case G.VVariable variableName -> - Map.lookup variableName values + Map.lookup variableName variables `onNothing` Failure ["Value for variable " <> variableName <<> " not provided"] G.VList listValue -> - fmap G.VList (traverse go listValue) + fmap G.VList (traverse substituteVariables listValue) G.VObject objectValue -> - fmap G.VObject (traverse go objectValue) + fmap G.VObject (traverse substituteVariables objectValue) G.VInt i -> pure $ G.VInt i G.VFloat d -> pure $ G.VFloat d G.VString txt -> pure $ G.VString txt G.VEnum e -> pure $ G.VEnum e G.VBoolean b -> pure $ G.VBoolean b G.VNull -> pure $ G.VNull + +-- | Combine two GraphQL values together. +-- +-- This is used to combine different input arguments into one. This function can +-- only combine objects or lists pairwise, and fails if it has to combine any +-- other combination of values. +-- +-- >>> combineValues (Object (fromList [("id", Number 1)]) (Object (fromList [("name", String "foo")]) +-- Object (fromList [("id", Number 1), ("name", String "foo")]) +-- +-- NOTE: this function *panics* if it fails. +combineValues :: + HasCallStack => G.Value RemoteSchemaVariable -> G.Value RemoteSchemaVariable -> G.Value RemoteSchemaVariable +combineValues (G.VList l) (G.VList r) = G.VList $ l <> r +combineValues (G.VObject l) (G.VObject r) = G.VObject $ Map.unionWith combineValues l r +combineValues l r = + error $ + "combineValues: cannot combine values (" <> show l <> ") and (" <> show r + <> "); \ + \lists can only be merged with lists, objects can only be merged with objects" + +-- | Craft a GraphQL query document from the list of fields. +fieldsToRequest :: NonEmpty (G.Field G.NoFragments P.Variable) -> GQLReqOutgoing +fieldsToRequest gFields = + GQLReq + { _grOperationName = Nothing, + _grVariables = + if Map.null variableInfos + then Nothing + else Just $ mapKeys G._vdName variableInfos, + _grQuery = + G.TypedOperationDefinition + { G._todSelectionSet = + -- convert from Field Variable to Field Name + NE.toList $ G.SelectionField . fmap P.getName <$> gFields, + G._todVariableDefinitions = Map.keys variableInfos, + G._todType = G.OperationTypeQuery, + G._todName = Nothing, + G._todDirectives = [] + } + } + where + variableInfos :: HashMap G.VariableDefinition A.Value + variableInfos = Map.fromList $ concatMap (foldMap getVariableInfo) gFields + getVariableInfo :: P.Variable -> [(G.VariableDefinition, A.Value)] + getVariableInfo = pure . fmap snd . getVariableDefinitionAndValue + +------------------------------------------------------------------------------ +-- Step 2: sending the call over the network + +-- | Sends the call over the network, and parse the resulting ByteString. +executeRemoteSchemaCall :: + (MonadError QErr m) => + -- | Function to send a request over the network. + (GQLReqOutgoing -> m BL.ByteString) -> + -- | Information about that call. + RemoteSchemaCall -> + -- | Resulting JSON object + m AO.Object +executeRemoteSchemaCall networkFunction (RemoteSchemaCall customizer request _) = do + responseBody <- networkFunction request + responseJSON <- + AO.eitherDecode responseBody + `onLeft` (\e -> throw500 $ "Remote server response is not valid JSON: " <> T.pack e) + responseObject <- AO.asObject responseJSON `onLeft` throw500 + let errors = AO.lookup "errors" responseObject + if + | isNothing errors || errors == Just AO.Null -> + case AO.lookup "data" responseObject of + Nothing -> throw500 "\"data\" field not found in remote response" + Just v -> + let v' = applyResultCustomizer customizer v + in AO.asObject v' `onLeft` throw500 + | otherwise -> + throwError + (err400 Unexpected "Errors from remote server") + { qeInternal = Just $ ExtraInternal $ A.object ["errors" A..= (AO.fromOrdered <$> errors)] + } + +------------------------------------------------------------------------------- +-- Step 3: extracting the join index + +-- | Construct a join index from the remote source's 'AO.Value' response. +-- +-- This function extracts from the 'RemoteJoinCall' a mapping from +-- 'JoinArgumentId' to 'ResponsePath': from an integer that uniquely identifies +-- a join argument to the "path" at which we expect that value in the +-- response. With it, and with the actual reponse JSON value obtained from the +-- remote server, it constructs a corresponding mapping of, for each argument, +-- its extracted value. +-- +-- If the response does not have value at any of the provided 'ResponsePath's, +-- throw a generic 'QErr'. +-- +-- NOTE(jkachmar): If we switch to an 'Applicative' validator, we can collect +-- more than one missing 'ResponsePath's (rather than short-circuiting on the +-- first missing value). +buildJoinIndex :: + forall m. + (MonadError QErr m) => + RemoteSchemaCall -> + AO.Object -> + m (IntMap.IntMap AO.Value) +buildJoinIndex RemoteSchemaCall {..} response = + for rscResponsePaths $ \(ResponsePath path) -> + go (AO.Object response) (map G.unName . NE.toList $ path) + where + go :: AO.Value -> [Text] -> m AO.Value + go value path = case path of + [] -> pure value + k : ks -> case value of + AO.Object obj -> do + objValue <- + AO.lookup k obj + `onNothing` throw500 ("failed to lookup key '" <> toTxt k <> "' in response") + go objValue ks + _ -> + throw500 $ + "unexpected non-object json value found while path not empty: " + <> commaSeparated path + +------------------------------------------------------------------------------- +-- Local helpers + +-- NOTE: Ideally this should be done at the remote relationship validation +-- layer. +-- +-- When validating remote relationships, we should store the validated names so +-- that we don't need to continually re-validate them downstream. +parseGraphQLName :: (MonadError QErr m) => Text -> m G.Name +parseGraphQLName txt = + G.mkName txt `onNothing` (throw400 RemoteSchemaError $ errMsg) + where + errMsg = txt <> " is not a valid GraphQL name" + +ordJSONValueToGValue :: (MonadError QErr n) => AO.Value -> n (G.Value Void) +ordJSONValueToGValue = + either (throw400 ValidationFailed) pure . P.jsonToGraphQL . AO.fromOrdered diff --git a/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Types.hs b/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Types.hs index f62eec13dfb..a0832572586 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Types.hs @@ -2,21 +2,30 @@ {-# LANGUAGE UndecidableInstances #-} module Hasura.GraphQL.Execute.RemoteJoin.Types - ( RemoteJoin (..), - getPhantomFields, - getJoinColumnMapping, - getRemoteSchemaJoins, - RemoteSchemaJoin (..), - RemoteSourceJoin (..), - RemoteJoins, - JoinColumnAlias (..), - getAliasFieldName, + ( -- * Remote joins tree JoinTree (..), JoinNode (..), + RemoteJoins, + QualifiedFieldName (..), + getRemoteSchemaJoins, + + -- * Individual join information + RemoteJoin (..), JoinCallId, + JoinColumnAlias (..), + getAliasFieldName, + getPhantomFields, + getJoinColumnMapping, + + -- * Join to source + RemoteSourceJoin (..), + + -- * Join to schema + RemoteSchemaJoin (..), + + -- * Join arguments JoinArgumentId, JoinArgument (..), - JoinIndex, JoinArguments (..), ) where @@ -24,15 +33,18 @@ where import Control.Lens (view, _1) import Data.Aeson.Ordered qualified as AO import Data.HashMap.Strict qualified as Map -import Data.HashMap.Strict.NonEmpty qualified as Map -import Data.IntMap.Strict qualified as IntMap +import Data.HashMap.Strict.NonEmpty qualified as NEMap import Hasura.GraphQL.Parser qualified as P import Hasura.Prelude +import Hasura.RQL.IR.RemoteSchema qualified as IR import Hasura.RQL.IR.Select qualified as IR import Hasura.RQL.Types import Hasura.SQL.AnyBackend qualified as AB import Language.GraphQL.Draft.Syntax qualified as G +------------------------------------------------------------------------------- +-- Remote joins tree + -- | A JoinTree represents the set of operations that need to be executed to -- enrich the response of a source with data from remote sources. A tree -- structure is used to capture the locations in the response where the join @@ -62,33 +74,102 @@ import Language.GraphQL.Draft.Syntax qualified as G -- Note that the same join tree will be emitted even if 'city' is of type -- '[City]' and 'state' is of type [State], we currently do not capture any -- information if any of the fields in the path expect json arrays. It is --- similar in spirit to a GraphQL selection set in this regard -newtype JoinTree a = JoinTree {unJoinTree :: Map.NEHashMap FieldName (JoinNode a)} - deriving stock (Eq, Foldable, Functor, Generic, Traversable, Show) +-- similar in spirit to a GraphQL selection set in this regard. +-- +-- This structure is somewhat similar to a prefix tree such as 'Data.Trie.Trie', +-- but has two additional guarantees: +-- - a 'JoinTree' is never empty, +-- - there cannot exist a pair of values for which one's prefix key is a +-- subset of the other: every value is effectively a leaf. +newtype JoinTree a = JoinTree {unJoinTree :: NEMap.NEHashMap QualifiedFieldName (JoinNode a)} + deriving stock (Show, Eq, Functor, Foldable, Traversable, Generic) deriving newtype (Semigroup) +-- | A field name annotated with an optional type name. +-- +-- To deal with ambiguous join paths, such as those that emerge from GraphQL +-- interfaces or GraphQL unions, we do not just keep track of the fields' name, +-- but also, optionally, of their type. Whenever a selection set is deemed +-- ambiguous, we insert a reserved field in the query to retrieve the typename, +-- @__hasura_internal_typename@; when traversing the join tree, if that key is +-- present, then we use it alongside the field name when querying the join tree +-- (see @traverseObject@ in the @Join@ module). +-- +-- We use 'Text' for the representation of the field name instead of +-- 'FieldName', for simplicity: the join tree is only meant to be queried using +-- the values we get in the reponse, which will be unrestricted text. +data QualifiedFieldName = QualifiedFieldName + { _qfTypeName :: Maybe Text, + _qfFieldName :: Text + } + deriving stock (Show, Eq, Generic) + deriving anyclass (Hashable) + +-- | Each leaf associates a mapping from typename to actual join info. +-- This allows to disambiguate between different remote joins with the same name +-- in a given selection set, which might happen with union or interface +-- fragments. data JoinNode a = Leaf a - | Tree !(JoinTree a) + | Tree (JoinTree a) deriving stock (Eq, Foldable, Functor, Generic, Traversable, Show) type RemoteJoins = JoinTree RemoteJoin --- | TODO(jkachmar): Documentation +-- | Collect all the remote joins to a remote schema from a join tree. +getRemoteSchemaJoins :: RemoteJoins -> [RemoteSchemaJoin] +getRemoteSchemaJoins = concatMap getRemoteSchemaJoin . toList + where + getRemoteSchemaJoin :: RemoteJoin -> [RemoteSchemaJoin] + getRemoteSchemaJoin = \case + RemoteJoinSource _ remoteJoins -> maybe [] getRemoteSchemaJoins remoteJoins + RemoteJoinRemoteSchema s remoteJoins -> s : maybe [] getRemoteSchemaJoins remoteJoins + +------------------------------------------------------------------------------- +-- Individual join information + +-- | An individual join entry point in a 'JoinTree'. +-- +-- Either a join against a source, or against a remote schema. In either case, +-- the constructor will contain that particular join's information (a +-- 'RemoteSourceJoin' or 'RemoteSchemaJoin' respectively) and, recursively, the +-- set of follow-up 'RemoteJoins' from that target, if any. data RemoteJoin - = RemoteJoinSource !(AB.AnyBackend RemoteSourceJoin) !(Maybe RemoteJoins) - | RemoteJoinRemoteSchema !RemoteSchemaJoin + = RemoteJoinSource (AB.AnyBackend RemoteSourceJoin) (Maybe RemoteJoins) + | RemoteJoinRemoteSchema RemoteSchemaJoin (Maybe RemoteJoins) deriving stock (Eq, Generic) --- | This collects all the remote joins from a join tree -getRemoteSchemaJoins :: RemoteJoins -> [RemoteSchemaJoin] -getRemoteSchemaJoins = mapMaybe getRemoteSchemaJoin . toList - where - getRemoteSchemaJoin :: RemoteJoin -> Maybe RemoteSchemaJoin - getRemoteSchemaJoin = \case - RemoteJoinSource _ _ -> Nothing - RemoteJoinRemoteSchema s -> Just s +-- | A unique id that gets assigned to each 'RemoteJoin' (this is to avoid the +-- requirement of Ord/Hashable implementation for RemoteJoin) +type JoinCallId = Int +-- | Disambiguates between 'FieldName's which are provided as part of the +-- GraphQL selection provided by the user (i.e. 'JCSelected') and those which +-- we need to retreive data but which are not expressly requested (i.e. +-- 'JCPhantom'). +-- +-- After processing the remote join, we remove all phantom 'FieldName's and +-- only return those which fall under the 'JCSelected' branch of this type. +data JoinColumnAlias + = -- | This fieldname is already part of the response. + JCSelected !FieldName + | -- | This is explicitly added for the join. + -- + -- Such keys will have to be removed from the response eventually. + JCPhantom !FieldName + deriving stock (Eq, Generic, Show) + deriving anyclass (Hashable) + +-- | Extracts the field name from the 'JoinColumnAlias', regardless of whether +-- the field is requested by the user of a "phantom" field. +getAliasFieldName :: JoinColumnAlias -> FieldName +getAliasFieldName = \case + JCSelected f -> f + JCPhantom f -> f + +-- | Extracts the list of phantom field names out of a given 'RemoteJoin', +-- i.e. the name of the fields that must be part of the query but were not +-- requested by the user. getPhantomFields :: RemoteJoin -> [FieldName] getPhantomFields = mapMaybe getPhantomFieldName . Map.elems . getJoinColumnMapping @@ -98,16 +179,27 @@ getPhantomFields = JCSelected _ -> Nothing JCPhantom f -> Just f +-- | Extracts an abstracted field mapping for a particular 'RemoteJoin', using a +-- common representation. +-- +-- The RHS of the mapping uses 'JoinColumnAlias' instead of 'FieldName' to +-- differentiate between selected fields and phantom fields (see +-- 'JoinColumnAlias'). getJoinColumnMapping :: RemoteJoin -> Map.HashMap FieldName JoinColumnAlias getJoinColumnMapping = \case RemoteJoinSource sourceJoin _ -> AB.runBackend sourceJoin \RemoteSourceJoin {_rsjJoinColumns} -> fmap (view _1) _rsjJoinColumns - RemoteJoinRemoteSchema RemoteSchemaJoin {_rsjJoinColumnAliases} -> + RemoteJoinRemoteSchema RemoteSchemaJoin {_rsjJoinColumnAliases} _ -> _rsjJoinColumnAliases --- | TODO(jkachmar): Documentation. +------------------------------------------------------------------------------- +-- Join to source + +-- | A 'RemoteSourceJoin' contains all the contextual information required for +-- the execution of a join against a source, translated from the IR's +-- representation of a selection (see 'AnnFieldG'). data RemoteSourceJoin b = RemoteSourceJoin { _rsjSource :: !SourceName, _rsjSourceConfig :: !(SourceConfig b), @@ -131,37 +223,19 @@ deriving instance ) => Eq (RemoteSourceJoin b) --- | Disambiguates between 'FieldName's which are provided as part of the --- GraphQL selection provided by the user (i.e. 'JCSelected') and those which --- we need to retreive data but which are not expressly requested (i.e. --- 'JCPhantom'). --- --- After processing the remote join, we remove all phantom 'FieldName's and --- only return those which fall under the 'JCSelected' branch of this type. -data JoinColumnAlias - = -- | This fieldname is already part of the response. - JCSelected !FieldName - | -- | This is explicitly added for the join. - -- - -- Such keys will have to be removed from the response eventually. - JCPhantom !FieldName - deriving stock (Eq, Generic, Show) - deriving anyclass (Hashable) +------------------------------------------------------------------------------- +-- Join to schema -getAliasFieldName :: JoinColumnAlias -> FieldName -getAliasFieldName = \case - JCSelected f -> f - JCPhantom f -> f - --- | A 'RemoteSchemaJoin' represents the context of a remote relationship to be --- extracted from 'AnnFieldG's. +-- | A 'RemoteSchemaJoin' contains all the contextual information required for +-- the execution of a join against a remote schema, translated from the IR's +-- representation of a selection (see 'AnnFieldG'). data RemoteSchemaJoin = RemoteSchemaJoin { -- | User-provided arguments with variables. _rsjArgs :: !(Map.HashMap G.Name (P.InputValue RemoteSchemaVariable)), -- | Customizer for JSON result from the remote server. _rsjResultCustomizer :: !ResultCustomizer, -- | User-provided selection set of remote field. - _rsjSelSet :: !(G.SelectionSet G.NoFragments RemoteSchemaVariable), + _rsjSelSet :: !(IR.SelectionSet Void RemoteSchemaVariable), -- | A map of the join column to its alias in the response _rsjJoinColumnAliases :: !(Map.HashMap FieldName JoinColumnAlias), -- | Remote server fields. @@ -177,9 +251,8 @@ instance Eq RemoteSchemaJoin where (==) = on (==) \RemoteSchemaJoin {..} -> (_rsjArgs, _rsjSelSet, _rsjJoinColumnAliases, _rsjFieldCall, _rsjRemoteSchema) --- | A unique id that gets assigned to each 'RemoteJoin' (this is to avoid the --- requirement of Ord/Hashable implementation for RemoteJoin) -type JoinCallId = Int +------------------------------------------------------------------------------- +-- Join arguments -- | A map of fieldname to values extracted from each LHS row/object -- @@ -195,9 +268,6 @@ newtype JoinArgument = JoinArgument {unJoinArgument :: Map.HashMap FieldName AO. -- | A unique id assigned to each join argument type JoinArgumentId = Int --- | A map of JoinArgumentId to its value fetched from the RHS source of a join -type JoinIndex = IntMap.IntMap AO.Value - data JoinArguments = JoinArguments { -- | The 'RemoteJoin' associated with the join arguments within this -- structure. diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index b9c96477070..532698025fc 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -243,12 +243,12 @@ buildRoleContext where getQueryRemotes :: [ParsedIntrospection] -> - [P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))] + [P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))] getQueryRemotes = concatMap piQuery getMutationRemotes :: [ParsedIntrospection] -> - [P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))] + [P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))] getMutationRemotes = concatMap (concat . piMutation) buildSource :: @@ -429,8 +429,8 @@ unauthenticatedContext :: ( MonadError QErr m, MonadIO m ) => - [P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))] -> - [P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))] -> + [P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))] -> + [P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))] -> RemoteSchemaPermsCtx -> m GQLContext unauthenticatedContext adminQueryRemotes adminMutationRemotes remoteSchemaPermsCtx = P.runSchemaT $ do @@ -613,7 +613,7 @@ buildQueryParser :: Has CustomizeRemoteFieldName r ) => [P.FieldParser n (NamespacedField (QueryRootField UnpreparedValue))] -> - [P.FieldParser n (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))] -> + [P.FieldParser n (NamespacedField (RemoteSchemaRootField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))] -> [ActionInfo] -> AnnotatedCustomTypes -> Maybe (Parser 'Output n (RootFieldMap (MutationRootField UnpreparedValue))) -> @@ -711,7 +711,7 @@ buildMutationParser :: Has MkRootFieldName r, Has CustomizeRemoteFieldName r ) => - [P.FieldParser n (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))] -> + [P.FieldParser n (NamespacedField (RemoteSchemaRootField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))] -> [ActionInfo] -> AnnotatedCustomTypes -> [P.FieldParser n (NamespacedField (MutationRootField UnpreparedValue))] -> diff --git a/server/src-lib/Hasura/GraphQL/Schema/Remote.hs b/server/src-lib/Hasura/GraphQL/Schema/Remote.hs index 6fb11f82c4c..d88418eb11b 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Remote.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Remote.hs @@ -24,9 +24,10 @@ import Hasura.GraphQL.Parser.Internal.Parser qualified as P import Hasura.GraphQL.Parser.Internal.TypeChecking qualified as P import Hasura.Prelude import Hasura.RQL.IR.RemoteSchema qualified as IR +import Hasura.RQL.IR.Root qualified as IR import Hasura.RQL.Types.RemoteSchema import Hasura.RQL.Types.ResultCustomization -import Hasura.RQL.Types.SchemaCache (IntrospectionResult (IntrospectionResult, irMutationRoot, irQueryRoot, irSubscriptionRoot), ParsedIntrospectionG (..)) +import Hasura.RQL.Types.SchemaCache import Hasura.RQL.Types.SourceCustomization import Language.GraphQL.Draft.Syntax qualified as G @@ -52,7 +53,7 @@ buildRemoteParser introspectionResult remoteSchemaInfo@RemoteSchemaInfo {..} = d makeResultCustomizer :: RemoteSchemaCustomizer -> - IR.GraphQLField Void RemoteSchemaVariable -> + IR.GraphQLField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable -> ResultCustomizer makeResultCustomizer remoteSchemaCustomizer IR.GraphQLField {..} = modifyFieldByName _fAlias $ @@ -61,16 +62,21 @@ makeResultCustomizer remoteSchemaCustomizer IR.GraphQLField {..} = else resultCustomizerFromSelection _fSelectionSet where resultCustomizerFromSelection :: - IR.SelectionSet Void RemoteSchemaVariable -> ResultCustomizer + IR.SelectionSet (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable -> ResultCustomizer resultCustomizerFromSelection = \case IR.SelectionSetObject s -> foldMap customizeField s IR.SelectionSetUnion s -> foldMap (foldMap customizeField) $ IR._atssMemberSelectionSets s IR.SelectionSetInterface s -> foldMap (foldMap customizeField) $ IR._atssMemberSelectionSets s IR.SelectionSetNone -> mempty - customizeField :: IR.Field Void RemoteSchemaVariable -> ResultCustomizer + customizeField :: IR.Field (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable -> ResultCustomizer customizeField = \case IR.FieldGraphQL f -> makeResultCustomizer remoteSchemaCustomizer f + -- we do not traverse the remote because that part of the response is + -- never exists in the response by a remote schema - it is only added + -- later by the remote joins execution engine, which in turn would have + -- been processed by its own result customizer if applicable + IR.FieldRemote _ -> mempty buildRawRemoteParser :: forall r m n. @@ -79,9 +85,9 @@ buildRawRemoteParser :: RemoteSchemaInfo -> -- | parsers for, respectively: queries, mutations, and subscriptions m - ( [P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)], - Maybe [P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)], - Maybe [P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)] + ( [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)], + Maybe [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)], + Maybe [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)] ) buildRawRemoteParser (IntrospectionResult sdoc queryRoot mutationRoot subscriptionRoot) info = do queryT <- makeParsers queryRoot @@ -89,21 +95,21 @@ buildRawRemoteParser (IntrospectionResult sdoc queryRoot mutationRoot subscripti subscriptionT <- makeNonQueryRootFieldParser subscriptionRoot $$(G.litName "Subscription") return (queryT, mutationT, subscriptionT) where - makeFieldParser :: G.Name -> G.FieldDefinition RemoteSchemaInputValueDefinition -> m (P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)) + makeFieldParser :: G.Name -> G.FieldDefinition RemoteSchemaInputValueDefinition -> m (P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)) makeFieldParser rootTypeName fieldDef = fmap makeRemoteField <$> remoteFieldFromDefinition sdoc rootTypeName fieldDef - makeRemoteField :: IR.GraphQLField Void RemoteSchemaVariable -> (IR.RemoteSchemaRootField Void RemoteSchemaVariable) + makeRemoteField :: IR.GraphQLField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable -> (IR.RemoteSchemaRootField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable) makeRemoteField fld = IR.RemoteSchemaRootField info (makeResultCustomizer (rsCustomizer info) fld) fld - makeParsers :: G.Name -> m [P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)] + makeParsers :: G.Name -> m [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)] makeParsers rootName = case lookupType sdoc rootName of Just (G.TypeDefinitionObject o) -> traverse (makeFieldParser rootName) $ G._otdFieldsDefinition o _ -> throw400 Unexpected $ rootName <<> " has to be an object type" - makeNonQueryRootFieldParser :: Maybe G.Name -> G.Name -> m (Maybe [P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)]) + makeNonQueryRootFieldParser :: Maybe G.Name -> G.Name -> m (Maybe [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]) makeNonQueryRootFieldParser userProvidedRootName defaultRootName = case userProvidedRootName of Just _rootName -> traverse makeParsers userProvidedRootName @@ -550,7 +556,7 @@ remoteSchemaObject :: MonadBuildRemoteSchema r m n => RemoteSchemaIntrospection -> G.ObjectTypeDefinition RemoteSchemaInputValueDefinition -> - m (Parser 'Output n (IR.ObjectSelectionSet Void RemoteSchemaVariable)) + m (Parser 'Output n (IR.ObjectSelectionSet (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)) remoteSchemaObject schemaDoc defn@(G.ObjectTypeDefinition description name interfaces _directives subFields) = P.memoizeOn 'remoteSchemaObject defn do subFieldParsers <- traverse (remoteFieldFromDefinition schemaDoc name) subFields @@ -730,7 +736,7 @@ remoteSchemaInterface :: MonadBuildRemoteSchema r m n => RemoteSchemaIntrospection -> G.InterfaceTypeDefinition [G.Name] RemoteSchemaInputValueDefinition -> - m (Parser 'Output n (IR.DeduplicatedSelectionSet Void RemoteSchemaVariable)) + m (Parser 'Output n (IR.DeduplicatedSelectionSet (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)) remoteSchemaInterface schemaDoc defn@(G.InterfaceTypeDefinition description name _directives fields possibleTypes) = P.memoizeOn 'remoteSchemaObject defn do subFieldParsers <- traverse (remoteFieldFromDefinition schemaDoc name) fields @@ -770,7 +776,7 @@ remoteSchemaUnion :: MonadBuildRemoteSchema r m n => RemoteSchemaIntrospection -> G.UnionTypeDefinition -> - m (Parser 'Output n (IR.DeduplicatedSelectionSet Void RemoteSchemaVariable)) + m (Parser 'Output n (IR.DeduplicatedSelectionSet (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)) remoteSchemaUnion schemaDoc defn@(G.UnionTypeDefinition description name _directives objectNames) = P.memoizeOn 'remoteSchemaObject defn do objs <- traverse (getObjectParser schemaDoc getObject) objectNames @@ -800,7 +806,7 @@ remoteFieldFromDefinition :: RemoteSchemaIntrospection -> G.Name -> G.FieldDefinition RemoteSchemaInputValueDefinition -> - m (FieldParser n (IR.GraphQLField Void RemoteSchemaVariable)) + m (FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)) remoteFieldFromDefinition schemaDoc parentTypeName (G.FieldDefinition description name argsDefinition gType _) = convertType gType where @@ -815,7 +821,7 @@ remoteFieldFromDefinition schemaDoc parentTypeName (G.FieldDefinition descriptio -- TODO add directives, deprecation convertType :: G.GType -> - m (FieldParser n (IR.GraphQLField Void RemoteSchemaVariable)) + m (FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)) convertType = \case G.TypeNamed (G.Nullability True) fieldTypeName -> P.nullableField <$> remoteFieldFromName schemaDoc parentTypeName name description fieldTypeName argsDefinition @@ -837,7 +843,7 @@ remoteFieldFromName :: Maybe G.Description -> G.Name -> G.ArgumentsDefinition RemoteSchemaInputValueDefinition -> - m (FieldParser n (IR.GraphQLField Void RemoteSchemaVariable)) + m (FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)) remoteFieldFromName sdoc parentTypeName fieldName description fieldTypeName argsDefns = case lookupType sdoc fieldTypeName of Nothing -> throw400 RemoteSchemaError $ "Could not find type with name " <>> fieldTypeName @@ -855,7 +861,7 @@ remoteField :: Maybe G.Description -> G.ArgumentsDefinition RemoteSchemaInputValueDefinition -> G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition -> - m (FieldParser n (IR.GraphQLField Void RemoteSchemaVariable)) + m (FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)) remoteField sdoc parentTypeName fieldName description argsDefn typeDefn = do -- TODO add directives argsParser <- argumentsParser argsDefn sdoc @@ -884,8 +890,8 @@ remoteField sdoc parentTypeName fieldName description argsDefn typeDefn = do Maybe G.Name -> G.Name -> HashMap G.Name (G.Value RemoteSchemaVariable) -> - IR.SelectionSet Void RemoteSchemaVariable -> - IR.GraphQLField Void RemoteSchemaVariable + IR.SelectionSet (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable -> + IR.GraphQLField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable mkField alias customizedFieldName args selSet = -- If there's no alias then use customizedFieldName as the alias so the -- correctly customized field name will be returned from the remote server. @@ -896,7 +902,7 @@ remoteField sdoc parentTypeName fieldName description argsDefn typeDefn = do G.Name -> InputFieldsParser n (Altered, HashMap G.Name (G.Value RemoteSchemaVariable)) -> Parser 'Both n () -> - FieldParser n (IR.GraphQLField Void RemoteSchemaVariable) + FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable) mkFieldParserWithoutSelectionSet customizedFieldName argsParser outputParser = P.rawSelection customizedFieldName description argsParser outputParser <&> \(alias, _, (_, args)) -> mkField alias customizedFieldName args IR.SelectionSetNone @@ -904,8 +910,8 @@ remoteField sdoc parentTypeName fieldName description argsDefn typeDefn = do mkFieldParserWithSelectionSet :: G.Name -> InputFieldsParser n (Altered, HashMap G.Name (G.Value RemoteSchemaVariable)) -> - Parser 'Output n (IR.SelectionSet Void RemoteSchemaVariable) -> - FieldParser n (IR.GraphQLField Void RemoteSchemaVariable) + Parser 'Output n (IR.SelectionSet (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable) -> + FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable) mkFieldParserWithSelectionSet customizedFieldName argsParser outputParser = P.rawSubselection customizedFieldName description argsParser outputParser <&> \(alias, _, (_, args), selSet) -> mkField alias customizedFieldName args selSet @@ -921,7 +927,7 @@ getObjectParser :: RemoteSchemaIntrospection -> (G.Name -> m (G.ObjectTypeDefinition RemoteSchemaInputValueDefinition)) -> G.Name -> - m (Parser 'Output n (G.Name, IR.ObjectSelectionSet Void RemoteSchemaVariable)) + m (Parser 'Output n (G.Name, IR.ObjectSelectionSet (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)) getObjectParser schemaDoc getObject objName = do obj <- remoteSchemaObject schemaDoc =<< getObject objName return $ (objName,) <$> obj @@ -931,8 +937,8 @@ customizeRemoteNamespace :: (MonadParse n) => RemoteSchemaInfo -> G.Name -> - [P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)] -> - [P.FieldParser n (NamespacedField (IR.RemoteSchemaRootField Void RemoteSchemaVariable))] + [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)] -> + [P.FieldParser n (NamespacedField (IR.RemoteSchemaRootField (IR.RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))] customizeRemoteNamespace remoteSchemaInfo@RemoteSchemaInfo {..} rootTypeName fieldParsers = customizeNamespace (_rscNamespaceFieldName rsCustomizer) fromParsedSelection mkNamespaceTypename fieldParsers where diff --git a/server/src-lib/Hasura/GraphQL/Schema/RemoteRelationship.hs b/server/src-lib/Hasura/GraphQL/Schema/RemoteRelationship.hs index e9005d332fb..1a5f22267a9 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/RemoteRelationship.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/RemoteRelationship.hs @@ -60,7 +60,7 @@ remoteRelationshipToSchemaField :: (MonadBuildSchemaBase r m n) => Map.HashMap FieldName lhsJoinField -> RemoteSchemaFieldInfo -> - m (Maybe (FieldParser n IR.RemoteSchemaSelect)) + m (Maybe (FieldParser n (IR.RemoteSchemaSelect (IR.RemoteRelationshipField UnpreparedValue)))) remoteRelationshipToSchemaField lhsFields RemoteSchemaFieldInfo {..} = runMaybeT do remoteRelationshipQueryCtx <- asks $ qcRemoteRelationshipContext . getter RemoteRelationshipQueryContext roleIntrospectionResultOriginal _ remoteSchemaCustomizer <- diff --git a/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs b/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs index 18588fa5dc8..aa2ed0270c7 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs @@ -242,7 +242,7 @@ runSessVarPred = filterSessionVariables . fromMaybe (\_ _ -> False) . unSessVarP filterVariablesFromQuery :: [ RootField (QueryDBRoot (RemoteRelationshipField UnpreparedValue) UnpreparedValue) - (RemoteSchemaRootField Void RemoteSchemaVariable) + (RemoteSchemaRootField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable) (ActionQuery (RemoteRelationshipField UnpreparedValue)) d ] -> @@ -432,9 +432,9 @@ runGQ env logger reqId userInfo ipAddress reqHeaders queryType reqUnparsed = do finalResponse <- RJ.processRemoteJoins reqId logger env httpManager reqHeaders userInfo resp remoteJoins reqUnparsed pure $ AnnotatedResponsePart telemTimeIO_DT Telem.Local finalResponse [] - E.ExecStepRemote rsi resultCustomizer gqlReq -> do + E.ExecStepRemote rsi resultCustomizer gqlReq remoteJoins -> do logQueryLog logger $ QueryLog reqUnparsed Nothing reqId QueryLogKindRemoteSchema - runRemoteGQ httpManager fieldName rsi resultCustomizer gqlReq + runRemoteGQ httpManager fieldName rsi resultCustomizer gqlReq remoteJoins E.ExecStepAction aep _ remoteJoins -> do logQueryLog logger $ QueryLog reqUnparsed Nothing reqId QueryLogKindAction (time, resp) <- doQErr $ do @@ -462,9 +462,9 @@ runGQ env logger reqId userInfo ipAddress reqHeaders queryType reqUnparsed = do finalResponse <- RJ.processRemoteJoins reqId logger env httpManager reqHeaders userInfo resp remoteJoins reqUnparsed pure $ AnnotatedResponsePart telemTimeIO_DT Telem.Local finalResponse responseHeaders - E.ExecStepRemote rsi resultCustomizer gqlReq -> do + E.ExecStepRemote rsi resultCustomizer gqlReq remoteJoins -> do logQueryLog logger $ QueryLog reqUnparsed Nothing reqId QueryLogKindRemoteSchema - runRemoteGQ httpManager fieldName rsi resultCustomizer gqlReq + runRemoteGQ httpManager fieldName rsi resultCustomizer gqlReq remoteJoins E.ExecStepAction aep _ remoteJoins -> do logQueryLog logger $ QueryLog reqUnparsed Nothing reqId QueryLogKindAction (time, (resp, hdrs)) <- doQErr $ do @@ -477,12 +477,25 @@ runGQ env logger reqId userInfo ipAddress reqHeaders queryType reqUnparsed = do logQueryLog logger $ QueryLog reqUnparsed Nothing reqId QueryLogKindIntrospection buildRaw json - runRemoteGQ httpManager fieldName rsi resultCustomizer gqlReq = do + runRemoteGQ httpManager fieldName rsi resultCustomizer gqlReq remoteJoins = do (telemTimeIO_DT, remoteResponseHeaders, resp) <- doQErr $ E.execRemoteGQ env httpManager userInfo reqHeaders (rsDef rsi) gqlReq value <- extractFieldFromResponse fieldName resultCustomizer resp + finalResponse <- + doQErr $ + RJ.processRemoteJoins + reqId + logger + env + httpManager + reqHeaders + userInfo + -- TODO: avoid encode and decode here + (encJFromOrderedValue value) + remoteJoins + reqUnparsed let filteredHeaders = filter ((== "Set-Cookie") . fst) remoteResponseHeaders - pure $ AnnotatedResponsePart telemTimeIO_DT Telem.Remote (encJFromOrderedValue value) filteredHeaders + pure $ AnnotatedResponsePart telemTimeIO_DT Telem.Remote finalResponse filteredHeaders cacheAccess :: GQLReqParsed -> diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs index 75299bdb8b9..9c9de46f49d 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs @@ -500,9 +500,9 @@ onStart env enabledLogTypes serverEnv wsConn (StartMsg opId q) onMessageActions finalResponse <- RJ.processRemoteJoins requestId logger env httpMgr reqHdrs userInfo resp remoteJoins q pure $ AnnotatedResponsePart telemTimeIO_DT Telem.Local finalResponse [] - E.ExecStepRemote rsi resultCustomizer gqlReq -> do + E.ExecStepRemote rsi resultCustomizer gqlReq remoteJoins -> do logQueryLog logger $ QueryLog q Nothing requestId QueryLogKindRemoteSchema - runRemoteGQ fieldName userInfo reqHdrs rsi resultCustomizer gqlReq + runRemoteGQ requestId q fieldName userInfo reqHdrs rsi resultCustomizer gqlReq remoteJoins E.ExecStepAction actionExecPlan _ remoteJoins -> do logQueryLog logger $ QueryLog q Nothing requestId QueryLogKindAction (time, (resp, _)) <- doQErr $ do @@ -577,9 +577,9 @@ onStart env enabledLogTypes serverEnv wsConn (StartMsg opId q) onMessageActions RJ.processRemoteJoins requestId logger env httpMgr reqHdrs userInfo resp remoteJoins q pure (time, (finalResponse, hdrs)) pure $ AnnotatedResponsePart time Telem.Empty resp $ fromMaybe [] hdrs - E.ExecStepRemote rsi resultCustomizer gqlReq -> do + E.ExecStepRemote rsi resultCustomizer gqlReq remoteJoins -> do logQueryLog logger $ QueryLog q Nothing requestId QueryLogKindRemoteSchema - runRemoteGQ fieldName userInfo reqHdrs rsi resultCustomizer gqlReq + runRemoteGQ requestId q fieldName userInfo reqHdrs rsi resultCustomizer gqlReq remoteJoins E.ExecStepRaw json -> do logQueryLog logger $ QueryLog q Nothing requestId QueryLogKindIntrospection buildRaw json @@ -707,19 +707,35 @@ onStart env enabledLogTypes serverEnv wsConn (StartMsg opId q) onMessageActions Telem.recordTimingMetric Telem.RequestDimensions {..} Telem.RequestTimings {..} runRemoteGQ :: + RequestId -> + GQLReqUnparsed -> RootFieldAlias -> UserInfo -> [HTTP.Header] -> RemoteSchemaInfo -> ResultCustomizer -> GQLReqOutgoing -> + Maybe RJ.RemoteJoins -> ExceptT (Either GQExecError QErr) (ExceptT () m) AnnotatedResponsePart - runRemoteGQ fieldName userInfo reqHdrs rsi resultCustomizer gqlReq = do + runRemoteGQ requestId reqUnparsed fieldName userInfo reqHdrs rsi resultCustomizer gqlReq remoteJoins = do (telemTimeIO_DT, _respHdrs, resp) <- doQErr $ E.execRemoteGQ env httpMgr userInfo reqHdrs (rsDef rsi) gqlReq value <- mapExceptT lift $ extractFieldFromResponse fieldName resultCustomizer resp - return $ AnnotatedResponsePart telemTimeIO_DT Telem.Remote (encJFromOrderedValue value) [] + finalResponse <- + doQErr $ + RJ.processRemoteJoins + requestId + logger + env + httpMgr + reqHdrs + userInfo + -- TODO: avoid encode and decode here + (encJFromOrderedValue value) + remoteJoins + reqUnparsed + return $ AnnotatedResponsePart telemTimeIO_DT Telem.Remote finalResponse [] WSServerEnv logger diff --git a/server/src-lib/Hasura/RQL/IR/RemoteSchema.hs b/server/src-lib/Hasura/RQL/IR/RemoteSchema.hs index b662fc83552..4b516b4b067 100644 --- a/server/src-lib/Hasura/RQL/IR/RemoteSchema.hs +++ b/server/src-lib/Hasura/RQL/IR/RemoteSchema.hs @@ -160,10 +160,10 @@ data RemoteFieldArgument = RemoteFieldArgument } deriving (Eq, Show) -data RemoteSchemaSelect = RemoteSchemaSelect +data RemoteSchemaSelect r = RemoteSchemaSelect { _rselArgs :: [RemoteFieldArgument], _rselResultCustomizer :: ResultCustomizer, - _rselSelection :: SelectionSet Void RemoteSchemaVariable, + _rselSelection :: SelectionSet r RemoteSchemaVariable, _rselFieldCall :: NonEmpty FieldCall, _rselRemoteSchema :: RemoteSchemaInfo } diff --git a/server/src-lib/Hasura/RQL/IR/Root.hs b/server/src-lib/Hasura/RQL/IR/Root.hs index 430842a1e97..0380cc76fa8 100644 --- a/server/src-lib/Hasura/RQL/IR/Root.hs +++ b/server/src-lib/Hasura/RQL/IR/Root.hs @@ -73,7 +73,7 @@ newtype MutationDBRoot r v b = MDBR (MutationDB b r (v b)) -- either a remote schema or a database's table. See RemoteSourceSelect for -- explanation on 'vf'. data RemoteRelationshipField vf - = RemoteSchemaField RemoteSchemaSelect + = RemoteSchemaField (RemoteSchemaSelect (RemoteRelationshipField vf)) | -- | AnyBackend is used here to capture a relationship to an arbitrary target RemoteSourceField (AB.AnyBackend (RemoteSourceSelect (RemoteRelationshipField vf) vf)) @@ -88,14 +88,14 @@ type MutationActionRoot v = type QueryRootField v = RootField (QueryDBRoot (RemoteRelationshipField v) v) - (RemoteSchemaRootField Void RQL.RemoteSchemaVariable) + (RemoteSchemaRootField (RemoteRelationshipField v) RQL.RemoteSchemaVariable) (QueryActionRoot v) JO.Value type MutationRootField v = RootField (MutationDBRoot (RemoteRelationshipField v) v) - (RemoteSchemaRootField Void RQL.RemoteSchemaVariable) + (RemoteSchemaRootField (RemoteRelationshipField v) RQL.RemoteSchemaVariable) (MutationActionRoot v) JO.Value diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index e95882bbaf3..cc10ac4bcd0 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -129,6 +129,7 @@ import Hasura.Base.Error import Hasura.GraphQL.Context (GQLContext, RoleContext) import Hasura.GraphQL.Namespace import Hasura.GraphQL.Parser qualified as P +import Hasura.GraphQL.Parser.Column (UnpreparedValue) import Hasura.Incremental ( Cacheable, Dependency, @@ -139,6 +140,7 @@ import Hasura.Prelude import Hasura.RQL.DDL.Webhook.Transform import Hasura.RQL.IR.BoolExp import Hasura.RQL.IR.RemoteSchema +import Hasura.RQL.IR.Root import Hasura.RQL.Types.Action import Hasura.RQL.Types.Allowlist import Hasura.RQL.Types.ApiLimit @@ -227,9 +229,9 @@ data IntrospectionResult = IntrospectionResult instance Cacheable IntrospectionResult data ParsedIntrospectionG m = ParsedIntrospection - { piQuery :: [P.FieldParser m (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))], - piMutation :: Maybe [P.FieldParser m (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))], - piSubscription :: Maybe [P.FieldParser m (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))] + { piQuery :: [P.FieldParser m (NamespacedField (RemoteSchemaRootField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))], + piMutation :: Maybe [P.FieldParser m (NamespacedField (RemoteSchemaRootField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))], + piSubscription :: Maybe [P.FieldParser m (NamespacedField (RemoteSchemaRootField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))] } type ParsedIntrospection = ParsedIntrospectionG (P.ParseT Identity) diff --git a/server/src-test/Hasura/GraphQL/Schema/RemoteTest.hs b/server/src-test/Hasura/GraphQL/Schema/RemoteTest.hs index 151f41200b6..6168b894adc 100644 --- a/server/src-test/Hasura/GraphQL/Schema/RemoteTest.hs +++ b/server/src-test/Hasura/GraphQL/Schema/RemoteTest.hs @@ -12,15 +12,20 @@ import Hasura.GraphQL.Execute.Inline import Hasura.GraphQL.Execute.Remote (resolveRemoteVariable, runVariableCache) import Hasura.GraphQL.Execute.Resolve import Hasura.GraphQL.Namespace +import Hasura.GraphQL.Parser.Column (UnpreparedValue) import Hasura.GraphQL.Parser.Internal.Parser qualified as P import Hasura.GraphQL.Parser.Schema import Hasura.GraphQL.Parser.TestUtils import Hasura.GraphQL.RemoteServer (identityCustomizer) +import Hasura.GraphQL.Schema.Common import Hasura.GraphQL.Schema.Remote import Hasura.Prelude import Hasura.RQL.IR.RemoteSchema +import Hasura.RQL.IR.Root import Hasura.RQL.Types.RemoteSchema import Hasura.RQL.Types.SchemaCache +import Hasura.RQL.Types.Source +import Hasura.RQL.Types.SourceCustomization import Hasura.Session import Language.GraphQL.Draft.Parser qualified as G import Language.GraphQL.Draft.Syntax qualified as G @@ -98,16 +103,26 @@ mkTestVariableValues vars = runIdentity $ buildQueryParsers :: RemoteSchemaIntrospection -> - IO (P.FieldParser TestMonad (G.Field G.NoFragments RemoteSchemaVariable)) + IO (P.FieldParser TestMonad (GraphQLField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)) buildQueryParsers introspection = do let introResult = IntrospectionResult introspection $$(G.litName "Query") Nothing Nothing + remoteSchemaInfo = RemoteSchemaInfo (ValidatedRemoteSchemaDef N.nullURI [] False 60 Nothing) identityCustomizer + sourceContext = + -- without relationships to sources, this won't be evaluated + ( adminRoleName :: RoleName, + mempty :: SourceCache, + undefined :: QueryContext, + mempty :: CustomizeRemoteFieldName, + mempty :: RemoteSchemaMap, + mempty :: MkTypename, + mempty :: MkRootFieldName + ) ParsedIntrospection query _ _ <- runError $ - buildRemoteParser introResult $ - RemoteSchemaInfo (ValidatedRemoteSchemaDef N.nullURI [] False 60 Nothing) identityCustomizer + buildRemoteParser introResult remoteSchemaInfo pure $ head query <&> \case - NotNamespaced remoteFld -> convertGraphQLField $ _rfField remoteFld + NotNamespaced remoteFld -> _rfField remoteFld Namespaced _ -> -- Shouldn't happen if we're using identityCustomizer -- TODO: add some tests for remote schema customization @@ -132,7 +147,7 @@ run :: Text -> -- | variables LBS.ByteString -> - IO (G.Field G.NoFragments RemoteSchemaVariable) + IO (GraphQLField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable) run schema query variables = do parser <- buildQueryParsers $ mkTestRemoteSchema schema pure $ @@ -192,7 +207,7 @@ query($a: A!) { } } |] - let arg = head $ M.toList $ G._fArguments field + let arg = head $ M.toList $ _fArguments field arg `shouldBe` ( $$(G.litName "a"), -- the parser did not create a new JSON variable, and forwarded the query variable unmodified @@ -246,7 +261,7 @@ query($a: A) { } } |] - let arg = head $ M.toList $ G._fArguments field + let arg = head $ M.toList $ _fArguments field arg `shouldBe` ( $$(G.litName "a"), -- fieldOptional has peeled the variable; all we see is a JSON blob, and in doubt @@ -300,7 +315,7 @@ query($a: A!) { } } |] - let arg = head $ M.toList $ G._fArguments field + let arg = head $ M.toList $ _fArguments field arg `shouldBe` ( $$(G.litName "a"), -- the preset has caused partial variable expansion, only up to where it's needed @@ -333,7 +348,7 @@ testVariableSubstitutionCollision = it "ensures that remote variables are de-dup . traverse (resolveRemoteVariable dummyUserInfo) $ field let variableNames = - eField ^.. _Right . to G._fArguments . traverse . _VVariable . to vInfo . to getName . to G.unName + eField ^.. _Right . to _fArguments . traverse . _VVariable . to vInfo . to getName . to G.unName variableNames `shouldBe` ["hasura_json_var_1", "hasura_json_var_2"] where -- A schema whose values are representable as collections of JSON values.