mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
4a83bb1834
https://github.com/hasura/graphql-engine-mono/pull/1995 Co-authored-by: David Overton <7734777+dmoverton@users.noreply.github.com> GitOrigin-RevId: 178669089ec5e63b1f3da1d3ba0a9f8debbc108d
438 lines
19 KiB
Haskell
438 lines
19 KiB
Haskell
module Hasura.GraphQL.Execute.RemoteJoin.Collect
|
|
( getRemoteJoins
|
|
, getRemoteJoinsSelect
|
|
, getRemoteJoinsMutationDB
|
|
, getRemoteJoinsActionQuery
|
|
, getRemoteJoinsActionMutation
|
|
) where
|
|
|
|
import Hasura.Prelude
|
|
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Data.List.NonEmpty as NE
|
|
import qualified Data.Text as T
|
|
|
|
import Control.Lens (Traversal', _2, preview)
|
|
import Control.Monad.Writer
|
|
|
|
|
|
import Hasura.GraphQL.Execute.RemoteJoin.Types
|
|
import Hasura.GraphQL.Parser.Column (UnpreparedValue (..))
|
|
import Hasura.RQL.IR
|
|
import Hasura.RQL.IR.Returning
|
|
import Hasura.RQL.Types
|
|
|
|
{- 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. | +----------------------------------------+
|
|
+--------------------------+
|
|
-}
|
|
|
|
-- | 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 :: NonEmpty (FieldName, RemoteJoin) -> Collector ()
|
|
collect = tell . Just . JoinTree . fmap (second Leaf)
|
|
|
|
-- | Keep track of the given field name in the current path from the root of the
|
|
-- selection set.
|
|
withField :: FieldName -> Collector a -> Collector a
|
|
withField name = censor (fmap wrap) where
|
|
wrap rjs = JoinTree ((name, Tree rjs) :| [])
|
|
|
|
-- | Collects remote joins from the AST and also adds the necessary join fields
|
|
getRemoteJoins
|
|
:: Backend b
|
|
=> QueryDB b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> (QueryDB b (Const Void) (UnpreparedValue b), Maybe RemoteJoins)
|
|
getRemoteJoins = \case
|
|
QDBMultipleRows s -> first QDBMultipleRows $ getRemoteJoinsSelect s
|
|
QDBSingleRow s -> first QDBSingleRow $ getRemoteJoinsSelect s
|
|
QDBAggregation s -> first QDBAggregation $ getRemoteJoinsAggregateSelect s
|
|
QDBConnection s -> first QDBConnection $ getRemoteJoinsConnectionSelect s
|
|
|
|
-- | Traverse through 'AnnSimpleSel' and collect remote join fields (if any).
|
|
getRemoteJoinsSelect
|
|
:: Backend b
|
|
=> AnnSimpleSelectG b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> (AnnSimpleSelectG b (Const Void) (UnpreparedValue b), Maybe RemoteJoins)
|
|
getRemoteJoinsSelect =
|
|
runCollector . transformSelect
|
|
|
|
-- | Traverse through @'AnnAggregateSelect' and collect remote join fields (if any).
|
|
getRemoteJoinsAggregateSelect
|
|
:: Backend b
|
|
=> AnnAggregateSelectG b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> (AnnAggregateSelectG b (Const Void) (UnpreparedValue b), Maybe RemoteJoins)
|
|
getRemoteJoinsAggregateSelect =
|
|
runCollector . transformAggregateSelect
|
|
|
|
-- | Traverse through @'ConnectionSelect' and collect remote join fields (if any).
|
|
getRemoteJoinsConnectionSelect
|
|
:: Backend b
|
|
=> ConnectionSelect b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> (ConnectionSelect b (Const Void) (UnpreparedValue b), Maybe RemoteJoins)
|
|
getRemoteJoinsConnectionSelect =
|
|
runCollector . transformConnectionSelect
|
|
|
|
-- | Traverse through 'MutationOutput' and collect remote join fields (if any)
|
|
getRemoteJoinsMutationOutput
|
|
:: Backend b
|
|
=> MutationOutputG b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> (MutationOutputG b (Const Void) (UnpreparedValue b), Maybe RemoteJoins)
|
|
getRemoteJoinsMutationOutput =
|
|
runCollector . transformMutationOutput
|
|
where
|
|
transformMutationOutput = \case
|
|
MOutMultirowFields mutationFields ->
|
|
MOutMultirowFields <$> transfromMutationFields mutationFields
|
|
MOutSinglerowObject annFields ->
|
|
MOutSinglerowObject <$> transformAnnFields annFields
|
|
where
|
|
transfromMutationFields fields =
|
|
for fields $ \(fieldName, field') -> withField fieldName do
|
|
(fieldName,) <$> case field' of
|
|
MCount -> pure MCount
|
|
MExp t -> pure $ MExp t
|
|
MRet annFields -> MRet <$> transformAnnFields annFields
|
|
|
|
|
|
-- local helpers
|
|
|
|
getRemoteJoinsAnnFields
|
|
:: Backend b
|
|
=> AnnFieldsG b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> (AnnFieldsG b (Const Void) (UnpreparedValue b), Maybe RemoteJoins)
|
|
getRemoteJoinsAnnFields =
|
|
runCollector . transformAnnFields
|
|
|
|
getRemoteJoinsMutationDB
|
|
:: Backend b
|
|
=> MutationDB b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> (MutationDB b (Const Void) (UnpreparedValue b), Maybe RemoteJoins)
|
|
getRemoteJoinsMutationDB = \case
|
|
MDBInsert insert ->
|
|
first MDBInsert $ getRemoteJoinsInsert insert
|
|
MDBUpdate update ->
|
|
first MDBUpdate $ getRemoteJoinsUpdate update
|
|
MDBDelete delete ->
|
|
first MDBDelete $ getRemoteJoinsDelete delete
|
|
MDBFunction aggSelect select ->
|
|
first (MDBFunction aggSelect) $ getRemoteJoinsSelect select
|
|
where
|
|
getRemoteJoinsInsert insert =
|
|
let (output', remoteJoins) = getRemoteJoinsMutationOutput $ _aiOutput insert
|
|
in (insert{ _aiOutput = output'}, remoteJoins)
|
|
|
|
getRemoteJoinsUpdate update =
|
|
let (output', remoteJoins) = getRemoteJoinsMutationOutput $ uqp1Output update
|
|
in (update{ uqp1Output = output'}, remoteJoins)
|
|
|
|
getRemoteJoinsDelete delete =
|
|
let (output', remoteJoins) = getRemoteJoinsMutationOutput $ dqp1Output delete
|
|
in (delete{ dqp1Output = output'}, remoteJoins)
|
|
|
|
getRemoteJoinsSyncAction
|
|
:: (Backend b)
|
|
=> AnnActionExecution b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> (AnnActionExecution b (Const Void) (UnpreparedValue b), Maybe RemoteJoins)
|
|
getRemoteJoinsSyncAction actionExecution =
|
|
let (fields', remoteJoins) = getRemoteJoinsAnnFields $ _aaeFields actionExecution
|
|
in (actionExecution { _aaeFields = fields' }, remoteJoins)
|
|
|
|
getRemoteJoinsActionQuery
|
|
:: (Backend b)
|
|
=> ActionQuery b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> (ActionQuery b (Const Void) (UnpreparedValue b), Maybe RemoteJoins)
|
|
getRemoteJoinsActionQuery = \case
|
|
AQQuery sync ->
|
|
first AQQuery $ getRemoteJoinsSyncAction sync
|
|
AQAsync async ->
|
|
first AQAsync $ getRemoteJoinsAsyncQuery async
|
|
where
|
|
getRemoteJoinsAsyncQuery async =
|
|
let (fields', remoteJoins) =
|
|
runCollector . transformAsyncFields $
|
|
_aaaqFields async
|
|
in (async { _aaaqFields = fields' }, remoteJoins)
|
|
|
|
transformAsyncFields fields =
|
|
for fields $ \(fieldName, field) -> withField fieldName do
|
|
(fieldName,) <$> case field of
|
|
AsyncTypename t -> pure $ AsyncTypename t
|
|
AsyncOutput outputFields ->
|
|
AsyncOutput <$> transformAnnFields outputFields
|
|
AsyncId -> pure AsyncId
|
|
AsyncCreatedAt -> pure AsyncCreatedAt
|
|
AsyncErrors -> pure AsyncErrors
|
|
|
|
getRemoteJoinsActionMutation
|
|
:: (Backend b)
|
|
=> ActionMutation b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> (ActionMutation b (Const Void) (UnpreparedValue b), Maybe RemoteJoins)
|
|
getRemoteJoinsActionMutation = \case
|
|
AMAsync async -> (AMAsync async, Nothing)
|
|
AMSync sync -> first AMSync $ getRemoteJoinsSyncAction sync
|
|
|
|
|
|
transformSelect
|
|
:: Backend b
|
|
=> AnnSimpleSelectG b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> Collector (AnnSimpleSelectG b (Const Void) (UnpreparedValue b))
|
|
transformSelect select@AnnSelectG{_asnFields = fields} = do
|
|
-- Transform selects in array, object and computed fields
|
|
transformedFields <- transformAnnFields fields
|
|
pure select{_asnFields = transformedFields}
|
|
|
|
transformAggregateSelect
|
|
:: Backend b
|
|
=> AnnAggregateSelectG b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> Collector (AnnAggregateSelectG b (Const Void) (UnpreparedValue b))
|
|
transformAggregateSelect select@AnnSelectG{_asnFields = aggFields} = do
|
|
transformedFields <- for aggFields \(fieldName, aggField) ->
|
|
withField fieldName $ case aggField of
|
|
TAFAgg agg -> pure (fieldName, TAFAgg agg)
|
|
TAFExp t -> pure (fieldName, TAFExp t)
|
|
TAFNodes nodesAgg annFields -> do
|
|
transformed <- transformAnnFields annFields
|
|
pure (fieldName, TAFNodes nodesAgg transformed)
|
|
pure select{_asnFields = transformedFields}
|
|
|
|
transformConnectionSelect
|
|
:: forall b. Backend b
|
|
=> ConnectionSelect b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> Collector (ConnectionSelect b (Const Void) (UnpreparedValue b))
|
|
transformConnectionSelect connSelect@ConnectionSelect{..} = do
|
|
transformedFields <- for (_asnFields _csSelect) \(fieldName, connField) ->
|
|
withField fieldName $ case connField of
|
|
ConnectionTypename t -> pure (fieldName, ConnectionTypename t)
|
|
ConnectionPageInfo p -> pure (fieldName, ConnectionPageInfo p)
|
|
ConnectionEdges edges -> do
|
|
transformed <- transformEdges edges
|
|
pure (fieldName, ConnectionEdges transformed)
|
|
|
|
let select = _csSelect{_asnFields = transformedFields}
|
|
pure connSelect{ _csSelect = select }
|
|
where
|
|
transformEdges
|
|
:: [(FieldName, EdgeField b (RemoteSelect UnpreparedValue) (UnpreparedValue b))]
|
|
-> Collector [(FieldName, EdgeField b (Const Void) (UnpreparedValue b))]
|
|
transformEdges edgeFields = for edgeFields \(fieldName, edgeField) ->
|
|
withField fieldName $ case edgeField of
|
|
EdgeTypename t -> pure (fieldName, EdgeTypename t)
|
|
EdgeCursor -> pure (fieldName, EdgeCursor)
|
|
EdgeNode annFields -> do
|
|
transformed <- transformAnnFields annFields
|
|
pure (fieldName, EdgeNode transformed)
|
|
|
|
transformObjectSelect
|
|
:: Backend b
|
|
=> AnnObjectSelectG b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> Collector (AnnObjectSelectG b (Const Void) (UnpreparedValue b))
|
|
transformObjectSelect select@AnnObjectSelectG{_aosFields = fields} = do
|
|
transformedFields <- transformAnnFields fields
|
|
pure select{_aosFields = transformedFields}
|
|
|
|
transformAnnFields
|
|
:: forall b . Backend b
|
|
=> AnnFieldsG b (RemoteSelect UnpreparedValue) (UnpreparedValue b)
|
|
-> Collector (AnnFieldsG b (Const Void) (UnpreparedValue b))
|
|
transformAnnFields fields = do
|
|
-- Produces a list of transformed fields that may or may not have an
|
|
-- associated remote join.
|
|
annotatedFields <- for fields \(fieldName, field') -> withField fieldName do
|
|
-- FIXME: There's way too much going on in this 'case .. of' block...
|
|
(fieldName,) <$> case field' of
|
|
-- 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 <- transformAnnRelation transformObjectSelect annRel
|
|
pure (AFObjectRelation transformed, Nothing)
|
|
AFArrayRelation (ASSimple annRel) -> do
|
|
transformed <- transformAnnRelation transformSelect annRel
|
|
pure (AFArrayRelation . ASSimple $ transformed, Nothing)
|
|
AFArrayRelation (ASAggregate aggRel) -> do
|
|
transformed <- transformAnnRelation transformAggregateSelect aggRel
|
|
pure (AFArrayRelation . ASAggregate $ transformed, Nothing)
|
|
AFArrayRelation (ASConnection annRel) -> do
|
|
transformed <- transformAnnRelation 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.
|
|
--
|
|
-- 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.
|
|
AFRemote (RemoteSelectRemoteSchema RemoteSchemaSelect{..}) ->
|
|
let
|
|
annotatedJoinColumns =
|
|
Map.fromList $ map annotateDBJoinField (toList _rselHasuraFields)
|
|
phantomColumns = annotatedJoinColumns & Map.mapMaybe \(columnInfo, alias) ->
|
|
case alias of
|
|
JCSelected _ -> Nothing
|
|
JCPhantom a -> Just (columnInfo, a)
|
|
joinColumnAliases = fmap snd annotatedJoinColumns
|
|
inputArgsToMap = Map.fromList . map (_rfaArgument &&& _rfaValue)
|
|
remoteJoin = RemoteJoinRemoteSchema $ RemoteSchemaJoin
|
|
(inputArgsToMap _rselArgs)
|
|
_rselResultCustomizer
|
|
_rselSelection
|
|
joinColumnAliases
|
|
_rselFieldCall
|
|
_rselRemoteSchema
|
|
annotatedJoin = Just (phantomColumns, remoteJoin)
|
|
in
|
|
pure (remoteAnnPlaceholder, annotatedJoin)
|
|
|
|
let
|
|
transformedFields = (fmap . fmap) fst annotatedFields
|
|
remoteJoins = annotatedFields & mapMaybe \(fieldName, (_, mRemoteJoin)) ->
|
|
mRemoteJoin <&> \remoteJoin -> (fieldName, remoteJoin)
|
|
case NE.nonEmpty remoteJoins of
|
|
Nothing -> pure transformedFields
|
|
Just neRemoteJoins -> do
|
|
let
|
|
phantomFields =
|
|
(Map.elems . Map.unions . map (fst . snd) $ remoteJoins) <&>
|
|
\(joinField, alias) -> case joinField of
|
|
JoinColumn columnInfo ->
|
|
let column = AFColumn $ AnnColumnField columnInfo False Nothing Nothing
|
|
in (alias, column)
|
|
JoinComputedField computedFieldInfo ->
|
|
(alias, mkScalarComputedFieldSelect computedFieldInfo)
|
|
collect $ (fmap . fmap) snd neRemoteJoins
|
|
pure $ transformedFields <> phantomFields
|
|
where
|
|
-- Placeholder text to annotate a remote relationship field.
|
|
remoteAnnPlaceholder :: AnnFieldG b (Const Void) (UnpreparedValue b)
|
|
remoteAnnPlaceholder = AFExpression "remote relationship placeholder"
|
|
|
|
-- Annotate a 'DBJoinField' with its field name and an alias so that it may
|
|
-- be used to construct a remote join.
|
|
annotateDBJoinField :: DBJoinField b -> (FieldName, (DBJoinField b, JoinColumnAlias))
|
|
annotateDBJoinField = \case
|
|
jc@(JoinColumn columnInfo) ->
|
|
let
|
|
column = pgiColumn columnInfo
|
|
columnFieldName = fromCol @b $ column
|
|
alias = getJoinColumnAlias columnFieldName column columnFields
|
|
in
|
|
(columnFieldName, (jc, alias))
|
|
jcf@(JoinComputedField ScalarComputedField{..}) ->
|
|
let
|
|
computedFieldName = fromComputedField _scfName
|
|
alias = getJoinColumnAlias computedFieldName _scfName computedFields
|
|
in
|
|
(computedFieldName, (jcf, alias))
|
|
|
|
-- 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)
|
|
|
|
-- This is a map of column name to its alias of all columns in the
|
|
-- selection set.
|
|
columnFields :: HashMap (Column b) FieldName
|
|
columnFields = Map.fromList $
|
|
[ (pgiColumn . _acfInfo $ 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
|
|
]
|
|
|
|
getJoinColumnAlias
|
|
:: (Eq field, Hashable field)
|
|
=> FieldName
|
|
-> field
|
|
-> HashMap field FieldName
|
|
-> JoinColumnAlias
|
|
getJoinColumnAlias fieldName field selectedFields =
|
|
case Map.lookup field selectedFields of
|
|
Nothing -> makeUniqueAlias fieldName
|
|
Just fieldAlias -> JCSelected fieldAlias
|
|
|
|
longestAliasLength = maximum $ map (T.length . coerce . fst) fields
|
|
|
|
-- This generates an alias for a phantom field that does not conflict with
|
|
-- any of the existing aliases in the seleciton 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
|
|
makeUniqueAlias :: FieldName -> JoinColumnAlias
|
|
makeUniqueAlias fieldName =
|
|
let suffix = "_join_column" <>
|
|
-- 12 is the length of "_join_column"
|
|
T.replicate ((longestAliasLength - (T.length (coerce fieldName) + 12)) + 1) "_"
|
|
in JCPhantom $ fieldName <> FieldName suffix
|
|
|
|
transformAnnRelation
|
|
:: (t -> Collector a)
|
|
-> AnnRelationSelectG b t
|
|
-> Collector (AnnRelationSelectG b a)
|
|
transformAnnRelation transform relation@(AnnRelationSelectG _ _ select) = do
|
|
transformedSelect <- transform select
|
|
pure $ relation{ aarAnnSelect = transformedSelect }
|
|
|
|
mkScalarComputedFieldSelect
|
|
:: ScalarComputedField b
|
|
-> (AnnFieldG b (Const 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
|