hasura/graphql-engine
1
0
Fork 0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-18 13:02:11 +03:00
Code Issues Projects Releases Wiki Activity
3a400fab3d
graphql-engine/server/src-lib/Hasura/GraphQL/Execute/RemoteJoin/Collect.hs
Samir Talwar 8db9b77c77 server: Reorganize quasi-quoted names. 
Pretty much all quasi-quoted names in the server code base have ended up in `Hasura.GraphQL.Parser.Constants`. I'm now finding this unpleasant for two reasons:

1. I would like to factor out the parser code into its own Cabal package, and I don't want to have to expose all these names.
2. Most of them really have nothing to do with the parsers.

In order to remedy this, I have:

1. moved the names used by parser code to `Hasura.GraphQL.Parser.DirectiveName`, as they're all related to directives;
2. moved `Hasura.GraphQL.Parser.Constants` to `Hasura.Name`, changing the qualified import name from `G` to `Name`;
3. moved names only used in tests to the appropriate test case;
4. removed unused items from `Hasura.Name`; and
5. grouped related names.

Most of the changes are simply changing `G` to `Name`, which I find much more meaningful.

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4777
GitOrigin-RevId: a77aa0aee137b2b5e6faec94495d3a9fbfa1348b
2022-06-23 09:15:31 +00:00

687 lines
30 KiB
Haskell
Raw Blame History

