mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-14 17:02:49 +03:00
Generalize remote schemas IR
### Description This PR is one further step towards remote joins from remote schemas. It introduces a custom partial AST to represent queries to remote schemas in the IR: we now need to augment what used to be a straightforward GraphQL AST with additional information for remote join fields. This PR does the minimal amount of work to adjust the rest of the code accordingly, using `Void` in all places that expect a type representing remote relationships. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3794 GitOrigin-RevId: 33fc317731aace71f82ad158a1951ea93350d6cc
This commit is contained in:
Antoine Leblanc
hasura-bot
parent
ecc9ffd070
commit
a1886b3729
@ -5,6 +5,7 @@ module Data.List.Extended
|
||||
getDifferenceOn,
|
||||
getOverlapWith,
|
||||
hasNoDuplicates,
|
||||
longestCommonPrefix,
|
||||
module L,
|
||||
)
|
||||
where
|
||||
@ -38,3 +39,16 @@ getOverlapWith getKey left right =
|
||||
|
||||
hasNoDuplicates :: (Eq a, Hashable a) => [a] -> Bool
|
||||
hasNoDuplicates xs = Set.size (Set.fromList xs) == length xs
|
||||
|
||||
-- | Returns the longest prefix common to all given lists. Returns an empty list on an empty list.
|
||||
--
|
||||
-- >>> longestCommonPrefix ["abcd", "abce", "abgh"]
|
||||
-- "ab"
|
||||
--
|
||||
-- >>> longestCommonPrefix []
|
||||
-- []
|
||||
longestCommonPrefix :: Eq a => [[a]] -> [a]
|
||||
longestCommonPrefix [] = []
|
||||
longestCommonPrefix (x : xs) = foldr prefix x xs
|
||||
where
|
||||
prefix l1 l2 = map fst $ takeWhile (uncurry (==)) $ zip l1 l2
|
||||
|
||||
@ -122,13 +122,13 @@ convertMutationSelectionSet
|
||||
exists
|
||||
\(SourceConfigWith (sourceConfig :: SourceConfig b) queryTagsConfig (MDBR db)) -> do
|
||||
let mutationQueryTagsAttributes = encodeQueryTags $ QTMutation $ MutationMetadata reqId maybeOperationName rootFieldName parameterizedQueryHash
|
||||
let queryTagsComment = Tagged.untag $ createQueryTags @m mutationQueryTagsAttributes queryTagsConfig
|
||||
let (noRelsDBAST, remoteJoins) = RJ.getRemoteJoinsMutationDB db
|
||||
queryTagsComment = Tagged.untag $ createQueryTags @m mutationQueryTagsAttributes queryTagsConfig
|
||||
(noRelsDBAST, remoteJoins) = RJ.getRemoteJoinsMutationDB db
|
||||
dbStepInfo <- flip runReaderT queryTagsComment $ mkDBMutationPlan @b userInfo stringifyNum sourceName sourceConfig noRelsDBAST
|
||||
pure $ ExecStepDB [] (AB.mkAnyBackend dbStepInfo) remoteJoins
|
||||
RFRemote remoteField -> do
|
||||
RemoteFieldG remoteSchemaInfo resultCustomizer resolvedRemoteField <- runVariableCache $ resolveRemoteField userInfo remoteField
|
||||
pure $ buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeMutation [G.SelectionField resolvedRemoteField] (GH._grOperationName gqlUnparsed)
|
||||
RemoteSchemaRootField remoteSchemaInfo resultCustomizer resolvedRemoteField <- runVariableCache $ resolveRemoteField userInfo remoteField
|
||||
pure $ buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeMutation [G.SelectionField $ convertGraphQLField resolvedRemoteField] (GH._grOperationName gqlUnparsed)
|
||||
RFAction action -> do
|
||||
let (noRelsDBAST, remoteJoins) = RJ.getRemoteJoinsActionMutation action
|
||||
(actionName, _fch) <- pure $ case noRelsDBAST of
|
||||
|
||||
@ -108,13 +108,13 @@ convertQuerySelSet
|
||||
exists
|
||||
\(SourceConfigWith (sourceConfig :: (SourceConfig b)) queryTagsConfig (QDBR db)) -> do
|
||||
let queryTagsAttributes = encodeQueryTags $ QTQuery $ QueryMetadata reqId maybeOperationName rootFieldName parameterizedQueryHash
|
||||
let queryTagsComment = Tagged.untag $ createQueryTags @m queryTagsAttributes queryTagsConfig
|
||||
let (noRelsDBAST, remoteJoins) = RJ.getRemoteJoins db
|
||||
queryTagsComment = Tagged.untag $ createQueryTags @m queryTagsAttributes queryTagsConfig
|
||||
(noRelsDBAST, remoteJoins) = RJ.getRemoteJoins db
|
||||
dbStepInfo <- flip runReaderT queryTagsComment $ mkDBQueryPlan @b userInfo sourceName sourceConfig noRelsDBAST
|
||||
pure $ ExecStepDB [] (AB.mkAnyBackend dbStepInfo) remoteJoins
|
||||
RFRemote rf -> do
|
||||
RemoteFieldG remoteSchemaInfo resultCustomizer remoteField <- runVariableCache $ for rf $ resolveRemoteVariable userInfo
|
||||
pure $ buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeQuery [G.SelectionField remoteField] (GH._grOperationName gqlUnparsed)
|
||||
RemoteSchemaRootField remoteSchemaInfo resultCustomizer remoteField <- runVariableCache $ for rf $ resolveRemoteVariable userInfo
|
||||
pure $ buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeQuery [G.SelectionField $ convertGraphQLField remoteField] (GH._grOperationName gqlUnparsed)
|
||||
RFAction action -> do
|
||||
let (noRelsDBAST, remoteJoins) = RJ.getRemoteJoinsActionQuery action
|
||||
(actionExecution, actionName, fch) <- pure $ case noRelsDBAST of
|
||||
|
||||
@ -21,6 +21,7 @@ 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.Types
|
||||
import Hasura.Session
|
||||
import Language.GraphQL.Draft.Syntax qualified as G
|
||||
@ -222,8 +223,8 @@ resolveRemoteVariable userInfo = \case
|
||||
resolveRemoteField ::
|
||||
(MonadError QErr m) =>
|
||||
UserInfo ->
|
||||
RemoteFieldG RemoteSchemaVariable ->
|
||||
StateT RemoteJSONVariableMap m (RemoteFieldG Variable)
|
||||
RemoteSchemaRootField Void RemoteSchemaVariable ->
|
||||
StateT RemoteJSONVariableMap m (RemoteSchemaRootField Void Variable)
|
||||
resolveRemoteField userInfo = traverse (resolveRemoteVariable userInfo)
|
||||
|
||||
-- | TODO: Documentation.
|
||||
|
||||
@ -281,7 +281,7 @@ createRemoteJoin joinColumnAliases remoteRelationship =
|
||||
RemoteSchemaJoin
|
||||
(inputArgsToMap _rselArgs)
|
||||
_rselResultCustomizer
|
||||
_rselSelection
|
||||
(convertSelectionSet _rselSelection)
|
||||
joinColumnAliases
|
||||
_rselFieldCall
|
||||
_rselRemoteSchema
|
||||
|
||||
@ -232,12 +232,12 @@ buildRoleContext
|
||||
where
|
||||
getQueryRemotes ::
|
||||
[ParsedIntrospection] ->
|
||||
[P.FieldParser (P.ParseT Identity) (NamespacedField RemoteField)]
|
||||
[P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))]
|
||||
getQueryRemotes = concatMap piQuery
|
||||
|
||||
getMutationRemotes ::
|
||||
[ParsedIntrospection] ->
|
||||
[P.FieldParser (P.ParseT Identity) (NamespacedField RemoteField)]
|
||||
[P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))]
|
||||
getMutationRemotes = concatMap (concat . piMutation)
|
||||
|
||||
buildSource ::
|
||||
@ -418,8 +418,8 @@ unauthenticatedContext ::
|
||||
( MonadError QErr m,
|
||||
MonadIO m
|
||||
) =>
|
||||
[P.FieldParser (P.ParseT Identity) (NamespacedField RemoteField)] ->
|
||||
[P.FieldParser (P.ParseT Identity) (NamespacedField RemoteField)] ->
|
||||
[P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))] ->
|
||||
[P.FieldParser (P.ParseT Identity) (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))] ->
|
||||
RemoteSchemaPermsCtx ->
|
||||
m GQLContext
|
||||
unauthenticatedContext adminQueryRemotes adminMutationRemotes remoteSchemaPermsCtx = P.runSchemaT $ do
|
||||
@ -602,7 +602,7 @@ buildQueryParser ::
|
||||
Has CustomizeRemoteFieldName r
|
||||
) =>
|
||||
[P.FieldParser n (NamespacedField (QueryRootField UnpreparedValue))] ->
|
||||
[P.FieldParser n (NamespacedField RemoteField)] ->
|
||||
[P.FieldParser n (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))] ->
|
||||
[ActionInfo] ->
|
||||
AnnotatedCustomTypes ->
|
||||
Maybe (Parser 'Output n (RootFieldMap (MutationRootField UnpreparedValue))) ->
|
||||
@ -700,7 +700,7 @@ buildMutationParser ::
|
||||
Has MkRootFieldName r,
|
||||
Has CustomizeRemoteFieldName r
|
||||
) =>
|
||||
[P.FieldParser n (NamespacedField RemoteField)] ->
|
||||
[P.FieldParser n (NamespacedField (RemoteSchemaRootField Void RemoteSchemaVariable))] ->
|
||||
[ActionInfo] ->
|
||||
AnnotatedCustomTypes ->
|
||||
[P.FieldParser n (NamespacedField (MutationRootField UnpreparedValue))] ->
|
||||
|
||||
@ -12,7 +12,7 @@ where
|
||||
import Data.Has
|
||||
import Data.HashMap.Strict qualified as Map
|
||||
import Data.HashMap.Strict.InsOrd qualified as OMap
|
||||
import Data.HashMap.Strict.InsOrd.Extended qualified as OMap
|
||||
import Data.HashSet qualified as Set
|
||||
import Data.List.NonEmpty qualified as NE
|
||||
import Data.Monoid (Any (..))
|
||||
import Data.Text.Extended
|
||||
@ -23,6 +23,7 @@ import Hasura.GraphQL.Parser as P
|
||||
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.Types.RemoteSchema
|
||||
import Hasura.RQL.Types.ResultCustomization
|
||||
import Hasura.RQL.Types.SchemaCache (IntrospectionResult (IntrospectionResult, irMutationRoot, irQueryRoot, irSubscriptionRoot), ParsedIntrospectionG (..))
|
||||
@ -49,17 +50,27 @@ buildRemoteParser introspectionResult remoteSchemaInfo@RemoteSchemaInfo {..} = d
|
||||
(customizeRemoteNamespace remoteSchemaInfo <$> irMutationRoot introspectionResult <*> rawMutationParsers)
|
||||
(customizeRemoteNamespace remoteSchemaInfo <$> irSubscriptionRoot introspectionResult <*> rawSubscriptionParsers)
|
||||
|
||||
makeResultCustomizer :: RemoteSchemaCustomizer -> G.Field G.NoFragments a -> ResultCustomizer
|
||||
makeResultCustomizer remoteSchemaCustomizer G.Field {..} =
|
||||
modifyFieldByName (fromMaybe _fName _fAlias) $
|
||||
makeResultCustomizer ::
|
||||
RemoteSchemaCustomizer ->
|
||||
IR.GraphQLField Void RemoteSchemaVariable ->
|
||||
ResultCustomizer
|
||||
makeResultCustomizer remoteSchemaCustomizer IR.GraphQLField {..} =
|
||||
modifyFieldByName _fAlias $
|
||||
if _fName == $$(G.litName "__typename")
|
||||
then customizeTypeNameString (_rscCustomizeTypeName remoteSchemaCustomizer)
|
||||
else foldMap resultCustomizerFromSelection _fSelectionSet
|
||||
else resultCustomizerFromSelection _fSelectionSet
|
||||
where
|
||||
resultCustomizerFromSelection :: G.Selection G.NoFragments a -> ResultCustomizer
|
||||
resultCustomizerFromSelection ::
|
||||
IR.SelectionSet Void RemoteSchemaVariable -> ResultCustomizer
|
||||
resultCustomizerFromSelection = \case
|
||||
G.SelectionField fld -> makeResultCustomizer remoteSchemaCustomizer fld
|
||||
G.SelectionInlineFragment G.InlineFragment {..} -> foldMap resultCustomizerFromSelection _ifSelectionSet
|
||||
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 = \case
|
||||
IR.FieldGraphQL f -> makeResultCustomizer remoteSchemaCustomizer f
|
||||
|
||||
buildRawRemoteParser ::
|
||||
forall r m n.
|
||||
@ -68,9 +79,9 @@ buildRawRemoteParser ::
|
||||
RemoteSchemaInfo ->
|
||||
-- | parsers for, respectively: queries, mutations, and subscriptions
|
||||
m
|
||||
( [P.FieldParser n RemoteField],
|
||||
Maybe [P.FieldParser n RemoteField],
|
||||
Maybe [P.FieldParser n RemoteField]
|
||||
( [P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)],
|
||||
Maybe [P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)],
|
||||
Maybe [P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)]
|
||||
)
|
||||
buildRawRemoteParser (IntrospectionResult sdoc queryRoot mutationRoot subscriptionRoot) info = do
|
||||
queryT <- makeParsers queryRoot
|
||||
@ -78,21 +89,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 RemoteField)
|
||||
makeFieldParser :: G.Name -> G.FieldDefinition RemoteSchemaInputValueDefinition -> m (P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable))
|
||||
makeFieldParser rootTypeName fieldDef =
|
||||
fmap makeRemoteField <$> remoteFieldFromDefinition sdoc rootTypeName fieldDef
|
||||
|
||||
makeRemoteField :: G.Field G.NoFragments RemoteSchemaVariable -> RemoteField
|
||||
makeRemoteField fld = RemoteFieldG info (makeResultCustomizer (rsCustomizer info) fld) fld
|
||||
makeRemoteField :: IR.GraphQLField Void RemoteSchemaVariable -> (IR.RemoteSchemaRootField Void RemoteSchemaVariable)
|
||||
makeRemoteField fld = IR.RemoteSchemaRootField info (makeResultCustomizer (rsCustomizer info) fld) fld
|
||||
|
||||
makeParsers :: G.Name -> m [P.FieldParser n RemoteField]
|
||||
makeParsers :: G.Name -> m [P.FieldParser n (IR.RemoteSchemaRootField Void 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 RemoteField])
|
||||
makeNonQueryRootFieldParser :: Maybe G.Name -> G.Name -> m (Maybe [P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)])
|
||||
makeNonQueryRootFieldParser userProvidedRootName defaultRootName =
|
||||
case userProvidedRootName of
|
||||
Just _rootName -> traverse makeParsers userProvidedRootName
|
||||
@ -539,7 +550,7 @@ remoteSchemaObject ::
|
||||
MonadBuildRemoteSchema r m n =>
|
||||
RemoteSchemaIntrospection ->
|
||||
G.ObjectTypeDefinition RemoteSchemaInputValueDefinition ->
|
||||
m (Parser 'Output n [G.Field G.NoFragments RemoteSchemaVariable])
|
||||
m (Parser 'Output n (IR.ObjectSelectionSet Void RemoteSchemaVariable))
|
||||
remoteSchemaObject schemaDoc defn@(G.ObjectTypeDefinition description name interfaces _directives subFields) =
|
||||
P.memoizeOn 'remoteSchemaObject defn do
|
||||
subFieldParsers <- traverse (remoteFieldFromDefinition schemaDoc name) subFields
|
||||
@ -548,13 +559,13 @@ remoteSchemaObject schemaDoc defn@(G.ObjectTypeDefinition description name inter
|
||||
-- TODO: also check sub-interfaces, when these are supported in a future graphql spec
|
||||
traverse_ validateImplementsFields interfaceDefs
|
||||
typename <- mkTypename name
|
||||
let allFields = map (fmap IR.FieldGraphQL) subFieldParsers -- <> map (fmap IR.FieldRemote) remoteJoinParsers
|
||||
pure $
|
||||
P.selectionSetObject typename description subFieldParsers implements
|
||||
<&> toList
|
||||
. OMap.mapWithKey
|
||||
( \alias -> handleTypename $ \_ ->
|
||||
G.Field (Just alias) $$(G.litName "__typename") mempty mempty mempty
|
||||
)
|
||||
P.selectionSetObject typename description allFields implements
|
||||
<&> OMap.mapWithKey \alias ->
|
||||
handleTypename $
|
||||
const $
|
||||
IR.FieldGraphQL $ IR.mkGraphQLField (Just alias) $$(G.litName "__typename") mempty mempty IR.SelectionSetNone
|
||||
where
|
||||
getInterface :: G.Name -> m (G.InterfaceTypeDefinition [G.Name] RemoteSchemaInputValueDefinition)
|
||||
getInterface interfaceName =
|
||||
@ -719,7 +730,7 @@ remoteSchemaInterface ::
|
||||
MonadBuildRemoteSchema r m n =>
|
||||
RemoteSchemaIntrospection ->
|
||||
G.InterfaceTypeDefinition [G.Name] RemoteSchemaInputValueDefinition ->
|
||||
m (Parser 'Output n (G.SelectionSet G.NoFragments RemoteSchemaVariable))
|
||||
m (Parser 'Output n (IR.DeduplicatedSelectionSet Void RemoteSchemaVariable))
|
||||
remoteSchemaInterface schemaDoc defn@(G.InterfaceTypeDefinition description name _directives fields possibleTypes) =
|
||||
P.memoizeOn 'remoteSchemaObject defn do
|
||||
subFieldParsers <- traverse (remoteFieldFromDefinition schemaDoc name) fields
|
||||
@ -734,7 +745,9 @@ remoteSchemaInterface schemaDoc defn@(G.InterfaceTypeDefinition description name
|
||||
-- should have a check that expresses that that collection of objects is equal
|
||||
-- to 'possibleTypes'.
|
||||
typename <- mkTypename name
|
||||
pure $ P.selectionSetInterface typename description subFieldParsers objs <&> constructInterfaceSelectionSet
|
||||
pure $
|
||||
P.selectionSetInterface typename description subFieldParsers objs
|
||||
<&> IR.mkInterfaceSelectionSet (Set.fromList $ map G._fldName fields)
|
||||
where
|
||||
getObject :: G.Name -> m (G.ObjectTypeDefinition RemoteSchemaInputValueDefinition)
|
||||
getObject objectName =
|
||||
@ -751,77 +764,20 @@ remoteSchemaInterface schemaDoc defn@(G.InterfaceTypeDefinition description name
|
||||
<> " can only include object types. It cannot include "
|
||||
<> squote objectName
|
||||
|
||||
-- 'constructInterfaceQuery' constructs a remote interface query.
|
||||
constructInterfaceSelectionSet ::
|
||||
[(G.Name, [G.Field G.NoFragments RemoteSchemaVariable])] ->
|
||||
G.SelectionSet G.NoFragments RemoteSchemaVariable
|
||||
constructInterfaceSelectionSet objNameAndFields =
|
||||
let -- common interface fields that exist in every
|
||||
-- selection set provided
|
||||
-- #1 of Note [Querying remote schema Interfaces]
|
||||
commonInterfaceFields =
|
||||
OMap.elems $
|
||||
OMap.mapMaybe (allTheSame . toList) $
|
||||
OMap.groupListWith G._fName $
|
||||
concatMap (filter ((`elem` interfaceFieldNames) . G._fName) . snd) $
|
||||
objNameAndFields
|
||||
|
||||
interfaceFieldNames = map G._fldName fields
|
||||
|
||||
allTheSame (x : xs) | all (== x) xs = Just x
|
||||
allTheSame _ = Nothing
|
||||
|
||||
-- #2 of Note [Querying remote schema interface fields]
|
||||
nonCommonInterfaceFields =
|
||||
catMaybes $
|
||||
flip map objNameAndFields $ \(objName, objFields) ->
|
||||
let nonCommonFields = filter (not . flip elem commonInterfaceFields) objFields
|
||||
in mkObjInlineFragment (objName, map G.SelectionField nonCommonFields)
|
||||
|
||||
-- helper function for #4 of Note [Querying remote schema interface fields]
|
||||
mkObjInlineFragment (_, []) = Nothing
|
||||
mkObjInlineFragment (objName, selSet) =
|
||||
Just $
|
||||
G.SelectionInlineFragment $
|
||||
G.InlineFragment (Just objName) mempty selSet
|
||||
in -- #5 of Note [Querying remote schema interface fields]
|
||||
fmap G.SelectionField commonInterfaceFields <> nonCommonInterfaceFields
|
||||
|
||||
-- | 'remoteSchemaUnion' returns a output parser for a given 'UnionTypeDefinition'.
|
||||
remoteSchemaUnion ::
|
||||
forall r m n.
|
||||
MonadBuildRemoteSchema r m n =>
|
||||
RemoteSchemaIntrospection ->
|
||||
G.UnionTypeDefinition ->
|
||||
m (Parser 'Output n (G.SelectionSet G.NoFragments RemoteSchemaVariable))
|
||||
m (Parser 'Output n (IR.DeduplicatedSelectionSet Void RemoteSchemaVariable))
|
||||
remoteSchemaUnion schemaDoc defn@(G.UnionTypeDefinition description name _directives objectNames) =
|
||||
P.memoizeOn 'remoteSchemaObject defn do
|
||||
objs <- traverse (getObjectParser schemaDoc getObject) objectNames
|
||||
when (null objs) $
|
||||
throw400 RemoteSchemaError $ "List of member types cannot be empty for union type " <> squote name
|
||||
typename <- mkTypename name
|
||||
pure $
|
||||
P.selectionSetUnion typename description objs
|
||||
<&> ( \objNameAndFields ->
|
||||
catMaybes $
|
||||
objNameAndFields <&> \(objName, fields) ->
|
||||
case fields of
|
||||
-- The return value obtained from the parsing of a union selection set
|
||||
-- specifies, for each object in the union type, a fragment-free
|
||||
-- selection set for that object type. In particular, if, for a given
|
||||
-- object type, the selection set passed to the union type did not
|
||||
-- specify any fields for that object type (i.e. if no inline fragment
|
||||
-- applied to that object), the selection set resulting from the parsing
|
||||
-- through that object type would be empty, i.e. []. We exclude such
|
||||
-- object types from the reconstructed selection set for the union
|
||||
-- type, as selection sets cannot be empty.
|
||||
[] -> Nothing
|
||||
_ ->
|
||||
Just
|
||||
( G.SelectionInlineFragment $
|
||||
G.InlineFragment (Just objName) mempty $ fmap G.SelectionField fields
|
||||
)
|
||||
)
|
||||
pure $ P.selectionSetUnion typename description objs <&> IR.mkUnionSelectionSet
|
||||
where
|
||||
getObject :: G.Name -> m (G.ObjectTypeDefinition RemoteSchemaInputValueDefinition)
|
||||
getObject objectName =
|
||||
@ -844,29 +800,31 @@ remoteFieldFromDefinition ::
|
||||
RemoteSchemaIntrospection ->
|
||||
G.Name ->
|
||||
G.FieldDefinition RemoteSchemaInputValueDefinition ->
|
||||
m (FieldParser n (G.Field G.NoFragments RemoteSchemaVariable))
|
||||
remoteFieldFromDefinition schemaDoc parentTypeName (G.FieldDefinition description name argsDefinition gType _) = do
|
||||
let addNullableList :: FieldParser n a -> FieldParser n a
|
||||
addNullableList (P.FieldParser (Definition name' desc (FieldInfo args typ)) parser) =
|
||||
P.FieldParser (Definition name' desc (FieldInfo args (TList Nullable typ))) parser
|
||||
|
||||
addNonNullableList :: FieldParser n a -> FieldParser n a
|
||||
addNonNullableList (P.FieldParser (Definition name' desc (FieldInfo args typ)) parser) =
|
||||
P.FieldParser (Definition name' desc (FieldInfo args (TList NonNullable typ))) parser
|
||||
|
||||
-- TODO add directives, deprecation
|
||||
convertType :: G.GType -> m (FieldParser n (G.Field G.NoFragments RemoteSchemaVariable))
|
||||
convertType gType' = do
|
||||
case gType' of
|
||||
G.TypeNamed (G.Nullability True) fieldTypeName ->
|
||||
P.nullableField <$> remoteFieldFromName schemaDoc parentTypeName name description fieldTypeName argsDefinition
|
||||
G.TypeList (G.Nullability True) gType'' ->
|
||||
addNullableList <$> convertType gType''
|
||||
G.TypeNamed (G.Nullability False) fieldTypeName -> do
|
||||
P.nonNullableField <$> remoteFieldFromName schemaDoc parentTypeName name description fieldTypeName argsDefinition
|
||||
G.TypeList (G.Nullability False) gType'' ->
|
||||
addNonNullableList <$> convertType gType''
|
||||
m (FieldParser n (IR.GraphQLField Void RemoteSchemaVariable))
|
||||
remoteFieldFromDefinition schemaDoc parentTypeName (G.FieldDefinition description name argsDefinition gType _) =
|
||||
convertType gType
|
||||
where
|
||||
addNullableList :: FieldParser n a -> FieldParser n a
|
||||
addNullableList (P.FieldParser (Definition name' desc (FieldInfo args typ)) parser) =
|
||||
P.FieldParser (Definition name' desc (FieldInfo args (TList Nullable typ))) parser
|
||||
|
||||
addNonNullableList :: FieldParser n a -> FieldParser n a
|
||||
addNonNullableList (P.FieldParser (Definition name' desc (FieldInfo args typ)) parser) =
|
||||
P.FieldParser (Definition name' desc (FieldInfo args (TList NonNullable typ))) parser
|
||||
|
||||
-- TODO add directives, deprecation
|
||||
convertType ::
|
||||
G.GType ->
|
||||
m (FieldParser n (IR.GraphQLField Void RemoteSchemaVariable))
|
||||
convertType = \case
|
||||
G.TypeNamed (G.Nullability True) fieldTypeName ->
|
||||
P.nullableField <$> remoteFieldFromName schemaDoc parentTypeName name description fieldTypeName argsDefinition
|
||||
G.TypeList (G.Nullability True) gType' ->
|
||||
addNullableList <$> convertType gType'
|
||||
G.TypeNamed (G.Nullability False) fieldTypeName -> do
|
||||
P.nonNullableField <$> remoteFieldFromName schemaDoc parentTypeName name description fieldTypeName argsDefinition
|
||||
G.TypeList (G.Nullability False) gType' ->
|
||||
addNonNullableList <$> convertType gType'
|
||||
|
||||
-- | 'remoteFieldFromName' accepts a GraphQL name and searches for its definition
|
||||
-- in the 'RemoteSchemaIntrospection'.
|
||||
@ -879,7 +837,7 @@ remoteFieldFromName ::
|
||||
Maybe G.Description ->
|
||||
G.Name ->
|
||||
G.ArgumentsDefinition RemoteSchemaInputValueDefinition ->
|
||||
m (FieldParser n (G.Field G.NoFragments RemoteSchemaVariable))
|
||||
m (FieldParser n (IR.GraphQLField Void RemoteSchemaVariable))
|
||||
remoteFieldFromName sdoc parentTypeName fieldName description fieldTypeName argsDefns =
|
||||
case lookupType sdoc fieldTypeName of
|
||||
Nothing -> throw400 RemoteSchemaError $ "Could not find type with name " <>> fieldTypeName
|
||||
@ -897,7 +855,7 @@ remoteField ::
|
||||
Maybe G.Description ->
|
||||
G.ArgumentsDefinition RemoteSchemaInputValueDefinition ->
|
||||
G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition ->
|
||||
m (FieldParser n (G.Field G.NoFragments RemoteSchemaVariable))
|
||||
m (FieldParser n (IR.GraphQLField Void RemoteSchemaVariable))
|
||||
remoteField sdoc parentTypeName fieldName description argsDefn typeDefn = do
|
||||
-- TODO add directives
|
||||
argsParser <- argumentsParser argsDefn sdoc
|
||||
@ -908,44 +866,46 @@ remoteField sdoc parentTypeName fieldName description argsDefn typeDefn = do
|
||||
G.TypeDefinitionObject objTypeDefn -> do
|
||||
remoteSchemaObjFields <- remoteSchemaObject sdoc objTypeDefn
|
||||
-- converting [Field NoFragments Name] to (SelectionSet NoFragments G.Name)
|
||||
let remoteSchemaObjSelSet = fmap G.SelectionField <$> remoteSchemaObjFields
|
||||
let remoteSchemaObjSelSet = IR.SelectionSetObject <$> remoteSchemaObjFields
|
||||
pure remoteSchemaObjSelSet <&> mkFieldParserWithSelectionSet customizedFieldName argsParser
|
||||
G.TypeDefinitionScalar scalarTypeDefn ->
|
||||
pure $ mkFieldParserWithoutSelectionSet customizedFieldName argsParser $ void $ remoteFieldScalarParser customizeTypename scalarTypeDefn
|
||||
G.TypeDefinitionEnum enumTypeDefn ->
|
||||
pure $ mkFieldParserWithoutSelectionSet customizedFieldName argsParser $ void $ remoteFieldEnumParser customizeTypename enumTypeDefn
|
||||
G.TypeDefinitionInterface ifaceTypeDefn ->
|
||||
remoteSchemaInterface sdoc ifaceTypeDefn <&> mkFieldParserWithSelectionSet customizedFieldName argsParser
|
||||
remoteSchemaInterface sdoc ifaceTypeDefn
|
||||
<&> (mkFieldParserWithSelectionSet customizedFieldName argsParser . fmap IR.SelectionSetInterface)
|
||||
G.TypeDefinitionUnion unionTypeDefn ->
|
||||
remoteSchemaUnion sdoc unionTypeDefn <&> mkFieldParserWithSelectionSet customizedFieldName argsParser
|
||||
remoteSchemaUnion sdoc unionTypeDefn
|
||||
<&> (mkFieldParserWithSelectionSet customizedFieldName argsParser . fmap IR.SelectionSetUnion)
|
||||
_ -> throw400 RemoteSchemaError "expected output type, but got input type"
|
||||
where
|
||||
mkField ::
|
||||
Maybe G.Name ->
|
||||
G.Name ->
|
||||
HashMap G.Name (G.Value RemoteSchemaVariable) ->
|
||||
G.SelectionSet G.NoFragments RemoteSchemaVariable ->
|
||||
G.Field G.NoFragments RemoteSchemaVariable
|
||||
IR.SelectionSet Void RemoteSchemaVariable ->
|
||||
IR.GraphQLField Void 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.
|
||||
let alias' = alias <|> guard (customizedFieldName /= fieldName) *> Just customizedFieldName
|
||||
in G.Field alias' fieldName args mempty selSet
|
||||
in IR.mkGraphQLField alias' fieldName args mempty selSet
|
||||
|
||||
mkFieldParserWithoutSelectionSet ::
|
||||
G.Name ->
|
||||
InputFieldsParser n (Altered, HashMap G.Name (G.Value RemoteSchemaVariable)) ->
|
||||
Parser 'Both n () ->
|
||||
FieldParser n (G.Field G.NoFragments RemoteSchemaVariable)
|
||||
FieldParser n (IR.GraphQLField Void RemoteSchemaVariable)
|
||||
mkFieldParserWithoutSelectionSet customizedFieldName argsParser outputParser =
|
||||
P.rawSelection customizedFieldName description argsParser outputParser
|
||||
<&> \(alias, _, (_, args)) -> mkField alias customizedFieldName args []
|
||||
<&> \(alias, _, (_, args)) -> mkField alias customizedFieldName args IR.SelectionSetNone
|
||||
|
||||
mkFieldParserWithSelectionSet ::
|
||||
G.Name ->
|
||||
InputFieldsParser n (Altered, HashMap G.Name (G.Value RemoteSchemaVariable)) ->
|
||||
Parser 'Output n (G.SelectionSet G.NoFragments RemoteSchemaVariable) ->
|
||||
FieldParser n (G.Field G.NoFragments RemoteSchemaVariable)
|
||||
Parser 'Output n (IR.SelectionSet Void RemoteSchemaVariable) ->
|
||||
FieldParser n (IR.GraphQLField Void RemoteSchemaVariable)
|
||||
mkFieldParserWithSelectionSet customizedFieldName argsParser outputParser =
|
||||
P.rawSubselection customizedFieldName description argsParser outputParser
|
||||
<&> \(alias, _, (_, args), selSet) -> mkField alias customizedFieldName args selSet
|
||||
@ -961,7 +921,7 @@ getObjectParser ::
|
||||
RemoteSchemaIntrospection ->
|
||||
(G.Name -> m (G.ObjectTypeDefinition RemoteSchemaInputValueDefinition)) ->
|
||||
G.Name ->
|
||||
m (Parser 'Output n (G.Name, [G.Field G.NoFragments RemoteSchemaVariable]))
|
||||
m (Parser 'Output n (G.Name, IR.ObjectSelectionSet Void RemoteSchemaVariable))
|
||||
getObjectParser schemaDoc getObject objName = do
|
||||
obj <- remoteSchemaObject schemaDoc =<< getObject objName
|
||||
return $ (objName,) <$> obj
|
||||
@ -971,8 +931,8 @@ customizeRemoteNamespace ::
|
||||
(MonadParse n) =>
|
||||
RemoteSchemaInfo ->
|
||||
G.Name ->
|
||||
[P.FieldParser n RemoteField] ->
|
||||
[P.FieldParser n (NamespacedField RemoteField)]
|
||||
[P.FieldParser n (IR.RemoteSchemaRootField Void RemoteSchemaVariable)] ->
|
||||
[P.FieldParser n (NamespacedField (IR.RemoteSchemaRootField Void RemoteSchemaVariable))]
|
||||
customizeRemoteNamespace remoteSchemaInfo@RemoteSchemaInfo {..} rootTypeName fieldParsers =
|
||||
customizeNamespace (_rscNamespaceFieldName rsCustomizer) fromParsedSelection mkNamespaceTypename fieldParsers
|
||||
where
|
||||
@ -980,7 +940,7 @@ customizeRemoteNamespace remoteSchemaInfo@RemoteSchemaInfo {..} rootTypeName fie
|
||||
handleTypename . const $
|
||||
-- In P.selectionSet we lose the resultCustomizer from __typename fields so we need to put it back
|
||||
let resultCustomizer = modifyFieldByName alias $ customizeTypeNameString $ _rscCustomizeTypeName rsCustomizer
|
||||
in RemoteFieldG remoteSchemaInfo resultCustomizer $ G.Field (Just alias) $$(G.litName "__typename") mempty mempty mempty
|
||||
in IR.RemoteSchemaRootField remoteSchemaInfo resultCustomizer $ IR.mkGraphQLField (Just alias) $$(G.litName "__typename") mempty mempty IR.SelectionSetNone
|
||||
mkNamespaceTypename = MkTypename $ const $ runMkTypename (remoteSchemaCustomizeTypeName rsCustomizer) rootTypeName
|
||||
|
||||
type MonadBuildRemoteSchema r m n = (MonadSchema n m, MonadError QErr m, MonadReader r m, Has MkTypename r, Has CustomizeRemoteFieldName r)
|
||||
|
||||
@ -115,7 +115,7 @@ remoteRelationshipToSchemaField lhsFields RemoteSchemaFieldInfo {..} = runMaybeT
|
||||
|
||||
pure $
|
||||
remoteFld
|
||||
`P.bindField` \fld@G.Field {G._fArguments = args, G._fSelectionSet = selSet, G._fName = fname} -> do
|
||||
`P.bindField` \fld@IR.GraphQLField {IR._fArguments = args, IR._fSelectionSet = selSet, IR._fName = fname} -> do
|
||||
let remoteArgs =
|
||||
Map.toList args <&> \(argName, argVal) -> IR.RemoteFieldArgument argName $ P.GraphQLValue argVal
|
||||
let resultCustomizer =
|
||||
|
||||
@ -238,7 +238,12 @@ runSessVarPred = filterSessionVariables . unSessVarPred
|
||||
-- | Filter out only those session variables used by the query AST provided
|
||||
filterVariablesFromQuery ::
|
||||
Backend backend =>
|
||||
[RootField (QueryDBRoot (RemoteRelationshipField UnpreparedValue) UnpreparedValue) RemoteField (ActionQuery backend (RemoteRelationshipField UnpreparedValue) (UnpreparedValue backend)) d] ->
|
||||
[ RootField
|
||||
(QueryDBRoot (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
|
||||
(RemoteSchemaRootField Void RemoteSchemaVariable)
|
||||
(ActionQuery backend (RemoteRelationshipField UnpreparedValue) (UnpreparedValue backend))
|
||||
d
|
||||
] ->
|
||||
SessVarPred
|
||||
filterVariablesFromQuery query = fold $ rootToSessVarPreds =<< query
|
||||
where
|
||||
|
||||
@ -15,10 +15,10 @@ import Hasura.RQL.Types.Column
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
data AnnDelG (b :: BackendType) (r :: Type) v = AnnDel
|
||||
{ dqp1Table :: !(TableName b),
|
||||
dqp1Where :: !(AnnBoolExp b v, AnnBoolExp b v),
|
||||
dqp1Output :: !(MutationOutputG b r v),
|
||||
dqp1AllCols :: ![ColumnInfo b]
|
||||
{ dqp1Table :: TableName b,
|
||||
dqp1Where :: (AnnBoolExp b v, AnnBoolExp b v),
|
||||
dqp1Output :: MutationOutputG b r v,
|
||||
dqp1AllCols :: [ColumnInfo b]
|
||||
}
|
||||
deriving (Functor, Foldable, Traversable)
|
||||
|
||||
|
||||
@ -1,26 +1,335 @@
|
||||
-- | Representation for queries going to remote schemas. Due to the existence of
|
||||
-- remote relationships from remote schemas, we can't simply reuse the GraphQL
|
||||
-- document AST we define in graphql-parser-hs, and instead redefine a custom
|
||||
-- structure to represent such queries.
|
||||
module Hasura.RQL.IR.RemoteSchema
|
||||
( RemoteFieldArgument (..),
|
||||
( -- AST
|
||||
SelectionSet (..),
|
||||
DeduplicatedSelectionSet (..),
|
||||
ObjectSelectionSet,
|
||||
mkInterfaceSelectionSet,
|
||||
mkUnionSelectionSet,
|
||||
Field (..),
|
||||
_FieldGraphQL,
|
||||
_FieldRemote,
|
||||
GraphQLField (..),
|
||||
mkGraphQLField,
|
||||
-- entry points
|
||||
RemoteSchemaRootField (..),
|
||||
SchemaRemoteRelationshipSelect (..),
|
||||
RemoteFieldArgument (..),
|
||||
RemoteSchemaSelect (..),
|
||||
-- AST conversion
|
||||
convertSelectionSet,
|
||||
convertGraphQLField,
|
||||
)
|
||||
where
|
||||
|
||||
import Hasura.GraphQL.Parser.Schema (InputValue)
|
||||
import Control.Lens.TH (makePrisms)
|
||||
import Data.HashMap.Strict qualified as Map
|
||||
import Data.HashMap.Strict.InsOrd.Extended qualified as OMap
|
||||
import Data.HashSet qualified as Set
|
||||
import Data.List.Extended (longestCommonPrefix)
|
||||
import Hasura.GraphQL.Parser.Schema as G (InputValue)
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.Types.Common (FieldName)
|
||||
import Hasura.RQL.Types.Relationships.ToSchema
|
||||
import Hasura.RQL.Types.RemoteSchema
|
||||
import Hasura.RQL.Types.RemoteSchema qualified as RQL
|
||||
import Hasura.RQL.Types.ResultCustomization
|
||||
import Hasura.RQL.Types.ResultCustomization qualified as RQL
|
||||
import Language.GraphQL.Draft.Syntax qualified as G
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Custom AST
|
||||
|
||||
-- | Custom representation of a selection set.
|
||||
--
|
||||
-- Similarly to other parts of the IR, the @r@ argument is used for remote
|
||||
-- relationships.
|
||||
data SelectionSet r var
|
||||
= SelectionSetObject !(ObjectSelectionSet r var)
|
||||
| SelectionSetUnion !(DeduplicatedSelectionSet r var)
|
||||
| SelectionSetInterface !(DeduplicatedSelectionSet r var)
|
||||
| SelectionSetNone
|
||||
deriving (Show, Eq, Functor, Foldable, Traversable)
|
||||
|
||||
-- | Representation of the normalized selection set of an interface/union type.
|
||||
--
|
||||
-- This representation is used to attempt to minimize the size of the GraphQL
|
||||
-- query that eventually gets sent to the GraphQL server by defining as many
|
||||
-- fields as possible on the abstract type.
|
||||
data DeduplicatedSelectionSet r var = DeduplicatedSelectionSet
|
||||
{ -- | Fields that aren't explicitly defined for member types
|
||||
_atssCommonFields :: !(Set.HashSet G.Name),
|
||||
-- | SelectionSets of individual member types
|
||||
_atssMemberSelectionSets :: !(Map.HashMap G.Name (ObjectSelectionSet r var))
|
||||
}
|
||||
deriving (Show, Eq, Functor, Foldable, Traversable, Generic)
|
||||
|
||||
type ObjectSelectionSet r var = OMap.InsOrdHashMap G.Name (Field r var)
|
||||
|
||||
-- | Constructs an 'InterfaceSelectionSet' from a set of interface fields and an
|
||||
-- association list of the fields. This function ensures that @__typename@ is
|
||||
-- present in the set of interface fields.
|
||||
mkInterfaceSelectionSet ::
|
||||
-- | Member fields of the interface
|
||||
Set.HashSet G.Name ->
|
||||
-- | Selection sets for all the member types
|
||||
[(G.Name, ObjectSelectionSet r var)] ->
|
||||
DeduplicatedSelectionSet r var
|
||||
mkInterfaceSelectionSet interfaceFields selectionSets =
|
||||
DeduplicatedSelectionSet
|
||||
(Set.insert $$(G.litName "__typename") interfaceFields)
|
||||
(Map.fromList selectionSets)
|
||||
|
||||
-- | Constructs an 'UnionSelectionSet' from a list of the fields, using a
|
||||
-- singleton set of @__typename@ for the set of common fields.
|
||||
mkUnionSelectionSet ::
|
||||
-- | Selection sets for all the member types
|
||||
[(G.Name, ObjectSelectionSet r var)] ->
|
||||
DeduplicatedSelectionSet r var
|
||||
mkUnionSelectionSet selectionSets =
|
||||
DeduplicatedSelectionSet
|
||||
(Set.singleton $$(G.litName "__typename"))
|
||||
(Map.fromList selectionSets)
|
||||
|
||||
-- | Representation of one individual field.
|
||||
--
|
||||
-- This particular type is the reason why we need a different representation
|
||||
-- from the one in 'graphql-parser-hs': we differentiate between selection
|
||||
-- fields that target the actual remote schema, and fields that, instead, are
|
||||
-- remote from it and need to be treated differently.
|
||||
data Field r var
|
||||
= FieldGraphQL !(GraphQLField r var)
|
||||
| FieldRemote !(SchemaRemoteRelationshipSelect r)
|
||||
deriving (Show, Eq, Functor, Foldable, Traversable)
|
||||
|
||||
-- | Normalized representation of a GraphQL field.
|
||||
--
|
||||
-- This type is almost identical to 'G.Field', except for the fact that the
|
||||
-- selection set is our annotated 'SelectionSet', instead of the original
|
||||
-- 'G.SelectionSet'. We use this type to represent the fields of a selection
|
||||
-- that do target the remote schema.
|
||||
data GraphQLField r var = GraphQLField
|
||||
{ _fAlias :: G.Name,
|
||||
_fName :: G.Name,
|
||||
_fArguments :: HashMap G.Name (G.Value var),
|
||||
_fDirectives :: [G.Directive var],
|
||||
_fSelectionSet :: SelectionSet r var
|
||||
}
|
||||
deriving (Show, Eq, Functor, Foldable, Traversable)
|
||||
|
||||
mkGraphQLField ::
|
||||
Maybe G.Name ->
|
||||
G.Name ->
|
||||
HashMap G.Name (G.Value var) ->
|
||||
[G.Directive var] ->
|
||||
SelectionSet r var ->
|
||||
GraphQLField r var
|
||||
mkGraphQLField alias name =
|
||||
GraphQLField (fromMaybe name alias) name
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Remote schema entry points
|
||||
|
||||
-- | Root entry point for a remote schema.
|
||||
data RemoteSchemaRootField r var = RemoteSchemaRootField
|
||||
{ _rfRemoteSchemaInfo :: RQL.RemoteSchemaInfo,
|
||||
_rfResultCustomizer :: RQL.ResultCustomizer,
|
||||
_rfField :: GraphQLField r var
|
||||
}
|
||||
deriving (Functor, Foldable, Traversable)
|
||||
|
||||
-- | A remote relationship's selection and fields required for its join condition.
|
||||
data SchemaRemoteRelationshipSelect r = SchemaRemoteRelationshipSelect
|
||||
{ -- | The fields on the table that are required for the join condition
|
||||
-- of the remote relationship
|
||||
_srrsLHSJoinFields :: HashMap FieldName G.Name,
|
||||
-- | The field that captures the relationship
|
||||
-- r ~ (RemoteRelationshipField UnpreparedValue) when the AST is emitted by the parser.
|
||||
-- r ~ Void when an execution tree is constructed so that a backend is
|
||||
-- absolved of dealing with remote relationships.
|
||||
_srrsRelationship :: r
|
||||
}
|
||||
deriving (Eq, Show, Functor, Foldable, Traversable)
|
||||
|
||||
data RemoteFieldArgument = RemoteFieldArgument
|
||||
{ _rfaArgument :: !G.Name,
|
||||
_rfaValue :: !(InputValue RemoteSchemaVariable)
|
||||
{ _rfaArgument :: G.Name,
|
||||
_rfaValue :: InputValue RemoteSchemaVariable
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data RemoteSchemaSelect = RemoteSchemaSelect
|
||||
{ _rselArgs :: ![RemoteFieldArgument],
|
||||
_rselResultCustomizer :: !ResultCustomizer,
|
||||
_rselSelection :: !(G.SelectionSet G.NoFragments RemoteSchemaVariable),
|
||||
_rselFieldCall :: !(NonEmpty FieldCall),
|
||||
_rselRemoteSchema :: !RemoteSchemaInfo
|
||||
{ _rselArgs :: [RemoteFieldArgument],
|
||||
_rselResultCustomizer :: ResultCustomizer,
|
||||
_rselSelection :: SelectionSet Void RemoteSchemaVariable,
|
||||
_rselFieldCall :: NonEmpty FieldCall,
|
||||
_rselRemoteSchema :: RemoteSchemaInfo
|
||||
}
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Conversion back to a GraphQL document
|
||||
|
||||
-- | Converts a normalized selection set back into a selection set as defined in
|
||||
-- GraphQL spec, in order to send it to a remote server.
|
||||
--
|
||||
-- This function expects a 'SelectionSet' for which @r@ is 'Void', which
|
||||
-- guarantees that there is no longer any remote join field in the selection
|
||||
-- set.
|
||||
convertSelectionSet ::
|
||||
forall var.
|
||||
Eq var =>
|
||||
SelectionSet Void var ->
|
||||
G.SelectionSet G.NoFragments var
|
||||
convertSelectionSet = \case
|
||||
SelectionSetObject s -> convertObjectSelectionSet s
|
||||
SelectionSetUnion s -> convertAbstractTypeSelectionSet s
|
||||
SelectionSetInterface s -> convertAbstractTypeSelectionSet s
|
||||
SelectionSetNone -> mempty
|
||||
where
|
||||
convertField :: Field Void var -> G.Field G.NoFragments var
|
||||
convertField = \case
|
||||
FieldGraphQL f -> convertGraphQLField f
|
||||
|
||||
convertObjectSelectionSet =
|
||||
map (G.SelectionField . convertField . snd) . OMap.toList
|
||||
|
||||
convertAbstractTypeSelectionSet abstractSelectionSet =
|
||||
let (base, members) = reduceAbstractTypeSelectionSet abstractSelectionSet
|
||||
commonFields = convertObjectSelectionSet base
|
||||
concreteTypeSelectionSets =
|
||||
Map.toList members <&> \(concreteType, selectionSet) ->
|
||||
G.InlineFragment
|
||||
{ G._ifTypeCondition = Just concreteType,
|
||||
G._ifDirectives = mempty,
|
||||
G._ifSelectionSet = convertObjectSelectionSet selectionSet
|
||||
}
|
||||
in -- The base selection set first and then the more specific member
|
||||
-- selection sets. Note that the rendering strategy here should be
|
||||
-- inline with the strategy used in `mkAbstractTypeSelectionSet`
|
||||
commonFields <> map G.SelectionInlineFragment concreteTypeSelectionSets
|
||||
|
||||
convertGraphQLField :: Eq var => GraphQLField Void var -> G.Field G.NoFragments var
|
||||
convertGraphQLField GraphQLField {..} =
|
||||
G.Field
|
||||
{ -- add the alias only if it is different from the field name. This
|
||||
-- keeps the outbound request more readable
|
||||
G._fAlias = if _fAlias /= _fName then Just _fAlias else Nothing,
|
||||
G._fName = _fName,
|
||||
G._fArguments = _fArguments,
|
||||
G._fDirectives = mempty,
|
||||
G._fSelectionSet = convertSelectionSet _fSelectionSet
|
||||
}
|
||||
|
||||
-- | Builds the selection set for an abstract type.
|
||||
--
|
||||
-- Let's consider this query on starwars API:
|
||||
-- The type `Node` an interface is implemented by `Film`, `Species`, `Planet`,
|
||||
-- `Person`, `Starship`, `Vehicle`
|
||||
--
|
||||
-- query f {
|
||||
-- node(id: "ZmlsbXM6MQ==") {
|
||||
-- __typename
|
||||
-- id
|
||||
-- ... on Film {
|
||||
-- title
|
||||
-- }
|
||||
-- ... on Species {
|
||||
-- name
|
||||
-- }
|
||||
-- }
|
||||
-- }
|
||||
--
|
||||
-- When we parse this, it gets normalized into this query:
|
||||
--
|
||||
-- query f {
|
||||
-- node(id: "ZmlsbXM6MQ==") {
|
||||
-- ... on Film {
|
||||
-- __typename: __typename
|
||||
-- id
|
||||
-- title
|
||||
-- }
|
||||
-- ... on Species {
|
||||
-- __typename: __typename
|
||||
-- id
|
||||
-- name
|
||||
-- }
|
||||
-- ... on Planet {
|
||||
-- __typename: __typename
|
||||
-- id
|
||||
-- }
|
||||
-- ... on Person {
|
||||
-- __typename: __typename
|
||||
-- id
|
||||
-- }
|
||||
-- ... on Starship {
|
||||
-- __typename: __typename
|
||||
-- id
|
||||
-- }
|
||||
-- ... on Vehicle {
|
||||
-- __typename: __typename
|
||||
-- id
|
||||
-- }
|
||||
-- }
|
||||
-- }
|
||||
--
|
||||
-- `__typename` and `id` get pushed to each of the member types. From the above
|
||||
-- normalized selection set, we want to costruct a query as close to the
|
||||
-- original as possible. We do this as follows:
|
||||
--
|
||||
-- 1. find the longest common set of fields that each selection set starts with
|
||||
-- (in the above case, they are `__typename` and `id`)
|
||||
-- 2. from the above list of fields, find the first field that cannot be
|
||||
-- defined on the abstract type. The fields that can be defined on the
|
||||
-- abstract type are all the fields that occur before the first non abstract
|
||||
-- type field (in the above case, both` __typename` and `id` can be defined
|
||||
-- on the `Node` type)
|
||||
-- 3. Strip the base selection set fields from all the member selection sets and
|
||||
-- filter out the member type selection sets that are subsumed by the base
|
||||
-- selection set
|
||||
--
|
||||
-- The above query now translates to this:
|
||||
--
|
||||
-- query f {
|
||||
-- node(id: "ZmlsbXM6MQ==") {
|
||||
-- __typename: __typename
|
||||
-- id
|
||||
-- ... on Film {
|
||||
-- title
|
||||
-- }
|
||||
-- ... on Species {
|
||||
-- name
|
||||
-- }
|
||||
-- }
|
||||
-- }
|
||||
--
|
||||
-- Note that it is not always possible to get the same shape as the original
|
||||
-- query and there is more than one approach to this. For example, we could
|
||||
-- have picked the selection set (that can be defined on the abstract type)
|
||||
-- that is common across all the member selection sets and used that as the
|
||||
-- base selection.
|
||||
reduceAbstractTypeSelectionSet ::
|
||||
(Eq var) =>
|
||||
DeduplicatedSelectionSet Void var ->
|
||||
(ObjectSelectionSet Void var, Map.HashMap G.Name (ObjectSelectionSet Void var))
|
||||
reduceAbstractTypeSelectionSet (DeduplicatedSelectionSet baseMemberFields selectionSets) =
|
||||
(baseSelectionSet, Map.fromList memberSelectionSets)
|
||||
where
|
||||
sharedSelectionSetPrefix = longestCommonPrefix $ map (OMap.toList . snd) $ Map.toList selectionSets
|
||||
|
||||
baseSelectionSet = OMap.fromList $ takeWhile (shouldAddToBase . snd) sharedSelectionSetPrefix
|
||||
|
||||
shouldAddToBase = \case
|
||||
FieldGraphQL f -> Set.member (_fName f) baseMemberFields
|
||||
|
||||
memberSelectionSets =
|
||||
-- remove member selection sets that are subsumed by base selection set
|
||||
filter (not . null . snd) $
|
||||
-- remove the common prefix from member selection sets
|
||||
map (second (OMap.fromList . drop (OMap.size baseSelectionSet) . OMap.toList)) $ Map.toList selectionSets
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Remote schema entry points
|
||||
|
||||
$(makePrisms ''Field)
|
||||
|
||||
@ -89,14 +89,14 @@ type MutationActionRoot v =
|
||||
type QueryRootField v =
|
||||
RootField
|
||||
(QueryDBRoot (RemoteRelationshipField v) v)
|
||||
RQL.RemoteField
|
||||
(RemoteSchemaRootField Void RQL.RemoteSchemaVariable)
|
||||
(QueryActionRoot v)
|
||||
JO.Value
|
||||
|
||||
type MutationRootField v =
|
||||
RootField
|
||||
(MutationDBRoot (RemoteRelationshipField v) v)
|
||||
RQL.RemoteField
|
||||
(RemoteSchemaRootField Void RQL.RemoteSchemaVariable)
|
||||
(MutationActionRoot v)
|
||||
JO.Value
|
||||
|
||||
|
||||
@ -160,10 +160,10 @@ data QueryDB (b :: BackendType) (r :: Type) v
|
||||
-- Select
|
||||
|
||||
data AnnSelectG (b :: BackendType) (r :: Type) (f :: Type -> Type) (v :: Type) = AnnSelectG
|
||||
{ _asnFields :: (Fields (f v)),
|
||||
_asnFrom :: (SelectFromG b v),
|
||||
_asnPerm :: (TablePermG b v),
|
||||
_asnArgs :: (SelectArgsG b v),
|
||||
{ _asnFields :: Fields (f v),
|
||||
_asnFrom :: SelectFromG b v,
|
||||
_asnPerm :: TablePermG b v,
|
||||
_asnArgs :: SelectArgsG b v,
|
||||
_asnStrfyNum :: StringifyNumbers
|
||||
}
|
||||
deriving stock (Functor, Foldable, Traversable)
|
||||
@ -195,10 +195,10 @@ type AnnAggregateSelect b = AnnAggregateSelectG b Void (SQLExpression b)
|
||||
-- Relay select
|
||||
|
||||
data ConnectionSelect (b :: BackendType) (r :: Type) v = ConnectionSelect
|
||||
{ _csXRelay :: (XRelay b),
|
||||
_csPrimaryKeyColumns :: (PrimaryKeyColumns b),
|
||||
_csSplit :: (Maybe (NE.NonEmpty (ConnectionSplit b v))),
|
||||
_csSlice :: (Maybe ConnectionSlice),
|
||||
{ _csXRelay :: XRelay b,
|
||||
_csPrimaryKeyColumns :: PrimaryKeyColumns b,
|
||||
_csSplit :: Maybe (NE.NonEmpty (ConnectionSplit b v)),
|
||||
_csSlice :: Maybe ConnectionSlice,
|
||||
_csSelect :: (AnnSelectG b r (ConnectionField b r) v)
|
||||
}
|
||||
deriving stock (Functor, Foldable, Traversable)
|
||||
@ -295,10 +295,10 @@ type SelectFrom b = SelectFromG b (SQLExpression b)
|
||||
-- Select arguments
|
||||
|
||||
data SelectArgsG (b :: BackendType) v = SelectArgs
|
||||
{ _saWhere :: (Maybe (AnnBoolExp b v)),
|
||||
_saOrderBy :: (Maybe (NE.NonEmpty (AnnotatedOrderByItemG b v))),
|
||||
_saLimit :: (Maybe Int),
|
||||
_saOffset :: (Maybe Int64),
|
||||
{ _saWhere :: Maybe (AnnBoolExp b v),
|
||||
_saOrderBy :: Maybe (NE.NonEmpty (AnnotatedOrderByItemG b v)),
|
||||
_saLimit :: Maybe Int,
|
||||
_saOffset :: Maybe Int64,
|
||||
_saDistinct :: (Maybe (NE.NonEmpty (Column b)))
|
||||
}
|
||||
deriving stock (Generic, Functor, Foldable, Traversable)
|
||||
@ -350,10 +350,10 @@ deriving stock instance (Backend b, Show v, Show (BooleanOperators b v)) => Show
|
||||
instance (Backend b, Hashable v, Hashable (BooleanOperators b v)) => Hashable (ComputedFieldOrderByElement b v)
|
||||
|
||||
data ComputedFieldOrderBy (b :: BackendType) v = ComputedFieldOrderBy
|
||||
{ _cfobXField :: (XComputedField b),
|
||||
{ _cfobXField :: XComputedField b,
|
||||
_cfobName :: ComputedFieldName,
|
||||
_cfobFunction :: (FunctionName b),
|
||||
_cfobFunctionArgsExp :: (FunctionArgsExpTableRow v),
|
||||
_cfobFunction :: FunctionName b,
|
||||
_cfobFunctionArgsExp :: FunctionArgsExpTableRow v,
|
||||
_cfobOrderByElement :: (ComputedFieldOrderByElement b v)
|
||||
}
|
||||
deriving stock (Generic, Functor, Foldable, Traversable)
|
||||
@ -581,17 +581,15 @@ type PageInfoFields = Fields PageInfoField
|
||||
|
||||
type EdgeFields b r v = Fields (EdgeField b r v)
|
||||
|
||||
-- Column
|
||||
|
||||
data AnnColumnField (b :: BackendType) v = AnnColumnField
|
||||
{ _acfColumn :: (Column b),
|
||||
_acfType :: (ColumnType b),
|
||||
{ _acfColumn :: Column b,
|
||||
_acfType :: ColumnType b,
|
||||
-- | If this field is 'True', columns are explicitly casted to @text@ when fetched, which avoids
|
||||
-- an issue that occurs because we don’t currently have proper support for array types. See
|
||||
-- https://github.com/hasura/graphql-engine/pull/3198 for more details.
|
||||
_acfAsText :: Bool,
|
||||
_acfOp :: (Maybe (ColumnOp b)),
|
||||
-- | This type is used to determine if whether the column
|
||||
_acfOp :: Maybe (ColumnOp b),
|
||||
-- | This type is used to determine whether the column
|
||||
-- should be nullified. When the value is `Nothing`, the column value
|
||||
-- will be outputted as computed and when the value is `Just c`, the
|
||||
-- column will be outputted when `c` evaluates to `true` and `null`
|
||||
@ -626,9 +624,9 @@ deriving stock instance Backend b => Eq (ColumnOp b)
|
||||
-- Computed field
|
||||
|
||||
data ComputedFieldScalarSelect (b :: BackendType) v = ComputedFieldScalarSelect
|
||||
{ _cfssFunction :: (FunctionName b),
|
||||
_cfssArguments :: (FunctionArgsExpTableRow v),
|
||||
_cfssType :: (ScalarType b),
|
||||
{ _cfssFunction :: FunctionName b,
|
||||
_cfssArguments :: FunctionArgsExpTableRow v,
|
||||
_cfssType :: ScalarType b,
|
||||
_cfssColumnOp :: (Maybe (ColumnOp b))
|
||||
}
|
||||
deriving stock (Functor, Foldable, Traversable)
|
||||
@ -670,7 +668,7 @@ deriving stock instance
|
||||
|
||||
data AnnRelationSelectG (b :: BackendType) a = AnnRelationSelectG
|
||||
{ aarRelationshipName :: RelName, -- Relationship name
|
||||
aarColumnMapping :: (HashMap (Column b) (Column b)), -- Column of left table to join with
|
||||
aarColumnMapping :: HashMap (Column b) (Column b), -- Column of left table to join with
|
||||
aarAnnSelect :: a -- Current table. Almost ~ to SQL Select
|
||||
}
|
||||
deriving stock (Functor, Foldable, Traversable)
|
||||
@ -688,8 +686,8 @@ type ArrayConnectionSelect b r v = AnnRelationSelectG b (ConnectionSelect b r v)
|
||||
type ArrayAggregateSelect b = ArrayAggregateSelectG b Void (SQLExpression b)
|
||||
|
||||
data AnnObjectSelectG (b :: BackendType) (r :: Type) v = AnnObjectSelectG
|
||||
{ _aosFields :: (AnnFieldsG b r v),
|
||||
_aosTableFrom :: (TableName b),
|
||||
{ _aosFields :: AnnFieldsG b r v,
|
||||
_aosTableFrom :: TableName b,
|
||||
_aosTableFilter :: (AnnBoolExp b v)
|
||||
}
|
||||
deriving stock (Functor, Foldable, Traversable)
|
||||
@ -779,8 +777,8 @@ data
|
||||
(vf :: BackendType -> Type)
|
||||
(tgt :: BackendType) = RemoteSourceSelect
|
||||
{ _rssName :: SourceName,
|
||||
_rssConfig :: (SourceConfig tgt),
|
||||
_rssSelection :: (SourceRelationshipSelection tgt r vf),
|
||||
_rssConfig :: SourceConfig tgt,
|
||||
_rssSelection :: SourceRelationshipSelection tgt r vf,
|
||||
-- | Additional information about the source's join columns:
|
||||
-- (ScalarType tgt) so that the remote can interpret the join values coming
|
||||
-- from src
|
||||
@ -792,7 +790,7 @@ data
|
||||
-- Permissions
|
||||
|
||||
data TablePermG (b :: BackendType) v = TablePerm
|
||||
{ _tpFilter :: (AnnBoolExp b v),
|
||||
{ _tpFilter :: AnnBoolExp b v,
|
||||
_tpLimit :: (Maybe Int)
|
||||
}
|
||||
deriving stock (Generic, Functor, Foldable, Traversable)
|
||||
|
||||
@ -3,9 +3,7 @@ module Hasura.RQL.Types.RemoteSchema
|
||||
AddRemoteSchemaQuery (..),
|
||||
AliasMapping,
|
||||
DropRemoteSchemaPermissions (..),
|
||||
RemoteField,
|
||||
RemoteFieldCustomization (..),
|
||||
RemoteFieldG (..),
|
||||
RemoteSchemaCustomization (..),
|
||||
RemoteSchemaCustomizer (..),
|
||||
RemoteSchemaDef (..),
|
||||
@ -36,16 +34,12 @@ module Hasura.RQL.Types.RemoteSchema
|
||||
remoteSchemaCustomizeFieldName,
|
||||
getTypeName,
|
||||
remoteSchemaCustomizeTypeName,
|
||||
rfField,
|
||||
rfRemoteSchemaInfo,
|
||||
rfResultCustomizer,
|
||||
singletonAliasMapping,
|
||||
validateRemoteSchemaCustomization,
|
||||
validateRemoteSchemaDef,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens.TH (makeLenses)
|
||||
import Data.Aeson qualified as J
|
||||
import Data.Aeson.TH qualified as J
|
||||
import Data.Environment qualified as Env
|
||||
@ -412,17 +406,6 @@ newtype RemoteSchemaIntrospection
|
||||
= RemoteSchemaIntrospection (HashMap G.Name (G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition))
|
||||
deriving (Show, Eq, Generic, Hashable, Cacheable, Ord)
|
||||
|
||||
data RemoteFieldG var = RemoteFieldG
|
||||
{ _rfRemoteSchemaInfo :: !RemoteSchemaInfo,
|
||||
_rfResultCustomizer :: !ResultCustomizer,
|
||||
_rfField :: !(G.Field G.NoFragments var)
|
||||
}
|
||||
deriving (Functor, Foldable, Traversable)
|
||||
|
||||
$(makeLenses ''RemoteFieldG)
|
||||
|
||||
type RemoteField = RemoteFieldG RemoteSchemaVariable
|
||||
|
||||
data RemoteSchemaPermsCtx
|
||||
= RemoteSchemaPermsEnabled
|
||||
| RemoteSchemaPermsDisabled
|
||||
|
||||
@ -138,6 +138,7 @@ import Hasura.Incremental
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.DDL.WebhookTransforms
|
||||
import Hasura.RQL.IR.BoolExp
|
||||
import Hasura.RQL.IR.RemoteSchema
|
||||
import Hasura.RQL.Types.Action
|
||||
import Hasura.RQL.Types.Allowlist
|
||||
import Hasura.RQL.Types.ApiLimit
|
||||
@ -226,9 +227,9 @@ data IntrospectionResult = IntrospectionResult
|
||||
instance Cacheable IntrospectionResult
|
||||
|
||||
data ParsedIntrospectionG m = ParsedIntrospection
|
||||
{ piQuery :: [P.FieldParser m (NamespacedField RemoteField)],
|
||||
piMutation :: Maybe [P.FieldParser m (NamespacedField RemoteField)],
|
||||
piSubscription :: Maybe [P.FieldParser m (NamespacedField RemoteField)]
|
||||
{ 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))]
|
||||
}
|
||||
|
||||
type ParsedIntrospection = ParsedIntrospectionG (P.ParseT Identity)
|
||||
|
||||
@ -18,6 +18,7 @@ import Hasura.GraphQL.Parser.TestUtils
|
||||
import Hasura.GraphQL.RemoteServer (identityCustomizer)
|
||||
import Hasura.GraphQL.Schema.Remote
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.IR.RemoteSchema
|
||||
import Hasura.RQL.Types.RemoteSchema
|
||||
import Hasura.RQL.Types.SchemaCache
|
||||
import Hasura.Session
|
||||
@ -106,7 +107,7 @@ buildQueryParsers introspection = do
|
||||
RemoteSchemaInfo (ValidatedRemoteSchemaDef N.nullURI [] False 60 Nothing) identityCustomizer
|
||||
pure $
|
||||
head query <&> \case
|
||||
NotNamespaced remoteFld -> _rfField remoteFld
|
||||
NotNamespaced remoteFld -> convertGraphQLField $ _rfField remoteFld
|
||||
Namespaced _ ->
|
||||
-- Shouldn't happen if we're using identityCustomizer
|
||||
-- TODO: add some tests for remote schema customization
|
||||
|
||||
Loading…
Reference in New Issue
Block a user