graphql-engine/server/src-lib/Hasura/RQL/IR/RemoteSchema.hs
Solomon c945b2d391 Replaces litName splices with name quasiquotes
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4267
GitOrigin-RevId: 2d93c35a7e34dbada3b72aabcae5fc2858bbfc29
2022-04-18 19:44:04 +00:00

348 lines
12 KiB
Haskell

{-# LANGUAGE TemplateHaskell #-}
-- | 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
( -- AST
SelectionSet (..),
DeduplicatedSelectionSet (..),
dssCommonFields,
dssMemberSelectionSets,
ObjectSelectionSet,
mkInterfaceSelectionSet,
mkUnionSelectionSet,
Field (..),
_FieldGraphQL,
_FieldRemote,
GraphQLField (..),
fAlias,
fName,
fArguments,
fDirectives,
fSelectionSet,
mkGraphQLField,
-- entry points
RemoteSchemaRootField (..),
SchemaRemoteRelationshipSelect (..),
RemoteFieldArgument (..),
RemoteSchemaSelect (..),
-- AST conversion
convertSelectionSet,
convertGraphQLField,
)
where
import Control.Lens.TH (makeLenses, 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.Constants qualified as G
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
_dssCommonFields :: !(Set.HashSet G.Name),
-- | SelectionSets of individual member types
_dssMemberSelectionSets :: !(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.___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.___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
}
deriving (Eq, Show)
data RemoteSchemaSelect r = RemoteSchemaSelect
{ _rselArgs :: [RemoteFieldArgument],
_rselResultCustomizer :: ResultCustomizer,
_rselSelection :: SelectionSet r 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
-------------------------------------------------------------------------------
-- TH lens generation
$(makePrisms ''Field)
$(makeLenses ''GraphQLField)
$(makeLenses ''DeduplicatedSelectionSet)