-- | Types for representing a GraphQL schema. module Hasura.GraphQL.Parser.Schema ( -- * Kinds Kind (..), (:<:) (..), type (<:) (..), -- * Types MkTypename (..), mkTypename, withTypenameCustomization, Type (..), NonNullableType (..), TypeInfo (..), getTypeInfo, SomeTypeInfo (..), eqType, eqNonNullableType, eqTypeInfo, discardNullability, nullableType, nonNullableType, toGraphQLType, getObjectInfo, getInterfaceInfo, EnumValueInfo (..), InputFieldInfo (..), FieldInfo (..), InputObjectInfo (..), ObjectInfo (..), InterfaceInfo (..), UnionInfo (..), -- * Definitions Definition (..), -- * Schemas Schema (..), ConflictingDefinitions (..), HasTypeDefinitions (..), TypeDefinitionsWrapper (..), collectTypeDefinitions, -- * Miscellany HasName (..), InputValue (..), Variable (..), VariableInfo (..), DirectiveInfo (..), ) where import Control.Lens.Extended import Data.Aeson qualified as J import Data.Functor.Classes import Data.Has import Data.HashMap.Strict.Extended qualified as Map import Data.HashSet qualified as Set import Data.Hashable (Hashable (..)) import Data.List.NonEmpty qualified as NE import Data.Monoid import Data.Text qualified as T import Data.Text.Extended import Hasura.Incremental (Cacheable) import Hasura.Prelude import Language.GraphQL.Draft.Syntax ( Description (..), DirectiveLocation (..), GType (..), Name (..), Nullability (..), Value (..), ) class HasName a where getName :: a -> Name instance HasName Name where getName = id -- | Type name customization newtype MkTypename = MkTypename {runMkTypename :: Name -> Name} deriving (Semigroup, Monoid) via (Endo Name) -- | Inject a new @MkTypename@ customization function into the environment. -- This can be used by schema-building code (with @MonadBuildSchema@ constraint) to ensure -- the correct type name customizations are applied. withTypenameCustomization :: forall m r a. (MonadReader r m, Has MkTypename r) => MkTypename -> m a -> m a withTypenameCustomization = local . set hasLens -- | Apply the type name customization function from the current environment. mkTypename :: (MonadReader r m, Has MkTypename r) => Name -> m Name mkTypename name = ($ name) . runMkTypename <$> asks getter -- | GraphQL types are divided into two classes: input types and output types. -- The GraphQL spec does not use the word “kind” to describe these classes, but -- it’s an apt term. -- -- Some GraphQL types can be used at either kind, so we also include the 'Both' -- kind, the superkind of both 'Input' and 'Output'. The '<:' class provides -- kind subsumption constraints. -- -- For more details, see . data Kind = -- | see Note [The 'Both kind] Both | Input | Output {- Note [The 'Both kind] ~~~~~~~~~~~~~~~~~~~~~~~~ As described in the Haddock comments for Kind and <:, we use Kind to index various types, such as Type and Parser. We use this to enforce various correctness constraints mandated by the GraphQL spec; for example, we don’t allow input object fields to have output types and we don’t allow output object fields to have input types. But scalars and enums can be used as input types *or* output types. A natural encoding of that in Haskell would be to make constructors for those types polymorphic, like this: data Kind = Input | Output data TypeInfo k where TIScalar :: TypeInfo k -- \ Polymorphic! TIEnum :: ... -> TypeInfo k -- / TIInputObject :: ... -> TypeInfo 'Input TIObject :: ... -> TypeInfo 'Output Naturally, this would give the `scalar` parser constructor a similarly polymorphic type: scalar :: MonadParse m => Name -> Maybe Description -> ScalarRepresentation a -> Parser k m a -- Polymorphic! But if we actually try that, we run into problems. The trouble is that we want to use the Kind to influence several different things: * As mentioned above, we use it to ensure that the types we generate are well-kinded according to the GraphQL spec rules. * We use it to determine what a Parser consumes as input. Parsers for input types parse GraphQL input values, but Parsers for output types parse selection sets. (See Note [The meaning of Parser 'Output] in Hasura.GraphQL.Parser.Internal.Parser for an explanation of why.) * We use it to know when to expect a sub-selection set for a field of an output object (see Note [The delicate balance of GraphQL kinds]). These many uses of Kind cause some trouble for a polymorphic representation. For example, consider our `scalar` parser constructor above---if we were to instantiate it at kind 'Output, we’d receive a `Parser 'Output`, which we would then expect to be able to apply to a selection set. But that doesn’t make any sense, since scalar fields don’t have selection sets! Another issue with this representation has to do with effectful parser constructors (such as constructors that can throw errors). These have types like mkFooParser :: MonadSchema n m => Blah -> m (Parser k n Foo) where the parser construction is itself monadic. This causes some annoyance, since even if mkFooParser returns a Parser of a polymorphic kind, code like this will not typecheck: (fooParser :: forall k. Parser k n Foo) <- mkFooParser blah The issue is that we have to instantiate k to a particular type to be able to call mkFooParser. If we want to use the result at both kinds, we’d have to call mkFooParser twice: (fooInputParser :: Parser 'Input n Foo) <- mkFooParser blah (fooOutputParser :: Parser 'Output n Foo) <- mkFooParser blah Other situations encounter similar difficulties, and they are not easy to resolve without impredicative polymorphism (which GHC does not support). To avoid this problem, we don’t use polymorphic kinds, but instead introduce a form of kind subsumption. Types that can be used as both input and output types are explicitly given the kind 'Both. This allows us to get the best of both worlds: * We use the <: typeclass to accept 'Both in most places where we expect either input or output types. * We can treat 'Both specially to avoid requiring `scalar` to supply a selection set parser (see Note [The delicate balance of GraphQL kinds] for further explanation). * Because we avoid the polymorphism, we don’t run into the aforementioned issue with monadic parser constructors. All of this is subtle and somewhat complicated, but unfortunately there isn’t much of a way around that: GraphQL is subtle and complicated. Our use of an explicit 'Both kind isn’t the only way to encode these things, but it’s the particular set of compromises we’ve chosen to accept. Note [The delicate balance of GraphQL kinds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As discussed in Note [The 'Both kind], we use GraphQL kinds to distinguish several different things. One of them is which output types take sub-selection sets. For example, scalars don’t accept sub-selection sets, so if we have a schema like type Query { users: [User!]! } type User { id: Int! } then the following query is illegal: query { users { id { blah } } } The id field has a scalar type, so it should not take a sub-selection set. This is actually something we care about distinguishing at the type level, because it affects the type of the `selection` parser combinator. Suppose we have a `Parser 'Output m UserQuery` for the User type. When we parse a field with that type, we expect to receive a UserQuery as a result, unsurprisingly. But what if we parse an output field using the `int` parser, which has this type: int :: MonadParse m => Parser 'Both m Int32 If we follow the same logic as for the User parser above, we’d expect to receive an Int32 as a result... but that doesn’t make any sense, since the Int32 corresponds to the result *we* are suppose to produce as a result of executing the query, not something user-specified. One way to solve this would be to associate every Parser with two result types: one when given an input object, and one when given a selection set. Then our parsers could be given these types, instead: user :: MonadParse m => Parser 'Output m Void UserQuery int :: MonadParse m => Parser 'Both m Int32 () But if you work through this, you’ll find that *all* parsers will either have Void or () for at least one of their input result types or their output result types, depending on their kind: * All 'Input parsers must have Void for their output result type, since they aren’t allowed to be used in output contexts at all. * All 'Output parsers must have Void for their input result type, since they aren’t allowed to be used in input contexts at all. * That just leaves 'Both. The only types of kind 'Both are scalars and enums, neither of which accept a sub-selection set. Their output result type would therefore be (), since they are allowed to appear in output contexts, but they don’t return any results. The end result of this is that we clutter all our types with Voids and ()s, with little actual benefit. If you really think about it, the fact that the no types of kind 'Both accept a sub-selection set is really something of a coincidence. In theory, one could imagine a future version of the GraphQL spec adding a type that can be used as both an input type or an output type, but accepts a sub-selection set. If that ever happens, we’ll have to tweak our encoding, but for now, we can take advantage of this happy coincidence and make the kinds serve double duty: * We can make `ParserInput 'Both` identical to `ParserInput 'Input`, since all parsers of kind 'Both only parse input values. * We can require types of kind 'Both in `selection`, which does not expect a sub-selection set, and types of kind 'Output in `subselection`, which does. Relying on this coincidence might seem a little gross, and perhaps it is somewhat. But it’s enormously convenient: not doing this would make some types significantly more complicated, since we would have to thread around more information at the type level and we couldn’t make as many simplifying assumptions. So until GraphQL adds a type that violates these assumptions, we are happy to take advantage of this coincidence. -} -- | Evidence for '<:'. data k1 :<: k2 where KRefl :: k :<: k KBoth :: k :<: 'Both -- | 'Kind' subsumption. The GraphQL kind hierarchy is extremely simple: -- -- > Both -- > / \ -- > Input Output -- -- Various functions in this module use '<:' to allow 'Both' to be used in -- places where 'Input' or 'Output' would otherwise be expected. class k1 <: k2 where subKind :: k1 :<: k2 instance k1 ~ k2 => k1 <: k2 where subKind = KRefl instance {-# OVERLAPPING #-} k <: 'Both where subKind = KBoth data Type k = NonNullable (NonNullableType k) | Nullable (NonNullableType k) instance Eq (Type k) where (==) = eqType -- | Like '==', but can compare 'Type's of different kinds. eqType :: Type k1 -> Type k2 -> Bool eqType (NonNullable a) (NonNullable b) = eqNonNullableType a b eqType (Nullable a) (Nullable b) = eqNonNullableType a b eqType _ _ = False instance HasName (Type k) where getName = getName . discardNullability discardNullability :: Type k -> NonNullableType k discardNullability (NonNullable t) = t discardNullability (Nullable t) = t nullableType :: Type k -> Type k nullableType (NonNullable t) = Nullable t -- Defined like this to preserve sharing nullableType t@(Nullable {}) = t nonNullableType :: Type k -> Type k nonNullableType (Nullable t) = NonNullable t nonNullableType t@(NonNullable {}) = t data NonNullableType k = TNamed (Definition (TypeInfo k)) | TList (Type k) instance Eq (NonNullableType k) where (==) = eqNonNullableType toGraphQLType :: Type k -> GType toGraphQLType = \case NonNullable t -> translateWith False t Nullable t -> translateWith True t where translateWith nullability = \case TNamed typeInfo -> TypeNamed (Nullability nullability) $ getName typeInfo TList typeInfo -> TypeList (Nullability nullability) $ toGraphQLType typeInfo -- | Like '==', but can compare 'NonNullableType's of different kinds. eqNonNullableType :: NonNullableType k1 -> NonNullableType k2 -> Bool eqNonNullableType (TNamed a) (TNamed b) = liftEq eqTypeInfo a b eqNonNullableType (TList a) (TList b) = eqType a b eqNonNullableType _ _ = False instance HasName (NonNullableType k) where getName (TNamed definition) = getName definition getName (TList t) = getName t {- Note [The interfaces story] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GraphQL interfaces are not conceptually complicated, but they pose some non-obvious challenges for our implementation. First, familiarize yourself with GraphQL interfaces themselves: * https://graphql.org/learn/schema/#interfaces * http://spec.graphql.org/June2018/#sec-Interfaces * http://spec.graphql.org/June2018/#sec-Objects The most logical repesentation of object and interface types is to have objects reference the interfaces they implement, but not the other way around. After all, that’s how it works in the GraphQL language: when you declare an interface, you just specify its fields, and you specify which interfaces each object type implements as part of their declarations. However, this representation is actually not very useful for us. We /also/ need the interfaces to reference the objects that implement them---forming a circular structure---for two reasons: 1. Most directly, we need this information for introspection queries. Introspection queries for object types return the set of interfaces they implement , and introspection queries for interfaces return the set of object types that implement them . 2. Less obviously, it’s more natural to specify the relationships “backwards” like this when building the schema using the parser combinator language. From the parser’s point of view, each implementation of an interface corresponds to a distinct parsing possibility. For example, when we generate a Relay schema, the type of the `node` root field is an interface, and each table is a type that implements it: type query_root { node(id: ID!): Node ... } interface Node { id: ID! } type author implements Node { id: ID! name: String! ... } type article implements Node { id: ID! title: String! body: String! ... } A query will use fragments on the Node type to access table-specific fields: query get_article_info($article_id: ID!) { node(id: $article_id) { ... on article { title body } } } The query parser needs to know which types implement the interface (and how to parse their selection sets) so that it can parse the fragments. This presents some complications, since we need to build this information in a circular fashion. Currently, we do this in a very naïve way: * We require selectionSetObject to specify the interfaces it implements /and/ require selectionSetInterface to specify the objects that implement it. * We take advantage of our existing memoization mechanism to do the knot-tying for us (see Note [Tying the knot] in Hasura.GraphQL.Parser.Class). You may notice that this makes it possible for the definitions to be inconsistent: we could construct an interface parser that parses some object type, but forget to specify that the object type implements the interface. This inconsistency is currently completely unchecked, which is quite unfortunate. It also means we don’t support remote schema-defined object types that implement interfaces we generate, since we don’t know anything about those types when we construct the interface. Since we don’t make very much use of interface types at the time of this writing, this isn’t much of a problem in practice. But if that changes, it would be worth implementing a more sophisticated solution that can gather up all the different sources of information and make sure they’re consistent. -} data InputObjectInfo = InputObjectInfo ~[Definition InputFieldInfo] -- Note that we can't check for equality of the fields since there may be -- circularity. So we rather check for equality of names. instance Eq InputObjectInfo where InputObjectInfo fields1 == InputObjectInfo fields2 = Set.fromList (fmap dName fields1) == Set.fromList (fmap dName fields2) data ObjectInfo = ObjectInfo { -- | The fields that this object has. This consists of the fields of the -- interfaces that it implements, as well as any additional fields. oiFields :: ~[Definition FieldInfo], -- | The interfaces that this object implements (inheriting all their -- fields). See Note [The interfaces story] for more details. oiImplements :: ~[Definition InterfaceInfo] } -- Note that we can't check for equality of the fields and the interfaces since -- there may be circularity. So we rather check for equality of names. instance Eq ObjectInfo where ObjectInfo fields1 interfaces1 == ObjectInfo fields2 interfaces2 = Set.fromList (fmap dName fields1) == Set.fromList (fmap dName fields2) && Set.fromList (fmap dName interfaces1) == Set.fromList (fmap dName interfaces2) -- | Type information for a GraphQL interface; see Note [The interfaces story] -- for more details. -- -- Note: in the current working draft of the GraphQL specification (> June -- 2018), interfaces may implement other interfaces, but we currently don't -- support this. data InterfaceInfo = InterfaceInfo { -- | Fields declared by this interface. Every object implementing this -- interface must include those fields. iiFields :: ~[Definition FieldInfo], -- | Objects that implement this interface. See Note [The interfaces story] -- for why we include that information here. iiPossibleTypes :: ~[Definition ObjectInfo] } -- Note that we can't check for equality of the fields and the interfaces since -- there may be circularity. So we rather check for equality of names. instance Eq InterfaceInfo where InterfaceInfo fields1 objects1 == InterfaceInfo fields2 objects2 = Set.fromList (fmap dName fields1) == Set.fromList (fmap dName fields2) && Set.fromList (fmap dName objects1) == Set.fromList (fmap dName objects2) data UnionInfo = UnionInfo { -- | The member object types of this union. uiPossibleTypes :: ~[Definition ObjectInfo] } data TypeInfo k where TIScalar :: TypeInfo 'Both TIEnum :: NonEmpty (Definition EnumValueInfo) -> TypeInfo 'Both TIInputObject :: InputObjectInfo -> TypeInfo 'Input TIObject :: ObjectInfo -> TypeInfo 'Output TIInterface :: InterfaceInfo -> TypeInfo 'Output TIUnion :: UnionInfo -> TypeInfo 'Output instance Eq (TypeInfo k) where (==) = eqTypeInfo -- | Like '==', but can compare 'TypeInfo's of different kinds. eqTypeInfo :: TypeInfo k1 -> TypeInfo k2 -> Bool eqTypeInfo TIScalar TIScalar = True eqTypeInfo (TIEnum values1) (TIEnum values2) = Set.fromList (toList values1) == Set.fromList (toList values2) -- NB the case for input objects currently has quadratic complexity, which is -- probably avoidable. HashSets should be able to get this down to -- O(n*log(n)). But this requires writing some Hashable instances by hand -- because we use some existential types and GADTs. eqTypeInfo (TIInputObject ioi1) (TIInputObject ioi2) = ioi1 == ioi2 eqTypeInfo (TIObject oi1) (TIObject oi2) = oi1 == oi2 eqTypeInfo (TIInterface ii1) (TIInterface ii2) = ii1 == ii2 eqTypeInfo (TIUnion (UnionInfo objects1)) (TIUnion (UnionInfo objects2)) = Set.fromList (fmap dName objects1) == Set.fromList (fmap dName objects2) eqTypeInfo _ _ = False getTypeInfo :: Type k -> Definition (TypeInfo k) getTypeInfo t = case discardNullability t of TNamed d -> d TList t' -> getTypeInfo t' getObjectInfo :: Type k -> Maybe (Definition ObjectInfo) getObjectInfo t = case getTypeInfo t of d@Definition {dInfo = TIObject oi} -> Just d {dInfo = oi} _ -> Nothing getInterfaceInfo :: Type k -> Maybe (Definition InterfaceInfo) getInterfaceInfo t = case getTypeInfo t of d@Definition {dInfo = TIInterface ii} -> Just d {dInfo = ii} _ -> Nothing data SomeTypeInfo = forall k. SomeTypeInfo (TypeInfo k) instance Eq SomeTypeInfo where SomeTypeInfo a == SomeTypeInfo b = eqTypeInfo a b data Definition a = Definition { dName :: Name, dDescription :: Maybe Description, -- | Lazy to allow mutually-recursive type definitions. dInfo :: ~a } deriving (Functor, Foldable, Traversable, Generic) instance Hashable a => Hashable (Definition a) where hashWithSalt salt Definition {..} = salt `hashWithSalt` dName `hashWithSalt` dInfo instance Eq a => Eq (Definition a) where (==) = eq1 instance Eq1 Definition where liftEq eq (Definition name1 _ info1) (Definition name2 _ info2) = name1 == name2 && eq info1 info2 instance HasName (Definition a) where getName = dName -- | Enum values have no extra information except for the information common to -- all definitions, so this is just a placeholder for use as @'Definition' -- 'EnumValueInfo'@. data EnumValueInfo = EnumValueInfo deriving (Eq, Generic) instance Hashable EnumValueInfo data InputFieldInfo = -- | A required field with a non-nullable type. forall k. ('Input <: k) => IFRequired (NonNullableType k) | -- | An optional input field with a nullable type and possibly a default -- value. If a default value is provided, it should be a valid value for the -- type. -- -- Note that a default value of 'VNull' is subtly different from having no -- default value at all. If no default value is provided, the GraphQL -- specification allows distinguishing provided @null@ values from values left -- completely absent; see Note [Optional fields and nullability] in -- Hasura.GraphQL.Parser.Internal.Parser. forall k. ('Input <: k) => IFOptional (Type k) (Maybe (Value Void)) instance Eq InputFieldInfo where IFRequired t1 == IFRequired t2 = eqNonNullableType t1 t2 IFOptional t1 v1 == IFOptional t2 v2 = eqType t1 t2 && v1 == v2 _ == _ = False data FieldInfo = forall k. ('Output <: k) => FieldInfo { fArguments :: [Definition InputFieldInfo], fType :: Type k } instance Eq FieldInfo where FieldInfo args1 t1 == FieldInfo args2 t2 = args1 == args2 && eqType t1 t2 {- Note [Parsing variable values] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GraphQL includes its own tiny language for input values, which is similar to JSON but not quite the same---GraphQL input values can be enum values, and there are restrictions on the names of input object keys. Despite these differences, variables’ values are passed as JSON, so we actually need to be able to parse values expressed in both languages. It’s tempting to contain this complexity by simply converting the JSON values to GraphQL input values up front, and for booleans, numbers, arrays, and most objects, this conversion is viable. But JSON strings pose a problem, since they are used to represent both GraphQL strings and GraphQL enums. For example, consider a query like this: enum FooBar { FOO BAR } query some_query($a: String, $b: FooBar) { ... } We might receive an accompany variables payload like this: { "a": "FOO", "b": "FOO" } To properly convert these JSON values to GraphQL, we’d need to use the type information to guide the parsing. Since $a has type String, its value should be parsed as the GraphQL string "FOO", while $b has type FooBar, so its value should be parsed as the GraphQL enum value FOO. We could do this type-directed parsing, but there are some advantages to being lazier. For one, we can use JSON values directly when used as a column value of type json or jsonb, rather than converting them to GraphQL and back; which, in turn, solves another problem with JSON objects: JSON object keys are arbitrary strings, while GraphQL input object keys are GraphQL names, and therefore restricted: not all JSON objects can be represented by a GraphQL input object. Arguably such columns should really be represented as strings containing encoded JSON, not GraphQL lists/objects, but the decision to treat them otherwise is old, and it would be backwards-incompatible to change now. We can also avoid needing to interpret the values of variables for types outside our control (i.e. those from a remote schema), which can be useful in the case of custom scalars or extensions of the GraphQL protocol. So instead we use the InputValue type to represent that an input value might be a GraphQL literal value or a JSON value from the variables payload. This means each input parser constructor needs to be able to parse both GraphQL values and JSON values, but fortunately, the duplication of logic is minimal. -} -- | See Note [Parsing variable values]. data InputValue v = GraphQLValue (Value v) | JSONValue J.Value deriving (Show, Eq, Functor, Generic, Ord) instance (Hashable v) => Hashable (InputValue v) instance (Cacheable v) => Cacheable (InputValue v) data Variable = Variable { vInfo :: VariableInfo, vType :: GType, -- | Note: if the variable was null or was not provided and the field has a -- non-null default value, this field contains the default value, not 'VNull'. vValue :: InputValue Void } deriving (Show, Eq, Generic, Ord) instance Hashable Variable instance Cacheable Variable data VariableInfo = VIRequired Name | -- | Unlike fields (see 'IFOptional'), nullable variables with no default -- value are indistinguishable from variables with a default value of null, so -- we don’t distinguish those cases here. VIOptional Name (Value Void) deriving (Show, Eq, Generic, Ord) instance Hashable VariableInfo instance Cacheable VariableInfo instance HasName Variable where getName = getName . vInfo instance HasName VariableInfo where getName (VIRequired name) = name getName (VIOptional name _) = name -- ----------------------------------------------------------------------------- -- support for introspection queries -- | This type represents the directives information to be served over GraphQL introspection data DirectiveInfo = DirectiveInfo { diName :: !Name, diDescription :: !(Maybe Description), diArguments :: ![Definition InputFieldInfo], diLocations :: ![DirectiveLocation] } -- | This type contains all the information needed to efficiently serve GraphQL -- introspection queries. It corresponds to the GraphQL @__Schema@ type defined -- in <§ 4.5 Schema Introspection http://spec.graphql.org/June2018/#sec-Introspection>. data Schema = Schema { sDescription :: Maybe Description, sTypes :: HashMap Name (Definition SomeTypeInfo), sQueryType :: Type 'Output, sMutationType :: Maybe (Type 'Output), sSubscriptionType :: Maybe (Type 'Output), sDirectives :: [DirectiveInfo] } data TypeDefinitionsWrapper where TypeDefinitionsWrapper :: HasTypeDefinitions a => a -> TypeDefinitionsWrapper -- | Recursively collects all type definitions accessible from the given value. collectTypeDefinitions :: HasTypeDefinitions a => a -> Either ConflictingDefinitions (HashMap Name (Definition SomeTypeInfo)) collectTypeDefinitions x = fmap (fmap fst) $ runExcept $ flip execStateT Map.empty $ flip runReaderT (TypeOriginStack []) $ runTypeAccumulation $ accumulateTypeDefinitions x newtype TypeOriginStack = TypeOriginStack [Name] -- Add the current field name to the origin stack typeOriginRecurse :: Name -> TypeOriginStack -> TypeOriginStack typeOriginRecurse field (TypeOriginStack origins) = TypeOriginStack (field : origins) -- This is kind of a hack to make sure that the query root name is part of the origin stack typeRootRecurse :: Name -> TypeOriginStack -> TypeOriginStack typeRootRecurse rootName (TypeOriginStack []) = (TypeOriginStack [rootName]) typeRootRecurse _ x = x instance ToTxt TypeOriginStack where toTxt (TypeOriginStack fields) = T.intercalate "." $ toTxt <$> reverse fields data ConflictingDefinitions = -- | Type collection has found at least two types with the same name. ConflictingDefinitions (Definition SomeTypeInfo, TypeOriginStack) (Definition SomeTypeInfo, NonEmpty TypeOriginStack) -- | Although the majority of graphql-engine is written in terms of abstract -- mtl-style effect monads, we figured out that this particular codepath is -- quite hot, and that mtl has a measurable negative effect for accumulating -- types from the schema, both in profiling and in benchmarking. Using an -- explicit transformers-style effect stack seems to overall memory usage by -- about 3-7%. newtype TypeAccumulation a = TypeAccumulation { runTypeAccumulation :: ReaderT TypeOriginStack ( StateT (HashMap Name (Definition SomeTypeInfo, NonEmpty TypeOriginStack)) (ExceptT ConflictingDefinitions Identity) ) a } deriving (Functor, Applicative, Monad) deriving (MonadReader TypeOriginStack) deriving (MonadState (HashMap Name (Definition SomeTypeInfo, NonEmpty TypeOriginStack))) deriving (MonadError ConflictingDefinitions) class HasTypeDefinitions a where -- | Recursively accumulates all type definitions accessible from the given -- value. This is done statefully to avoid infinite loops arising from -- recursive type definitions; see Note [Tying the knot] in Hasura.GraphQL.Parser.Class. accumulateTypeDefinitions :: a -> TypeAccumulation () instance HasTypeDefinitions (Definition (TypeInfo k)) where accumulateTypeDefinitions definition = do -- This is the important case! We actually have a type definition, so we -- need to add it to the state. definitions <- get stack <- ask let new = SomeTypeInfo <$> definition case Map.lookup (dName new) definitions of Nothing -> do put $! Map.insert (dName new) (new, pure stack) definitions -- This type definition might reference other type definitions, so we -- still need to recur. local (typeRootRecurse (getName definition)) $ accumulateTypeDefinitions (dInfo definition) Just (old, origins) -- It’s important we /don’t/ recur if we’ve already seen this definition -- before to avoid infinite loops; see Note [Tying the knot] in Hasura.GraphQL.Parser.Class. | old == new -> put $! Map.insert (dName new) (old, stack `NE.cons` origins) definitions | otherwise -> throwError $ ConflictingDefinitions (new, stack) (old, origins) instance HasTypeDefinitions a => HasTypeDefinitions [a] where accumulateTypeDefinitions = traverse_ accumulateTypeDefinitions instance HasTypeDefinitions TypeDefinitionsWrapper where accumulateTypeDefinitions (TypeDefinitionsWrapper x) = accumulateTypeDefinitions x instance HasTypeDefinitions (Type k) where accumulateTypeDefinitions = \case NonNullable t -> accumulateTypeDefinitions t Nullable t -> accumulateTypeDefinitions t instance HasTypeDefinitions (NonNullableType k) where accumulateTypeDefinitions = \case TNamed d -> accumulateTypeDefinitions d TList t -> accumulateTypeDefinitions t instance HasTypeDefinitions (TypeInfo k) where accumulateTypeDefinitions = \case TIScalar -> pure () TIEnum _ -> pure () TIInputObject (InputObjectInfo fields) -> accumulateTypeDefinitions fields TIObject (ObjectInfo fields interfaces) -> accumulateTypeDefinitions fields >> accumulateTypeDefinitions interfaces TIInterface (InterfaceInfo fields objects) -> accumulateTypeDefinitions fields >> accumulateTypeDefinitions objects TIUnion (UnionInfo objects) -> accumulateTypeDefinitions objects instance HasTypeDefinitions (Definition InputObjectInfo) where accumulateTypeDefinitions = accumulateTypeDefinitions . fmap TIInputObject instance HasTypeDefinitions (Definition InputFieldInfo) where accumulateTypeDefinitions Definition {..} = local (typeOriginRecurse dName) $ accumulateTypeDefinitions dInfo instance HasTypeDefinitions InputFieldInfo where accumulateTypeDefinitions = \case IFRequired t -> accumulateTypeDefinitions t IFOptional t _ -> accumulateTypeDefinitions t instance HasTypeDefinitions (Definition FieldInfo) where accumulateTypeDefinitions Definition {..} = local (typeOriginRecurse dName) $ accumulateTypeDefinitions dInfo instance HasTypeDefinitions FieldInfo where accumulateTypeDefinitions (FieldInfo args t) = do accumulateTypeDefinitions args accumulateTypeDefinitions t instance HasTypeDefinitions (Definition ObjectInfo) where accumulateTypeDefinitions d@Definition {..} = local (typeOriginRecurse dName) $ accumulateTypeDefinitions (fmap TIObject d) instance HasTypeDefinitions (Definition InterfaceInfo) where accumulateTypeDefinitions d@Definition {..} = local (typeOriginRecurse dName) $ accumulateTypeDefinitions (fmap TIInterface d) instance HasTypeDefinitions (Definition UnionInfo) where accumulateTypeDefinitions d@Definition {..} = local (typeOriginRecurse dName) $ accumulateTypeDefinitions (fmap TIUnion d)