module Hasura.GraphQL.Execute.RemoteJoin.Collect
( getRemoteJoinsQueryDB,
getRemoteJoinsMutationDB,
getRemoteJoinsActionQuery,
getRemoteJoinsActionMutation,
getRemoteJoinsGraphQLField,
)
where
import Control.Lens (Traversal', preview, traverseOf, _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
import Hasura.GraphQL.Execute.RemoteJoin.Types
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.Relationships.Remote
import Hasura.SQL.AnyBackend qualified as AB
import Language.GraphQL.Draft.Syntax qualified as G
{- Note [Remote Joins Architecture]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Unparsed Incoming GraphQL +------------------------------+
--------------------------> | Parsing of the GraphQL query |-----+
+------------------------------+ |
| DB Query and remote joins (if any)
|
V
+----------------------------------+ SQL query response +----------------------------+
| Traverse the DB response to | <------------------- | Execution of the DB query |
| get the values of the arguments | +----------------------------+
| of the remote field |
+----------------------------------+
|
| Remote field arguments
V
+--------------------------+ Remote schema response +----------------------------------------+
| Query the remote schema | ------------------------> | Replace the remote join fields in |
| with the remote field | | the SQL query response (JSON) with |
| arguments to the remote | | the response obtained from the remote |
| field configured in the | | schema at appropriate places. |
| remote join. | +----------------------------------------+
+--------------------------+
-}
-------------------------------------------------------------------------------
-- AST entry points
-- | Collects remote joins from the a 'QueryDB' if any, and transforms the
-- selection to add new join fields where those occured.
--
-- Returns the transformed selection set, in which remote fields have been
-- inserted, and for which the @r@ type is now 'Void'.
getRemoteJoinsQueryDB ::
Backend b =>
QueryDB b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
(QueryDB b Void (UnpreparedValue b), Maybe RemoteJoins)
getRemoteJoinsQueryDB =
runCollector . \case
QDBMultipleRows s ->
QDBMultipleRows <$> transformSelect s
QDBSingleRow s ->
QDBSingleRow <$> transformSelect s
QDBAggregation s ->
QDBAggregation <$> transformAggregateSelect s
QDBConnection s ->
QDBConnection <$> transformConnectionSelect s
QDBStreamMultipleRows s ->
QDBStreamMultipleRows <$> transformStreamSelect s
-- | Collects remote joins from the a 'MutationDB' if any, and transforms the
-- selection to add new join fields where those occured.
--
-- Returns the transformed selection set, in which remote fields have been
-- inserted, and for which the @r@ type is now 'Void'.
getRemoteJoinsMutationDB ::
Backend b =>
MutationDB b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
(MutationDB b Void (UnpreparedValue b), Maybe RemoteJoins)
getRemoteJoinsMutationDB =
runCollector . \case
MDBInsert insert ->
MDBInsert <$> traverseOf aiOutput transformMutationOutput insert
MDBUpdate update ->
MDBUpdate <$> traverseOf auOutput transformMutationOutput update
MDBDelete delete ->
MDBDelete <$> traverseOf adOutput transformMutationOutput delete
MDBFunction aggSelect select ->
MDBFunction aggSelect <$> transformSelect select
getRemoteJoinsActionQuery ::
ActionQuery (RemoteRelationshipField UnpreparedValue) ->
(ActionQuery Void, Maybe RemoteJoins)
getRemoteJoinsActionQuery =
runCollector . \case
AQQuery sync ->
AQQuery <$> transformSyncAction sync
AQAsync async ->
AQAsync <$> traverseOf aaaqFields (traverseFields transformAsyncFields) async
getRemoteJoinsActionMutation ::
ActionMutation (RemoteRelationshipField UnpreparedValue) ->
(ActionMutation Void, Maybe RemoteJoins)
getRemoteJoinsActionMutation =
runCollector . \case
AMAsync async -> pure $ AMAsync async
AMSync sync -> AMSync <$> transformSyncAction sync
getRemoteJoinsSourceRelation ::
Backend b =>
SourceRelationshipSelection b (RemoteRelationshipField UnpreparedValue) UnpreparedValue ->
(SourceRelationshipSelection b Void UnpreparedValue, Maybe RemoteJoins)
getRemoteJoinsSourceRelation =
runCollector . \case
SourceRelationshipObject objectSelect ->
SourceRelationshipObject <$> transformObjectSelect objectSelect
SourceRelationshipArray simpleSelect ->
SourceRelationshipArray <$> transformSelect simpleSelect
SourceRelationshipArrayAggregate aggregateSelect ->
SourceRelationshipArrayAggregate <$> transformAggregateSelect aggregateSelect
getRemoteJoinsGraphQLField ::
GraphQLField (RemoteRelationshipField UnpreparedValue) var ->
(GraphQLField Void var, Maybe RemoteJoins)
getRemoteJoinsGraphQLField =
runCollector . transformGraphQLField
getRemoteJoinsGraphQLSelectionSet ::
SelectionSet (RemoteRelationshipField UnpreparedValue) var ->
(SelectionSet Void var, Maybe RemoteJoins)
getRemoteJoinsGraphQLSelectionSet =
runCollector . transformGraphQLSelectionSet
-------------------------------------------------------------------------------
-- | A writer monad used to collect together all remote joins
-- appearing in some data structure.
--
-- In the functions below, the 'withField' function is used to track the
-- context of the path from the root of the current selection set.
--
-- It is important that we work bottom-up, and do not 'collect' duplicate
-- field names at any level, because the 'Semigroup' instance for 'RemoteJoins'
-- does not allow for these duplicates.
newtype Collector a = Collector {runCollector :: (a, Maybe RemoteJoins)}
deriving
(Functor, Applicative, Monad, MonadWriter (Maybe RemoteJoins))
via Writer (Maybe RemoteJoins)
-- | Collect some remote joins appearing at the given field names in the current
-- context.
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 :: Maybe Text -> Text -> Collector a -> Collector a
withField typeName fieldName = censor (fmap wrap)
where
wrap rjs = JoinTree $ NEMap.singleton (QualifiedFieldName typeName fieldName) (Tree rjs)
-- | Traverse a list of fields, while applying 'withField' to keep track of the
-- path within the AST. This function assumes that no type name is required for
-- the 'QualifiedFieldName' and uses 'Nothing'.
traverseFields ::
(a -> Collector b) ->
Fields a ->
Collector (Fields b)
traverseFields fun =
traverse \field@(fieldName, _) ->
withField Nothing (getFieldNameTxt fieldName) $ traverse fun field
-------------------------------------------------------------------------------
-- Internal AST traversals
transformAsyncFields ::
AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue) ->
Collector (AsyncActionQueryFieldG Void)
transformAsyncFields = traverseOf _AsyncOutput transformActionFields
transformMutationOutput ::
Backend b =>
MutationOutputG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
Collector (MutationOutputG b Void (UnpreparedValue b))
transformMutationOutput = \case
MOutMultirowFields mutationFields ->
MOutMultirowFields <$> transformMutationFields mutationFields
MOutSinglerowObject annFields ->
MOutSinglerowObject <$> transformAnnFields annFields
where
transformMutationFields = traverseFields $ traverseOf _MRet transformAnnFields
transformSyncAction ::
AnnActionExecution (RemoteRelationshipField UnpreparedValue) ->
Collector (AnnActionExecution Void)
transformSyncAction = traverseOf aaeFields transformActionFields
transformSelect ::
Backend b =>
AnnSimpleSelectG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
transformSelect = traverseOf asnFields transformAnnFields
transformStreamSelect ::
Backend b =>
AnnSimpleStreamSelectG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
Collector (AnnSimpleStreamSelectG b Void (UnpreparedValue b))
transformStreamSelect select@AnnSelectStreamG {_assnFields = fields} = do
-- Transform selects in array, object and computed fields
transformedFields <- transformAnnFields fields
pure select {_assnFields = transformedFields}
transformAggregateSelect ::
Backend b =>
AnnAggregateSelectG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
Collector (AnnAggregateSelectG b Void (UnpreparedValue b))
transformAggregateSelect =
traverseOf asnFields $
traverseFields $ traverseOf (_TAFNodes . _2) transformAnnFields
-- Relay doesn't support remote relationships: we can drill down directly to the
-- inner non-relay selection sets.
transformConnectionSelect ::
forall b.
Backend b =>
ConnectionSelect b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
Collector (ConnectionSelect b Void (UnpreparedValue b))
transformConnectionSelect =
traverseOf (csSelect . asnFields) $
traverseFields $
traverseOf _ConnectionEdges $
traverseFields $ traverseOf _EdgeNode transformAnnFields
transformObjectSelect ::
Backend b =>
AnnObjectSelectG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
Collector (AnnObjectSelectG b Void (UnpreparedValue b))
transformObjectSelect = traverseOf aosFields transformAnnFields
transformGraphQLField ::
GraphQLField (RemoteRelationshipField UnpreparedValue) var ->
Collector (GraphQLField Void var)
transformGraphQLField = traverseOf fSelectionSet transformGraphQLSelectionSet
transformGraphQLSelectionSet ::
SelectionSet (RemoteRelationshipField UnpreparedValue) var ->
Collector (SelectionSet Void var)
transformGraphQLSelectionSet = \case
SelectionSetNone -> pure SelectionSetNone
SelectionSetObject s -> SelectionSetObject <$> transformObjectSelectionSet Nothing s
SelectionSetUnion s -> SelectionSetUnion <$> transformDeduplicatedTypeSelectionSet s
SelectionSetInterface s -> SelectionSetInterface <$> transformDeduplicatedTypeSelectionSet s
where
transformDeduplicatedTypeSelectionSet =
traverseOf dssMemberSelectionSets $ Map.traverseWithKey \typeName objectSelectionSet ->
transformObjectSelectionSet (Just typeName) objectSelectionSet
-------------------------------------------------------------------------------
-- Actual transformations
-- | Transforms a source selection set.
--
-- This function takes an 'AnnFieldsG', which corresponds to a selection of
-- fields on a source, and extracts remote joins: for every field we encounter
-- that maps to a remote destination (either another source or a remote schema),
-- we replace it with a phantom field and 'collect' the corresponding
-- 'RemoteJoin'.
transformAnnFields ::
forall src.
Backend src =>
AnnFieldsG src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src) ->
Collector (AnnFieldsG src Void (UnpreparedValue src))
transformAnnFields fields = do
-- Produces a list of transformed fields that may or may not have an
-- associated remote join.
annotatedFields <-
fields & traverseFields \case
-- AnnFields which do not need to be transformed.
AFNodeId x sn qt pkeys ->
pure (AFNodeId x sn qt pkeys, Nothing)
AFColumn c ->
pure (AFColumn c, Nothing)
AFExpression t ->
pure (AFExpression t, Nothing)
-- AnnFields with no associated remote joins and whose transformations are
-- relatively straightforward.
AFObjectRelation annRel -> do
transformed <- traverseOf aarAnnSelect transformObjectSelect annRel
pure (AFObjectRelation transformed, Nothing)
AFArrayRelation (ASSimple annRel) -> do
transformed <- traverseOf aarAnnSelect transformSelect annRel
pure (AFArrayRelation . ASSimple $ transformed, Nothing)
AFArrayRelation (ASAggregate aggRel) -> do
transformed <- traverseOf aarAnnSelect transformAggregateSelect aggRel
pure (AFArrayRelation . ASAggregate $ transformed, Nothing)
AFArrayRelation (ASConnection annRel) -> do
transformed <- traverseOf aarAnnSelect transformConnectionSelect annRel
pure (AFArrayRelation . ASConnection $ transformed, Nothing)
AFComputedField computedField computedFieldName computedFieldSelect -> do
transformed <- case computedFieldSelect of
CFSScalar cfss cbe -> pure $ CFSScalar cfss cbe
CFSTable jsonAggSel annSel -> do
transformed <- transformSelect annSel
pure $ CFSTable jsonAggSel transformed
pure (AFComputedField computedField computedFieldName transformed, Nothing)
-- Remote AnnFields, whose elements require annotation so that they can be
-- used to construct a remote join.
AFRemote RemoteRelationshipSelect {..} ->
pure
( -- We generate this so that the response has a key with the relationship,
-- without which preserving the order of fields in the final response
-- would require a lot of bookkeeping.
remoteAnnPlaceholder,
Just $ createRemoteJoin joinColumnAliases _rrsRelationship
)
let transformedFields = (fmap . fmap) fst annotatedFields
remoteJoins =
annotatedFields & mapMaybe \(fieldName, (_, mRemoteJoin)) ->
(QualifiedFieldName Nothing (getFieldNameTxt fieldName),) <$> mRemoteJoin
case NEMap.fromList remoteJoins of
Nothing -> pure transformedFields
Just neRemoteJoins -> do
collect neRemoteJoins
pure $ transformedFields <> phantomFields
where
-- Placeholder text to annotate a remote relationship field.
remoteAnnPlaceholder :: AnnFieldG src Void (UnpreparedValue src)
remoteAnnPlaceholder = AFExpression "remote relationship placeholder"
-- This is a map of column name to its alias of all columns in the
-- selection set.
columnFields :: HashMap (Column src) FieldName
columnFields =
Map.fromList $
[ (_acfColumn annColumn, alias)
| (alias, annColumn) <- getFields _AFColumn fields
]
-- This is a map of computed field name to its alias of all computed fields
-- in the selection set.
computedFields :: Map.HashMap ComputedFieldName FieldName
computedFields =
Map.fromList $
[ (fieldName, alias)
| -- Note that we do not currently care about input arguments to a computed
-- field because only computed fields which do not accept input arguments
-- are currently allowed.
(alias, fieldName) <- getFields (_AFComputedField . _2) fields
]
-- Annotate a 'DBJoinField' with its field name and an alias so that it may
-- be used to construct a remote join.
annotateDBJoinField ::
FieldName -> DBJoinField src -> (DBJoinField src, JoinColumnAlias)
annotateDBJoinField fieldName = \case
jc@(JoinColumn column _) ->
let alias = getJoinColumnAlias fieldName column columnFields allAliases
in (jc, alias)
jcf@(JoinComputedField ScalarComputedField {..}) ->
let alias = getJoinColumnAlias fieldName _scfName computedFields allAliases
in (jcf, alias)
where
allAliases = map fst fields
-- goes through all the remote relationships in the selection set and emits
-- 1. a map of join field names to their aliases in the lhs response
-- 2. a list of extra fields that need to be included in the lhs query
-- that are required for the join
(joinColumnAliases, phantomFields) =
let lhsJoinFields =
Map.unions $ map (_rrsLHSJoinFields . snd) $ getFields _AFRemote fields
annotatedJoinColumns = Map.mapWithKey annotateDBJoinField $ lhsJoinFields
phantomFields_ =
toList annotatedJoinColumns & mapMaybe \(joinField, alias) ->
case alias of
JCSelected _ -> Nothing
JCPhantom a -> case joinField of
JoinColumn column columnType ->
let annotatedColumn =
AFColumn $ AnnColumnField column columnType False Nothing Nothing
in Just (a, annotatedColumn)
JoinComputedField computedFieldInfo ->
Just (a, mkScalarComputedFieldSelect computedFieldInfo)
in (fmap snd annotatedJoinColumns, phantomFields_)
mkScalarComputedFieldSelect ::
forall b.
(Backend b) =>
ScalarComputedField b ->
AnnFieldG b Void (UnpreparedValue b)
mkScalarComputedFieldSelect ScalarComputedField {..} =
let functionArgs =
flip FunctionArgsExp mempty $ fromComputedFieldImplicitArguments @b UVSession _scfComputedFieldImplicitArgs
fieldSelect =
flip CFSScalar Nothing $
ComputedFieldScalarSelect _scfFunction functionArgs _scfType Nothing
in AFComputedField _scfXField _scfName fieldSelect
-- | Transforms an action's selection set.
--
-- This function takes an 'ActionFieldsG', which corresponds to a selection of
-- fields on the result of an action, and extracts remote joins: for every field
-- we encounter that maps to a remote destination (either a source or a remote
-- schema), we replace it with a phantom field and 'collect' the corresponding
-- 'RemoteJoin'.
transformActionFields ::
ActionFieldsG (RemoteRelationshipField UnpreparedValue) ->
Collector ActionFields
transformActionFields fields = do
-- Produces a list of transformed fields that may or may not have an
-- associated remote join.
annotatedFields <-
fields & traverseFields \case
-- ActionFields which do not need to be transformed.
ACFScalar c -> pure (ACFScalar c, Nothing)
ACFExpression t -> pure (ACFExpression t, Nothing)
-- Remote ActionFields, whose elements require annotation so that they can be
-- used to construct a remote join.
ACFRemote ActionRemoteRelationshipSelect {..} ->
pure
( -- We generate this so that the response has a key with the relationship,
-- without which preserving the order of fields in the final response
-- would require a lot of bookkeeping.
remoteActionPlaceholder,
Just $ createRemoteJoin joinColumnAliases _arrsRelationship
)
ACFNestedObject fn fs ->
(,Nothing) . ACFNestedObject fn <$> transformActionFields fs
let transformedFields = (fmap . fmap) fst annotatedFields
remoteJoins =
annotatedFields & mapMaybe \(fieldName, (_, mRemoteJoin)) ->
(QualifiedFieldName Nothing (getFieldNameTxt fieldName),) <$> mRemoteJoin
case NEMap.fromList remoteJoins of
Nothing -> pure transformedFields
Just neRemoteJoins -> do
collect neRemoteJoins
pure $ transformedFields <> phantomFields
where
-- Placeholder text to annotate a remote relationship field.
remoteActionPlaceholder :: ActionFieldG Void
remoteActionPlaceholder = ACFExpression "remote relationship placeholder"
-- This is a map of column name to its alias of all columns in the
-- selection set.
scalarFields :: HashMap G.Name FieldName
scalarFields =
Map.fromList $
[ (name, alias)
| (alias, name) <- getFields _ACFScalar fields
]
-- Annotate a join field with its field name and an alias so that it may
-- be used to construct a remote join.
annotateJoinField ::
FieldName -> G.Name -> (G.Name, JoinColumnAlias)
annotateJoinField fieldName field =
let alias = getJoinColumnAlias fieldName field scalarFields allAliases
in (field, alias)
where
allAliases = map fst fields
-- goes through all the remote relationships in the selection set and emits
-- 1. a map of join field names to their aliases in the lhs response
-- 2. a list of extra fields that need to be included in the lhs query
-- that are required for the join
(joinColumnAliases, phantomFields :: ([(FieldName, ActionFieldG Void)])) =
let lhsJoinFields =
Map.unions $ map (_arrsLHSJoinFields . snd) $ getFields _ACFRemote fields
annotatedJoinColumns = Map.mapWithKey annotateJoinField $ lhsJoinFields
phantomFields_ :: ([(FieldName, ActionFieldG Void)]) =
toList annotatedJoinColumns & mapMaybe \(joinField, alias) ->
case alias of
JCSelected _ -> Nothing
JCPhantom a ->
let annotatedColumn =
ACFScalar joinField
in Just (a, annotatedColumn)
in (fmap snd annotatedJoinColumns, phantomFields_)
-- | Transforms a GraphQL selection set.
--
-- This function takes an 'SelectionSet', which corresponds to a selection of
-- fields on a remote GraphQL schema, and extracts remote joins: for every field
-- we encounter that maps to a remote destination (either a source or another
-- remote schema), we replace it with a phantom field and 'collect' the
-- corresponding 'RemoteJoin'.
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 = Name.___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)
GName.___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) GName.___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
-- This alias is generated in 'getJoinColumnAlias', and is guaranteed
-- to be a valid GraphQLName.
columnGraphQLName =
G.unsafeMkName $ getFieldNameTxt $ getAliasFieldName columnAlias
in ( mkGraphQLField
(Just columnGraphQLName)
lhsJoinField
mempty
mempty
SelectionSetNone,
columnAlias
)
(joinColumnAliases, phantomFields) =
let lhsJoinFields =
Map.unions $ map _srrsLHSJoinFields $ mapMaybe (preview _FieldRemote) $ toList selectionSet
annotatedJoinColumns = Map.mapWithKey annotateLHSJoinField lhsJoinFields
in (fmap snd annotatedJoinColumns, fmap fst annotatedJoinColumns)
-------------------------------------------------------------------------------
-- Internal helpers
-- | Converts a remote relationship field into a 'RemoteJoin' that
-- the execution engine understands.
createRemoteJoin ::
-- We need information about 'how' the lhs join fields appear in the lhs
-- response to construct a 'RemoteJoin' node
Map.HashMap FieldName JoinColumnAlias ->
-- The remote relationship field as captured in the IR
RemoteRelationshipField UnpreparedValue ->
RemoteJoin
createRemoteJoin joinColumnAliases = \case
RemoteSchemaField RemoteSchemaSelect {..} ->
let inputArgsToMap = Map.fromList . map (_rfaArgument &&& _rfaValue)
(transformedSchemaRelationship, schemaRelationshipJoins) =
getRemoteJoinsGraphQLSelectionSet _rselSelection
remoteJoin =
RemoteSchemaJoin
(inputArgsToMap _rselArgs)
_rselResultCustomizer
transformedSchemaRelationship
joinColumnAliases
_rselFieldCall
_rselRemoteSchema
in RemoteJoinRemoteSchema remoteJoin schemaRelationshipJoins
RemoteSourceField anySourceSelect ->
AB.dispatchAnyBackend @Backend anySourceSelect \RemoteSourceSelect {..} ->
let (transformedSourceRelationship, sourceRelationshipJoins) =
getRemoteJoinsSourceRelation _rssSelection
-- the invariant here is that the the keys in joinColumnAliases and
-- _rssJoinMapping are the same. We could've opted for a more type
-- safe representation Map k (a, b) instead of (Map k a, Map k b)
-- but that would make the type of lhs join columns creep into
-- RemoteRelationshipField which would make the type a little
-- unweildy
joinColumns =
_rssJoinMapping & Map.mapMaybeWithKey
\joinFieldName (rhsColumnType, rhsColumn) ->
(,(rhsColumn, rhsColumnType))
<$> Map.lookup joinFieldName joinColumnAliases
anySourceJoin =
AB.mkAnyBackend $
RemoteSourceJoin
_rssName
_rssConfig
transformedSourceRelationship
joinColumns
in RemoteJoinSource anySourceJoin sourceRelationshipJoins
-- | Constructs a 'JoinColumnAlias' for a given field in a selection set.
--
-- If the field was already requested, we leave it unchanged, to avoid
-- double-fetching the same information. However, if this field is a "phantom"
-- field, that we only add for the purpose of fetching a join key, we rename it
-- in a way that is guaranteed to avoid conflicts.
--
-- NOTE: if the @fieldName@ argument is a valid GraphQL name, then the
-- constructed alias MUST also be a valid GraphQL name.
getJoinColumnAlias ::
(Eq field, Hashable field) =>
FieldName ->
field ->
HashMap field FieldName ->
[FieldName] ->
JoinColumnAlias
getJoinColumnAlias fieldName field selectedFields allAliases =
case Map.lookup field selectedFields of
Nothing -> JCPhantom uniqueAlias
Just fieldAlias -> JCSelected fieldAlias
where
-- This generates an alias for a phantom field that does not conflict with
-- any of the existing aliases in the selection set
--
-- If we generate a unique name for each field name which is longer than
-- the longest alias in the selection set, the generated name would be
-- unique.
uniqueAlias :: FieldName
uniqueAlias =
let suffix =
"_join_column"
<>
-- 12 is the length of "_join_column"
T.replicate ((longestAliasLength - (T.length (coerce fieldName) + 12)) + 1) "_"
in fieldName <> FieldName suffix
where
longestAliasLength = maximum $ map (T.length . coerce) allAliases
-- | Get the fields targeted by some 'Traversal' for an arbitrary list of
-- tuples, discarding any elements whose fields cannot be focused upon.
getFields :: Traversal' super sub -> [(any, super)] -> [(any, sub)]
getFields focus = mapMaybe (traverse $ preview focus)
Reference in New Issue View Git Blame Copy Permalink