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.Column (UnpreparedValue (..)) import Hasura.GraphQL.Parser.Constants qualified as G import Hasura.Prelude import Hasura.RQL.IR import Hasura.RQL.Types 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 qt pkeys -> pure (AFNodeId x 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 :: ScalarComputedField b -> AnnFieldG b Void (UnpreparedValue b) mkScalarComputedFieldSelect ScalarComputedField {..} = let functionArgs = flip FunctionArgsExp mempty $ functionArgsWithTableRowAndSession UVSession _scfTableArgument _scfSessionArgument 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 = G.___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.___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.___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)