Validate arguments are defined

This commit is contained in:
Eugen Wissner 2020-09-28 07:06:15 +02:00
parent ced9b815db
commit 4602eb1df3
19 changed files with 375 additions and 185 deletions

View File

@ -23,6 +23,7 @@ and this project adheres to
the path without executing the query.
- `Error.Error`: `path` added. It is currently always empty.
- `Validate.Validation.Path` was moved to `Error`.
- `Type.Schema.Schema` gets an additional field, `Schema.directives`.
### Added
- `Validate.Validation.Rule` constructors:
@ -32,6 +33,7 @@ and this project adheres to
- `ArgumentsRule`
- `DirectivesRule`
- `VariablesRule`
- `FieldRule`
- `Validate.Rules`:
- `fragmentsOnCompositeTypesRule`
- `fragmentSpreadTargetDefinedRule`
@ -48,10 +50,15 @@ and this project adheres to
- `uniqueInputFieldNamesRule`
- `fieldsOnCorrectTypeRule`
- `scalarLeafsRule`
- `knownArgumentNamesRule`
- `AST.Document.Field`.
- `AST.Document.FragmentSpread`.
- `AST.Document.InlineFragment`.
- `AST.Document.Node`.
- `Type.In.Arguments`: Type alias for an argument map.
- `Type.Schema.Directive` and `Type.Schema.Directives` are directive definition
representation.
- `Type.Schema.schema`: Shortcut for creating a schema.
### Fixed
- Collecting existing types from the schema considers subscriptions.

View File

@ -18,7 +18,7 @@ import Language.GraphQL.AST
import Language.GraphQL.Error
import Language.GraphQL.Execute
import qualified Language.GraphQL.Validate as Validate
import Language.GraphQL.Type.Schema
import Language.GraphQL.Type.Schema (Schema)
import Text.Megaparsec (parse)
-- | If the text parses correctly as a @GraphQL@ query the query is

View File

@ -32,8 +32,8 @@ execute :: (MonadCatch m, VariableValue a, Serialize b)
-> HashMap Name a -- ^ Variable substitution function.
-> Document -- @GraphQL@ document.
-> m (Either (ResponseEventStream m b) (Response b))
execute schema operationName subs document =
case Transform.document schema operationName subs document of
execute schema' operationName subs document =
case Transform.document schema' operationName subs document of
Left queryError -> pure
$ Right
$ singleError

View File

@ -49,14 +49,15 @@ import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type as Type
import Language.GraphQL.Type.Internal
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema
import Language.GraphQL.Type.Schema (Schema)
import qualified Language.GraphQL.Type.Schema as Schema
-- | Associates a fragment name with a list of 'Field's.
data Replacement m = Replacement
{ fragments :: HashMap Full.Name (Fragment m)
, fragmentDefinitions :: FragmentDefinitions
, variableValues :: Type.Subs
, types :: HashMap Full.Name (Type m)
, types :: HashMap Full.Name (Schema.Type m)
}
type FragmentDefinitions = HashMap Full.Name Full.FragmentDefinition
@ -84,7 +85,7 @@ data Field m = Field
-- | Contains the operation to be executed along with its root type.
data Document m = Document
(HashMap Full.Name (Type m)) (Out.ObjectType m) (Operation m)
(HashMap Full.Name (Schema.Type m)) (Out.ObjectType m) (Operation m)
data OperationDefinition = OperationDefinition
Full.OperationType
@ -140,7 +141,7 @@ getOperation (Just operationName) operations
coerceVariableValues :: Coerce.VariableValue a
=> forall m
. HashMap Full.Name (Type m)
. HashMap Full.Name (Schema.Type m)
-> OperationDefinition
-> HashMap.HashMap Full.Name a
-> Either QueryError Type.Subs
@ -203,14 +204,14 @@ document schema operationName subs ast = do
}
case chosenOperation of
OperationDefinition Full.Query _ _ _ _ ->
pure $ Document referencedTypes (query schema)
pure $ Document referencedTypes (Schema.query schema)
$ operation chosenOperation replacement
OperationDefinition Full.Mutation _ _ _ _
| Just mutationType <- mutation schema ->
| Just mutationType <- Schema.mutation schema ->
pure $ Document referencedTypes mutationType
$ operation chosenOperation replacement
OperationDefinition Full.Subscription _ _ _ _
| Just subscriptionType <- subscription schema ->
| Just subscriptionType <- Schema.subscription schema ->
pure $ Document referencedTypes subscriptionType
$ operation chosenOperation replacement
_ -> Left UnsupportedRootOperation

View File

@ -21,6 +21,6 @@ module Language.GraphQL.Type
) where
import Language.GraphQL.Type.Definition
import Language.GraphQL.Type.Schema (Schema(..))
import Language.GraphQL.Type.Schema (Schema(..), schema)
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out

View File

@ -11,6 +11,7 @@
-- with 'Language.GraphQL.Type.Out'.
module Language.GraphQL.Type.In
( Argument(..)
, Arguments
, InputField(..)
, InputObjectType(..)
, Type(..)
@ -24,10 +25,10 @@ module Language.GraphQL.Type.In
import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import Language.GraphQL.AST.Document (Name)
import Language.GraphQL.Type.Definition
import qualified Language.GraphQL.Type.Definition as Definition
-- | Single field of an 'InputObjectType'.
data InputField = InputField (Maybe Text) Type (Maybe Value)
data InputField = InputField (Maybe Text) Type (Maybe Definition.Value)
-- | Input object type definition.
--
@ -45,25 +46,28 @@ instance Eq InputObjectType where
-- type can wrap other wrapping or named types. Wrapping types are lists and
-- Non-Null types (named types are nullable by default).
data Type
= NamedScalarType ScalarType
| NamedEnumType EnumType
= NamedScalarType Definition.ScalarType
| NamedEnumType Definition.EnumType
| NamedInputObjectType InputObjectType
| ListType Type
| NonNullScalarType ScalarType
| NonNullEnumType EnumType
| NonNullScalarType Definition.ScalarType
| NonNullEnumType Definition.EnumType
| NonNullInputObjectType InputObjectType
| NonNullListType Type
deriving Eq
-- | Field argument definition.
data Argument = Argument (Maybe Text) Type (Maybe Value)
data Argument = Argument (Maybe Text) Type (Maybe Definition.Value)
-- | Field argument definitions.
type Arguments = HashMap Name Argument
-- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
pattern ScalarBaseType :: ScalarType -> Type
pattern ScalarBaseType :: Definition.ScalarType -> Type
pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
-- | Matches either 'NamedEnumType' or 'NonNullEnumType'.
pattern EnumBaseType :: EnumType -> Type
pattern EnumBaseType :: Definition.EnumType -> Type
pattern EnumBaseType enumType <- (isEnumType -> Just enumType)
-- | Matches either 'NamedInputObjectType' or 'NonNullInputObjectType'.
@ -76,7 +80,7 @@ pattern ListBaseType listType <- (isListType -> Just listType)
{-# COMPLETE EnumBaseType, ListBaseType, InputObjectBaseType, ScalarBaseType #-}
isScalarType :: Type -> Maybe ScalarType
isScalarType :: Type -> Maybe Definition.ScalarType
isScalarType (NamedScalarType inputType) = Just inputType
isScalarType (NonNullScalarType inputType) = Just inputType
isScalarType _ = Nothing
@ -86,7 +90,7 @@ isInputObjectType (NamedInputObjectType inputType) = Just inputType
isInputObjectType (NonNullInputObjectType inputType) = Just inputType
isInputObjectType _ = Nothing
isEnumType :: Type -> Maybe EnumType
isEnumType :: Type -> Maybe Definition.EnumType
isEnumType (NamedEnumType inputType) = Just inputType
isEnumType (NonNullEnumType inputType) = Just inputType
isEnumType _ = Nothing

View File

@ -18,12 +18,12 @@ module Language.GraphQL.Type.Internal
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import qualified Language.GraphQL.AST as Full
import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema
import Language.GraphQL.Type.Schema (Schema)
import qualified Language.GraphQL.Type.Schema as Schema
-- | These types may describe the parent context of a selection set.
data CompositeType m
@ -39,13 +39,15 @@ data AbstractType m
deriving Eq
-- | Traverses the schema and finds all referenced types.
collectReferencedTypes :: forall m. Schema m -> HashMap Full.Name (Type m)
collectReferencedTypes :: forall m
. Schema m
-> HashMap Full.Name (Schema.Type m)
collectReferencedTypes schema =
let queryTypes = traverseObjectType (query schema) HashMap.empty
let queryTypes = traverseObjectType (Schema.query schema) HashMap.empty
mutationTypes = maybe queryTypes (`traverseObjectType` queryTypes)
$ mutation schema
$ Schema.mutation schema
in maybe mutationTypes (`traverseObjectType` queryTypes)
$ subscription schema
$ Schema.subscription schema
where
collect traverser typeName element foundTypes
| HashMap.member typeName foundTypes = foundTypes
@ -59,17 +61,17 @@ collectReferencedTypes schema =
getField (Out.EventStreamResolver field _ _) = field
traverseInputType (In.InputObjectBaseType objectType) =
let In.InputObjectType typeName _ inputFields = objectType
element = InputObjectType objectType
element = Schema.InputObjectType objectType
traverser = flip (foldr visitInputFields) inputFields
in collect traverser typeName element
traverseInputType (In.ListBaseType listType) =
traverseInputType listType
traverseInputType (In.ScalarBaseType scalarType) =
let Definition.ScalarType typeName _ = scalarType
in collect Prelude.id typeName (ScalarType scalarType)
in collect Prelude.id typeName (Schema.ScalarType scalarType)
traverseInputType (In.EnumBaseType enumType) =
let Definition.EnumType typeName _ _ = enumType
in collect Prelude.id typeName (EnumType enumType)
in collect Prelude.id typeName (Schema.EnumType enumType)
traverseOutputType (Out.ObjectBaseType objectType) =
traverseObjectType objectType
traverseOutputType (Out.InterfaceBaseType interfaceType) =
@ -77,23 +79,23 @@ collectReferencedTypes schema =
traverseOutputType (Out.UnionBaseType unionType) =
let Out.UnionType typeName _ types = unionType
traverser = flip (foldr traverseObjectType) types
in collect traverser typeName (UnionType unionType)
in collect traverser typeName (Schema.UnionType unionType)
traverseOutputType (Out.ListBaseType listType) =
traverseOutputType listType
traverseOutputType (Out.ScalarBaseType scalarType) =
let Definition.ScalarType typeName _ = scalarType
in collect Prelude.id typeName (ScalarType scalarType)
in collect Prelude.id typeName (Schema.ScalarType scalarType)
traverseOutputType (Out.EnumBaseType enumType) =
let Definition.EnumType typeName _ _ = enumType
in collect Prelude.id typeName (EnumType enumType)
in collect Prelude.id typeName (Schema.EnumType enumType)
traverseObjectType objectType foundTypes =
let Out.ObjectType typeName _ interfaces fields = objectType
element = ObjectType objectType
element = Schema.ObjectType objectType
traverser = polymorphicTraverser interfaces (getField <$> fields)
in collect traverser typeName element foundTypes
traverseInterfaceType interfaceType foundTypes =
let Out.InterfaceType typeName _ interfaces fields = interfaceType
element = InterfaceType interfaceType
element = Schema.InterfaceType interfaceType
traverser = polymorphicTraverser interfaces fields
in collect traverser typeName element foundTypes
polymorphicTraverser interfaces fields
@ -126,27 +128,28 @@ instanceOf objectType (AbstractUnionType unionType) =
lookupTypeCondition :: forall m
. Full.Name
-> HashMap Full.Name (Type m)
-> HashMap Full.Name (Schema.Type m)
-> Maybe (CompositeType m)
lookupTypeCondition type' types' =
case HashMap.lookup type' types' of
Just (ObjectType objectType) -> Just $ CompositeObjectType objectType
Just (UnionType unionType) -> Just $ CompositeUnionType unionType
Just (InterfaceType interfaceType) ->
Just (Schema.ObjectType objectType) ->
Just $ CompositeObjectType objectType
Just (Schema.UnionType unionType) -> Just $ CompositeUnionType unionType
Just (Schema.InterfaceType interfaceType) ->
Just $ CompositeInterfaceType interfaceType
_ -> Nothing
lookupInputType
:: Full.Type
-> HashMap.HashMap Full.Name (Type m)
-> HashMap.HashMap Full.Name (Schema.Type m)
-> Maybe In.Type
lookupInputType (Full.TypeNamed name) types =
case HashMap.lookup name types of
Just (ScalarType scalarType) ->
Just (Schema.ScalarType scalarType) ->
Just $ In.NamedScalarType scalarType
Just (EnumType enumType) ->
Just (Schema.EnumType enumType) ->
Just $ In.NamedEnumType enumType
Just (InputObjectType objectType) ->
Just (Schema.InputObjectType objectType) ->
Just $ In.NamedInputObjectType objectType
_ -> Nothing
lookupInputType (Full.TypeList list) types
@ -154,18 +157,18 @@ lookupInputType (Full.TypeList list) types
<$> lookupInputType list types
lookupInputType (Full.TypeNonNull (Full.NonNullTypeNamed nonNull)) types =
case HashMap.lookup nonNull types of
Just (ScalarType scalarType) ->
Just (Schema.ScalarType scalarType) ->
Just $ In.NonNullScalarType scalarType
Just (EnumType enumType) ->
Just (Schema.EnumType enumType) ->
Just $ In.NonNullEnumType enumType
Just (InputObjectType objectType) ->
Just (Schema.InputObjectType objectType) ->
Just $ In.NonNullInputObjectType objectType
_ -> Nothing
lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types
= In.NonNullListType
<$> lookupInputType nonNull types
lookupTypeField :: forall a. Text -> Out.Type a -> Maybe (Out.Type a)
lookupTypeField :: forall a. Full.Name -> Out.Type a -> Maybe (Out.Field a)
lookupTypeField fieldName = \case
Out.ObjectBaseType objectType ->
objectChild objectType
@ -177,8 +180,6 @@ lookupTypeField fieldName = \case
objectChild (Out.ObjectType _ _ _ resolvers) =
resolverType <$> HashMap.lookup fieldName resolvers
interfaceChild (Out.InterfaceType _ _ _ fields) =
fieldType <$> HashMap.lookup fieldName fields
resolverType (Out.ValueResolver objectField _) = fieldType objectField
resolverType (Out.EventStreamResolver objectField _ _) =
fieldType objectField
fieldType (Out.Field _ type' _) = type'
HashMap.lookup fieldName fields
resolverType (Out.ValueResolver objectField _) = objectField
resolverType (Out.EventStreamResolver objectField _ _) = objectField

View File

@ -2,13 +2,22 @@
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE ExplicitForAll #-}
-- | This module provides a representation of a @GraphQL@ Schema in addition to
-- functions for defining and manipulating schemas.
module Language.GraphQL.Type.Schema
( Schema(..)
( Directive(..)
, Directives
, Schema(..)
, Type(..)
, schema
) where
import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import qualified Language.GraphQL.AST.Document as Full
import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation)
import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
@ -23,6 +32,12 @@ data Type m
| UnionType (Out.UnionType m)
deriving Eq
-- | Directive definition.
data Directive = Directive (Maybe Text) [DirectiveLocation] In.Arguments
-- | Directive definitions.
type Directives = HashMap Full.Name Directive
-- | A Schema is created by supplying the root types of each type of operation,
-- query and mutation (optional). A schema definition is then supplied to the
-- validator and executor.
@ -34,4 +49,14 @@ data Schema m = Schema
{ query :: Out.ObjectType m
, mutation :: Maybe (Out.ObjectType m)
, subscription :: Maybe (Out.ObjectType m)
, directives :: Directives
}
-- | Shortcut for creating a schema.
schema :: forall m. Out.ObjectType m -> Schema m
schema query' = Schema
{ query = query'
, mutation = Nothing
, subscription = Nothing
, directives = mempty
}

View File

@ -3,11 +3,12 @@
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | GraphQL validator.
module Language.GraphQL.Validate
( Error(..)
( Validation.Error(..)
, document
, module Language.GraphQL.Validate.Rules
) where
@ -20,38 +21,100 @@ import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Sequence (Seq(..), (><), (|>))
import qualified Data.Sequence as Seq
import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation(..))
import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
import Language.GraphQL.AST.Document
import Language.GraphQL.Type.Internal
import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema (Schema(..))
import Language.GraphQL.Type.Schema (Schema)
import qualified Language.GraphQL.Type.Schema as Schema
import Language.GraphQL.Validate.Rules
import Language.GraphQL.Validate.Validation
import Language.GraphQL.Validate.Validation (Validation(Validation))
import qualified Language.GraphQL.Validate.Validation as Validation
type ApplyRule m a =
HashMap Name (Schema.Type m) -> Rule m -> Maybe (Out.Type m) -> a -> Seq (RuleT m)
type ApplySelectionRule m a
= HashMap Name (Schema.Type m)
-> Validation.Rule m
-> Maybe (Out.Type m)
-> a
-> Seq (Validation.RuleT m)
type ApplyRule m a = Validation.Rule m -> a -> Seq (Validation.RuleT m)
-- | Validates a document and returns a list of found errors. If the returned
-- list is empty, the document is valid.
document :: forall m. Schema m -> [Rule m] -> Document -> Seq Error
document :: forall m
. Schema m
-> [Validation.Rule m]
-> Document
-> Seq Validation.Error
document schema' rules' document' =
runReaderT reader context
where
context = Validation
{ ast = document'
, schema = schema'
, types = collectReferencedTypes schema'
{ Validation.ast = document'
, Validation.schema = schema'
, Validation.types = collectReferencedTypes schema'
, Validation.directives = allDirectives
}
allDirectives =
HashMap.union (Schema.directives schema') defaultDirectives
defaultDirectives = HashMap.fromList
[ ("skip", skipDirective)
, ("include", includeDirective)
, ("deprecated", deprecatedDirective)
]
includeDirective =
Schema.Directive includeDescription skipIncludeLocations includeArguments
includeArguments = HashMap.singleton "if"
$ In.Argument (Just "Included when true.") ifType Nothing
includeDescription = Just
"Directs the executor to include this field or fragment only when the \
\`if` argument is true."
skipDirective =
Schema.Directive skipDescription skipIncludeLocations skipArguments
skipArguments = HashMap.singleton "if"
$ In.Argument (Just "skipped when true.") ifType Nothing
ifType = In.NonNullScalarType Definition.boolean
skipDescription = Just
"Directs the executor to skip this field or fragment when the `if` \
\argument is true."
skipIncludeLocations =
[ ExecutableDirectiveLocation DirectiveLocation.Field
, ExecutableDirectiveLocation DirectiveLocation.FragmentSpread
, ExecutableDirectiveLocation DirectiveLocation.InlineFragment
]
deprecatedDirective =
Schema.Directive deprecatedDescription deprecatedLocations deprecatedArguments
reasonDescription = Just
"Explains why this element was deprecated, usually also including a \
\suggestion for how to access supported similar data. Formatted using \
\the Markdown syntax, as specified by \
\[CommonMark](https://commonmark.org/).'"
deprecatedArguments = HashMap.singleton "reason"
$ In.Argument reasonDescription reasonType
$ Just "No longer supported"
reasonType = In.NamedScalarType Definition.string
deprecatedDescription = Just
"Marks an element of a GraphQL schema as no longer supported."
deprecatedLocations =
[ TypeSystemDirectiveLocation DirectiveLocation.FieldDefinition
, TypeSystemDirectiveLocation DirectiveLocation.ArgumentDefinition
, TypeSystemDirectiveLocation DirectiveLocation.InputFieldDefinition
, TypeSystemDirectiveLocation DirectiveLocation.EnumValue
]
reader = do
rule' <- lift $ Seq.fromList rules'
join $ lift $ foldr (definition rule' context) Seq.empty document'
definition :: Rule m
definition :: Validation.Rule m
-> Validation m
-> Definition
-> Seq (RuleT m)
-> Seq (RuleT m)
definition (DefinitionRule rule) _ definition' accumulator =
-> Seq (Validation.RuleT m)
-> Seq (Validation.RuleT m)
definition (Validation.DefinitionRule rule) _ definition' accumulator =
accumulator |> rule definition'
definition rule context (ExecutableDefinition definition') accumulator =
accumulator >< executableDefinition rule context definition'
@ -60,12 +123,12 @@ definition rule _ (TypeSystemDefinition typeSystemDefinition' _) accumulator =
definition rule _ (TypeSystemExtension extension _) accumulator =
accumulator >< typeSystemExtension rule extension
typeSystemExtension :: Rule m -> TypeSystemExtension -> Seq (RuleT m)
typeSystemExtension :: forall m. ApplyRule m TypeSystemExtension
typeSystemExtension rule = \case
SchemaExtension extension -> schemaExtension rule extension
TypeExtension extension -> typeExtension rule extension
typeExtension :: Rule m -> TypeExtension -> Seq (RuleT m)
typeExtension :: forall m. ApplyRule m TypeExtension
typeExtension rule = \case
ScalarTypeExtension _ directives' -> directives rule directives'
ObjectTypeFieldsDefinitionExtension _ _ directives' fields ->
@ -88,27 +151,28 @@ typeExtension rule = \case
InputObjectTypeDirectivesExtension _ directives' ->
directives rule directives'
schemaExtension :: Rule m -> SchemaExtension -> Seq (RuleT m)
schemaExtension :: forall m. ApplyRule m SchemaExtension
schemaExtension rule = \case
SchemaOperationExtension directives' _ -> directives rule directives'
SchemaDirectivesExtension directives' -> directives rule directives'
executableDefinition :: Rule m
executableDefinition :: forall m
. Validation.Rule m
-> Validation m
-> ExecutableDefinition
-> Seq (RuleT m)
-> Seq (Validation.RuleT m)
executableDefinition rule context (DefinitionOperation operation) =
operationDefinition rule context operation
executableDefinition rule context (DefinitionFragment fragment) =
fragmentDefinition rule context fragment
typeSystemDefinition :: Rule m -> TypeSystemDefinition -> Seq (RuleT m)
typeSystemDefinition :: forall m. ApplyRule m TypeSystemDefinition
typeSystemDefinition rule = \case
SchemaDefinition directives' _ -> directives rule directives'
TypeDefinition typeDefinition' -> typeDefinition rule typeDefinition'
DirectiveDefinition _ _ arguments' _ -> argumentsDefinition rule arguments'
typeDefinition :: Rule m -> TypeDefinition -> Seq (RuleT m)
typeDefinition :: forall m. ApplyRule m TypeDefinition
typeDefinition rule = \case
ScalarTypeDefinition _ _ directives' -> directives rule directives'
ObjectTypeDefinition _ _ _ directives' fields ->
@ -122,30 +186,31 @@ typeDefinition rule = \case
-> directives rule directives'
<> foldMap (inputValueDefinition rule) fields
enumValueDefinition :: Rule m -> EnumValueDefinition -> Seq (RuleT m)
enumValueDefinition :: forall m. ApplyRule m EnumValueDefinition
enumValueDefinition rule (EnumValueDefinition _ _ directives') =
directives rule directives'
fieldDefinition :: Rule m -> FieldDefinition -> Seq (RuleT m)
fieldDefinition :: forall m. ApplyRule m FieldDefinition
fieldDefinition rule (FieldDefinition _ _ arguments' _ directives') =
directives rule directives' >< argumentsDefinition rule arguments'
argumentsDefinition :: Rule m -> ArgumentsDefinition -> Seq (RuleT m)
argumentsDefinition :: forall m. ApplyRule m ArgumentsDefinition
argumentsDefinition rule (ArgumentsDefinition definitions) =
foldMap (inputValueDefinition rule) definitions
inputValueDefinition :: Rule m -> InputValueDefinition -> Seq (RuleT m)
inputValueDefinition :: forall m. ApplyRule m InputValueDefinition
inputValueDefinition rule (InputValueDefinition _ _ _ _ directives') =
directives rule directives'
operationDefinition :: Rule m
operationDefinition :: forall m
. Validation.Rule m
-> Validation m
-> OperationDefinition
-> Seq (RuleT m)
-> Seq (Validation.RuleT m)
operationDefinition rule context operation
| OperationDefinitionRule operationRule <- rule =
| Validation.OperationDefinitionRule operationRule <- rule =
pure $ operationRule operation
| VariablesRule variablesRule <- rule
| Validation.VariablesRule variablesRule <- rule
, OperationDefinition _ _ variables _ _ _ <- operation
= Seq.fromList (variableDefinition rule <$> variables)
|> variablesRule variables
@ -155,11 +220,13 @@ operationDefinition rule context operation
= selectionSet types' rule (getRootType operationType) selections
>< directives rule directives'
where
types' = types context
getRootType Query = Just $ Out.NamedObjectType $ query $ schema context
getRootType Mutation = Out.NamedObjectType <$> mutation (schema context)
types' = Validation.types context
getRootType Query =
Just $ Out.NamedObjectType $ Schema.query $ Validation.schema context
getRootType Mutation =
Out.NamedObjectType <$> Schema.mutation (Validation.schema context)
getRootType Subscription =
Out.NamedObjectType <$> subscription (schema context)
Out.NamedObjectType <$> Schema.subscription (Validation.schema context)
typeToOut :: forall m. Schema.Type m -> Maybe (Out.Type m)
typeToOut (Schema.ObjectType objectType) =
@ -171,27 +238,30 @@ typeToOut (Schema.EnumType enumType) = Just $ Out.NamedEnumType enumType
typeToOut (Schema.ScalarType scalarType) = Just $ Out.NamedScalarType scalarType
typeToOut _ = Nothing
variableDefinition :: Rule m -> VariableDefinition -> RuleT m
variableDefinition (ValueRule _ rule) (VariableDefinition _ _ value _) =
variableDefinition :: forall m
. Validation.Rule m
-> VariableDefinition
-> Validation.RuleT m
variableDefinition (Validation.ValueRule _ rule) (VariableDefinition _ _ value _) =
maybe (lift mempty) rule value
variableDefinition _ _ = lift mempty
fragmentDefinition :: forall m
. Rule m
. Validation.Rule m
-> Validation m
-> FragmentDefinition
-> Seq (RuleT m)
fragmentDefinition (FragmentDefinitionRule rule) _ definition' =
-> Seq (Validation.RuleT m)
fragmentDefinition (Validation.FragmentDefinitionRule rule) _ definition' =
pure $ rule definition'
fragmentDefinition rule context definition'
| FragmentDefinition _ typeCondition directives' selections _ <- definition'
, FragmentRule definitionRule _ <- rule
, Validation.FragmentRule definitionRule _ <- rule
= applyToChildren typeCondition directives' selections
|> definitionRule definition'
| FragmentDefinition _ typeCondition directives' selections _ <- definition'
= applyToChildren typeCondition directives' selections
where
types' = types context
types' = Validation.types context
applyToChildren typeCondition directives' selections
= selectionSet types' rule (lookupType' typeCondition) selections
>< directives rule directives'
@ -204,12 +274,12 @@ lookupType :: forall m
lookupType typeCondition types' = HashMap.lookup typeCondition types'
>>= typeToOut
selectionSet :: Traversable t => forall m. ApplyRule m (t Selection)
selectionSet :: Traversable t => forall m. ApplySelectionRule m (t Selection)
selectionSet types' rule = foldMap . selection types' rule
selection :: forall m. ApplyRule m Selection
selection :: forall m. ApplySelectionRule m Selection
selection types' rule objectType selection'
| SelectionRule selectionRule <- rule =
| Validation.SelectionRule selectionRule <- rule =
applyToChildren |> selectionRule objectType selection'
| otherwise = applyToChildren
where
@ -221,33 +291,37 @@ selection types' rule objectType selection'
FragmentSpreadSelection fragmentSpread' ->
fragmentSpread rule fragmentSpread'
field :: forall m. ApplyRule m Field
field :: forall m. ApplySelectionRule m Field
field types' rule objectType field' = go field'
where
go (Field _ fieldName arguments' directives' selections _)
| ArgumentsRule fieldRule _ <- rule
= applyToChildren fieldName arguments' directives' selections
|> fieldRule field'
| otherwise =
applyToChildren fieldName arguments' directives' selections
applyToChildren fieldName arguments' directives' selections =
let child = objectType >>= lookupTypeField fieldName
in selectionSet types' rule child selections
go (Field _ fieldName _ _ _ _)
| Validation.FieldRule fieldRule <- rule =
applyToChildren fieldName |> fieldRule objectType field'
| Validation.ArgumentsRule argumentsRule _ <- rule =
applyToChildren fieldName |> argumentsRule objectType field'
| otherwise = applyToChildren fieldName
typeFieldType (Out.Field _ type' _) = type'
applyToChildren fieldName =
let Field _ _ arguments' directives' selections _ = field'
fieldType = objectType
>>= fmap typeFieldType . lookupTypeField fieldName
in selectionSet types' rule fieldType selections
>< directives rule directives'
>< arguments rule arguments'
arguments :: Rule m -> [Argument] -> Seq (RuleT m)
arguments :: forall m. ApplyRule m [Argument]
arguments = (.) Seq.fromList . fmap . argument
argument :: Rule m -> Argument -> RuleT m
argument (ValueRule rule _) (Argument _ (Node value _) _) = rule value
argument :: forall m. Validation.Rule m -> Argument -> Validation.RuleT m
argument (Validation.ValueRule rule _) (Argument _ (Node value _) _) =
rule value
argument _ _ = lift mempty
inlineFragment :: forall m. ApplyRule m InlineFragment
inlineFragment :: forall m. ApplySelectionRule m InlineFragment
inlineFragment types' rule objectType inlineFragment' = go inlineFragment'
where
go (InlineFragment optionalType directives' selections _)
| FragmentRule _ fragmentRule <- rule
| Validation.FragmentRule _ fragmentRule <- rule
= applyToChildren (refineTarget optionalType) directives' selections
|> fragmentRule inlineFragment'
| otherwise = applyToChildren (refineTarget optionalType) directives' selections
@ -257,24 +331,24 @@ inlineFragment types' rule objectType inlineFragment' = go inlineFragment'
= selectionSet types' rule objectType' selections
>< directives rule directives'
fragmentSpread :: Rule m -> FragmentSpread -> Seq (RuleT m)
fragmentSpread :: forall m. ApplyRule m FragmentSpread
fragmentSpread rule fragmentSpread'@(FragmentSpread _ directives' _)
| FragmentSpreadRule fragmentRule <- rule =
| Validation.FragmentSpreadRule fragmentRule <- rule =
applyToChildren |> fragmentRule fragmentSpread'
| otherwise = applyToChildren
where
applyToChildren = directives rule directives'
directives :: Traversable t => Rule m -> t Directive -> Seq (RuleT m)
directives :: Traversable t => forall m. ApplyRule m (t Directive)
directives rule directives'
| DirectivesRule directivesRule <- rule =
| Validation.DirectivesRule directivesRule <- rule =
applyToChildren |> directivesRule directiveList
| otherwise = applyToChildren
where
directiveList = toList directives'
applyToChildren = foldMap (directive rule) directiveList
directive :: Rule m -> Directive -> Seq (RuleT m)
directive (ArgumentsRule _ argumentsRule) directive' =
directive :: forall m. ApplyRule m Directive
directive (Validation.ArgumentsRule _ argumentsRule) directive' =
pure $ argumentsRule directive'
directive rule (Directive _ arguments' _) = arguments rule arguments'

View File

@ -15,6 +15,7 @@ module Language.GraphQL.Validate.Rules
, fragmentSpreadTargetDefinedRule
, fragmentSpreadTypeExistenceRule
, loneAnonymousOperationRule
, knownArgumentNamesRule
, noFragmentCyclesRule
, noUndefinedVariablesRule
, noUnusedFragmentsRule
@ -44,7 +45,7 @@ import qualified Data.HashSet as HashSet
import Data.List (groupBy, sortBy, sortOn)
import Data.Maybe (mapMaybe)
import Data.Ord (comparing)
import Data.Sequence (Seq(..))
import Data.Sequence (Seq(..), (|>))
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as Text
@ -71,6 +72,7 @@ specifiedRules =
, fieldsOnCorrectTypeRule
, scalarLeafsRule
-- Arguments.
, knownArgumentNamesRule
, uniqueArgumentNamesRule
-- Fragments.
, uniqueFragmentNamesRule
@ -134,20 +136,20 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
forSpread accumulator fragmentSelection
InlineFragmentSelection fragmentSelection ->
forInline accumulator fragmentSelection
forField accumulator (Field alias name _ directives _ _)
| any skip directives = pure accumulator
forField accumulator (Field alias name _ directives' _ _)
| any skip directives' = pure accumulator
| Just aliasedName <- alias = pure
$ HashSet.insert aliasedName accumulator
| otherwise = pure $ HashSet.insert name accumulator
forSpread accumulator (FragmentSpread fragmentName directives _)
| any skip directives = pure accumulator
forSpread accumulator (FragmentSpread fragmentName directives' _)
| any skip directives' = pure accumulator
| otherwise = do
inVisitetFragments <- gets $ HashSet.member fragmentName
if inVisitetFragments
then pure accumulator
else collectFromSpread fragmentName accumulator
forInline accumulator (InlineFragment maybeType directives selections _)
| any skip directives = pure accumulator
forInline accumulator (InlineFragment maybeType directives' selections _)
| any skip directives' = pure accumulator
| Just typeCondition <- maybeType =
collectFromFragment typeCondition selections accumulator
| otherwise = HashSet.union accumulator
@ -494,7 +496,7 @@ noFragmentCyclesRule = FragmentDefinitionRule $ \case
uniqueArgumentNamesRule :: forall m. Rule m
uniqueArgumentNamesRule = ArgumentsRule fieldRule directiveRule
where
fieldRule (Field _ _ arguments _ _ _) =
fieldRule _ (Field _ _ arguments _ _ _) =
lift $ filterDuplicates extract "argument" arguments
directiveRule (Directive _ arguments _) =
lift $ filterDuplicates extract "argument" arguments
@ -519,9 +521,9 @@ filterDuplicates extract nodeType = Seq.fromList
where
getName = fst . extract
equalByName lhs rhs = getName lhs == getName rhs
makeError directives = Error
{ message = makeMessage $ head directives
, locations = snd . extract <$> directives
makeError directives' = Error
{ message = makeMessage $ head directives'
, locations = snd . extract <$> directives'
}
makeMessage directive = concat
[ "There can be only one "
@ -614,11 +616,11 @@ variableUsageDifference difference errorMessage = OperationDefinitionRule $ \cas
filterSelections' = filterSelections variableFilter
variableFilter :: Selection -> ValidationState m (Name, [Location])
variableFilter (InlineFragmentSelection inline)
| InlineFragment _ directives _ _ <- inline =
lift $ lift $ mapDirectives directives
| InlineFragment _ directives' _ _ <- inline =
lift $ lift $ mapDirectives directives'
variableFilter (FieldSelection fieldSelection)
| Field _ _ arguments directives _ _ <- fieldSelection =
lift $ lift $ mapArguments arguments <> mapDirectives directives
| Field _ _ arguments directives' _ _ <- fieldSelection =
lift $ lift $ mapArguments arguments <> mapDirectives directives'
variableFilter (FragmentSpreadSelection spread)
| FragmentSpread fragmentName _ _ <- spread = do
definitions <- lift $ asks ast
@ -628,9 +630,9 @@ variableUsageDifference difference errorMessage = OperationDefinitionRule $ \cas
Just (viewFragment -> Just fragmentDefinition)
| not visited -> diveIntoSpread fragmentDefinition
_ -> lift $ lift mempty
diveIntoSpread (FragmentDefinition _ _ directives selections _)
diveIntoSpread (FragmentDefinition _ _ directives' selections _)
= filterSelections' selections
>>= lift . mapReaderT (<> mapDirectives directives) . pure
>>= lift . mapReaderT (<> mapDirectives directives') . pure
findDirectiveVariables (Directive _ arguments _) = mapArguments arguments
mapArguments = Seq.fromList . mapMaybe findArgumentVariables
mapDirectives = foldMap findDirectiveVariables
@ -683,13 +685,11 @@ uniqueInputFieldNamesRule = ValueRule (lift . go) (lift . constGo)
-- | The target field of a field selection must be defined on the scoped type of
-- the selection set. There are no limitations on alias names.
fieldsOnCorrectTypeRule :: forall m. Rule m
fieldsOnCorrectTypeRule = SelectionRule go
fieldsOnCorrectTypeRule = FieldRule fieldRule
where
go (Just objectType) (FieldSelection fieldSelection) =
fieldRule objectType fieldSelection
go _ _ = lift mempty
fieldRule objectType (Field _ fieldName _ _ _ location)
| Nothing <- lookupTypeField fieldName objectType
fieldRule parentType (Field _ fieldName _ _ _ location)
| Just objectType <- parentType
, Nothing <- lookupTypeField fieldName objectType
, Just typeName <- compositeTypeName objectType = pure $ Error
{ message = errorMessage fieldName typeName
, locations = [location]
@ -702,31 +702,32 @@ fieldsOnCorrectTypeRule = SelectionRule go
, Text.unpack typeName
, "\"."
]
compositeTypeName (Out.ObjectBaseType (Out.ObjectType typeName _ _ _)) =
compositeTypeName :: forall m. Out.Type m -> Maybe Name
compositeTypeName (Out.ObjectBaseType (Out.ObjectType typeName _ _ _)) =
Just typeName
compositeTypeName (Out.InterfaceBaseType interfaceType) =
compositeTypeName (Out.InterfaceBaseType interfaceType) =
let Out.InterfaceType typeName _ _ _ = interfaceType
in Just typeName
compositeTypeName (Out.UnionBaseType (Out.UnionType typeName _ _)) =
compositeTypeName (Out.UnionBaseType (Out.UnionType typeName _ _)) =
Just typeName
compositeTypeName (Out.ScalarBaseType _) =
compositeTypeName (Out.ScalarBaseType _) =
Nothing
compositeTypeName (Out.EnumBaseType _) =
compositeTypeName (Out.EnumBaseType _) =
Nothing
compositeTypeName (Out.ListBaseType wrappedType) =
compositeTypeName (Out.ListBaseType wrappedType) =
compositeTypeName wrappedType
-- | Field selections on scalars or enums are never allowed, because they are
-- the leaf nodes of any GraphQL query.
scalarLeafsRule :: forall m. Rule m
scalarLeafsRule = SelectionRule go
scalarLeafsRule = FieldRule fieldRule
where
go (Just objectType) (FieldSelection fieldSelection) =
fieldRule objectType fieldSelection
go _ _ = lift mempty
fieldRule objectType selectionField@(Field _ fieldName _ _ _ _)
| Just fieldType <- lookupTypeField fieldName objectType =
lift $ check fieldType selectionField
fieldRule parentType selectionField@(Field _ fieldName _ _ _ _)
| Just objectType <- parentType
, Just field <- lookupTypeField fieldName objectType =
let Out.Field _ fieldType _ = field
in lift $ check fieldType selectionField
| otherwise = lift mempty
check (Out.ObjectBaseType (Out.ObjectType typeName _ _ _)) =
checkNotEmpty typeName
@ -765,3 +766,49 @@ scalarLeafsRule = SelectionRule go
{ message = errorMessage
, locations = [location]
}
-- | Every argument provided to a field or directive must be defined in the set
-- of possible arguments of that field or directive.
knownArgumentNamesRule :: forall m. Rule m
knownArgumentNamesRule = ArgumentsRule fieldRule directiveRule
where
fieldRule (Just objectType) (Field _ fieldName arguments _ _ _)
| Just typeField <- lookupTypeField fieldName objectType
, Just typeName <- compositeTypeName objectType =
lift $ foldr (go typeName fieldName typeField) Seq.empty arguments
fieldRule _ _ = lift mempty
go typeName fieldName fieldDefinition (Argument argumentName _ location) errors
| Out.Field _ _ definitions <- fieldDefinition
, Just _ <- HashMap.lookup argumentName definitions = errors
| otherwise = errors |> Error
{ message = fieldMessage argumentName fieldName typeName
, locations = [location]
}
fieldMessage argumentName fieldName typeName = concat
[ "Unknown argument \""
, Text.unpack argumentName
, "\" on field \""
, Text.unpack typeName
, "."
, Text.unpack fieldName
, "\"."
]
directiveRule (Directive directiveName arguments _) = do
available <- asks $ HashMap.lookup directiveName . directives
Argument argumentName _ location <- lift $ Seq.fromList arguments
case available of
Just (Schema.Directive _ _ definitions)
| not $ HashMap.member argumentName definitions ->
pure $ makeError argumentName directiveName location
_ -> lift mempty
makeError argumentName directiveName location = Error
{ message = directiveMessage argumentName directiveName
, locations = [location]
}
directiveMessage argumentName directiveName = concat
[ "Unknown argument \""
, Text.unpack argumentName
, "\" on directive \"@"
, Text.unpack directiveName
, "\"."
]

View File

@ -29,6 +29,7 @@ data Validation m = Validation
{ ast :: Document
, schema :: Schema m
, types :: HashMap Name (Schema.Type m)
, directives :: Schema.Directives
}
-- | 'Rule' assigns a function to each AST node that can be validated. If the
@ -41,7 +42,8 @@ data Rule m
| SelectionRule (Maybe (Out.Type m) -> Selection -> RuleT m)
| FragmentRule (FragmentDefinition -> RuleT m) (InlineFragment -> RuleT m)
| FragmentSpreadRule (FragmentSpread -> RuleT m)
| ArgumentsRule (Field -> RuleT m) (Directive -> RuleT m)
| FieldRule (Maybe (Out.Type m) -> Field -> RuleT m)
| ArgumentsRule (Maybe (Out.Type m) -> Field -> RuleT m) (Directive -> RuleT m)
| DirectivesRule ([Directive] -> RuleT m)
| VariablesRule ([VariableDefinition] -> RuleT m)
| ValueRule (Value -> RuleT m) (ConstValue -> RuleT m)

View File

@ -1,4 +1,4 @@
resolver: lts-16.15
resolver: lts-16.16
packages:
- .

View File

@ -25,11 +25,12 @@ import Test.Hspec (Spec, context, describe, it, shouldBe)
import Text.Megaparsec (parse)
import Text.RawString.QQ (r)
schema :: Schema (Either SomeException)
schema = Schema
philosopherSchema :: Schema (Either SomeException)
philosopherSchema = Schema
{ query = queryType
, mutation = Nothing
, subscription = Just subscriptionType
, directives = HashMap.empty
}
queryType :: Out.ObjectType (Either SomeException)
@ -79,7 +80,8 @@ type EitherStreamOrValue = Either
(Response Aeson.Value)
execute' :: Document -> Either SomeException EitherStreamOrValue
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
execute' =
execute philosopherSchema Nothing (mempty :: HashMap Name Aeson.Value)
spec :: Spec
spec =

View File

@ -21,11 +21,12 @@ import Test.Hspec (Spec, describe, it, shouldBe, shouldContain)
import Text.Megaparsec (parse)
import Text.RawString.QQ (r)
schema :: Schema IO
schema = Schema
petSchema :: Schema IO
petSchema = Schema
{ query = queryType
, mutation = Nothing
, subscription = Just subscriptionType
, directives = HashMap.empty
}
queryType :: ObjectType IO
@ -132,7 +133,7 @@ validate :: Text -> [Error]
validate queryString =
case parse AST.document "" queryString of
Left _ -> []
Right ast -> toList $ document schema specifiedRules ast
Right ast -> toList $ document petSchema specifiedRules ast
spec :: Spec
spec =
@ -544,3 +545,34 @@ spec =
, locations = [AST.Location 4 19]
}
in validate queryString `shouldBe` [expected]
it "rejects field arguments missing in the type" $
let queryString = [r|
{
dog {
doesKnowCommand(command: CLEAN_UP_HOUSE)
}
}
|]
expected = Error
{ message =
"Unknown argument \"command\" on field \
\\"Dog.doesKnowCommand\"."
, locations = [AST.Location 4 35]
}
in validate queryString `shouldBe` [expected]
it "rejects directive arguments missing in the definition" $
let queryString = [r|
{
dog {
isHousetrained(atOtherHomes: true) @include(unless: false)
}
}
|]
expected = Error
{ message =
"Unknown argument \"unless\" on directive \"@include\"."
, locations = [AST.Location 4 63]
}
in validate queryString `shouldBe` [expected]

View File

@ -19,8 +19,7 @@ import Test.Hspec.GraphQL
import Text.RawString.QQ (r)
experimentalResolver :: Schema IO
experimentalResolver = Schema
{ query = queryType, mutation = Nothing, subscription = Nothing }
experimentalResolver = schema queryType
where
queryType = Out.ObjectType "Query" Nothing []
$ HashMap.singleton "experimentalField"

View File

@ -67,8 +67,7 @@ sizeFieldType
$ pure $ snd size
toSchema :: Text -> (Text, Value) -> Schema IO
toSchema t (_, resolve) = Schema
{ query = queryType, mutation = Nothing, subscription = Nothing }
toSchema t (_, resolve) = schema queryType
where
garmentType = Out.UnionType "Garment" Nothing [hatType, shirtType]
typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty

View File

@ -23,11 +23,12 @@ hatType = Out.ObjectType "Hat" Nothing []
$ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
$ pure $ Int 60
schema :: Schema IO
schema = Schema
garmentSchema :: Schema IO
garmentSchema = Schema
{ query = Out.ObjectType "Query" Nothing [] hatFieldResolver
, mutation = Just $ Out.ObjectType "Mutation" Nothing [] incrementFieldResolver
, subscription = Nothing
, directives = HashMap.empty
}
where
garment = pure $ Object $ HashMap.fromList
@ -57,7 +58,7 @@ spec =
[ "circumference" .= (60 :: Int)
]
]
actual <- graphql schema querySource
actual <- graphql garmentSchema querySource
actual `shouldResolveTo` expected
it "chooses Mutation" $ do
@ -70,5 +71,5 @@ spec =
$ object
[ "incrementCircumference" .= (61 :: Int)
]
actual <- graphql schema querySource
actual <- graphql garmentSchema querySource
actual `shouldResolveTo` expected

View File

@ -357,10 +357,10 @@ spec = describe "Star Wars Query Tests" $ do
testQuery :: Text -> Aeson.Value -> Expectation
testQuery q expected =
let Right (Right actual) = graphql schema q
let Right (Right actual) = graphql starWarsSchema q
in Aeson.Object actual `shouldBe` expected
testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation
testQueryParams f q expected =
let Right (Right actual) = graphqlSubs schema Nothing f q
let Right (Right actual) = graphqlSubs starWarsSchema Nothing f q
in Aeson.Object actual `shouldBe` expected

View File

@ -1,7 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Test.StarWars.Schema
( schema
( starWarsSchema
) where
import Control.Monad.Catch (MonadThrow(..), SomeException)
@ -17,12 +17,8 @@ import Prelude hiding (id)
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
schema :: Schema (Either SomeException)
schema = Schema
{ query = queryType
, mutation = Nothing
, subscription = Nothing
}
starWarsSchema :: Schema (Either SomeException)
starWarsSchema = schema queryType
where
queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
[ ("hero", heroFieldResolver)