From 38c3097bcf2d3c92a180c5d328cfb15ef80f0b95 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 20 Sep 2020 06:59:27 +0200 Subject: [PATCH] Validate fragments are input types --- CHANGELOG.md | 1 + src/Language/GraphQL/Execute/Transform.hs | 30 ------------------ src/Language/GraphQL/Type/Internal.hs | 38 ++++++++++++++++++++--- src/Language/GraphQL/Validate/Rules.hs | 30 +++++++++++++++++- stack.yaml | 2 +- tests/Language/GraphQL/ValidateSpec.hs | 15 +++++++++ 6 files changed, 80 insertions(+), 36 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fb41f88..9087cc3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -42,6 +42,7 @@ and this project adheres to - `uniqueArgumentNamesRule` - `uniqueDirectiveNamesRule` - `uniqueVariableNamesRule` + - `variablesAreInputTypesRule` - `AST.Document.Field`. - `AST.Document.FragmentSpread`. - `AST.Document.InlineFragment`. diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs index 6f123e6..54187e7 100644 --- a/src/Language/GraphQL/Execute/Transform.hs +++ b/src/Language/GraphQL/Execute/Transform.hs @@ -47,7 +47,6 @@ import Language.GraphQL.AST (Name) import qualified Language.GraphQL.Execute.Coerce as Coerce import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type as Type -import qualified Language.GraphQL.Type.In as In import Language.GraphQL.Type.Internal import qualified Language.GraphQL.Type.Out as Out import Language.GraphQL.Type.Schema @@ -139,35 +138,6 @@ getOperation (Just operationName) operations matchingName (OperationDefinition _ name _ _ _) = name == Just operationName -lookupInputType - :: Full.Type - -> HashMap.HashMap Full.Name (Type m) - -> Maybe In.Type -lookupInputType (Full.TypeNamed name) types = - case HashMap.lookup name types of - Just (ScalarType scalarType) -> - Just $ In.NamedScalarType scalarType - Just (EnumType enumType) -> - Just $ In.NamedEnumType enumType - Just (InputObjectType objectType) -> - Just $ In.NamedInputObjectType objectType - _ -> Nothing -lookupInputType (Full.TypeList list) types - = In.ListType - <$> lookupInputType list types -lookupInputType (Full.TypeNonNull (Full.NonNullTypeNamed nonNull)) types = - case HashMap.lookup nonNull types of - Just (ScalarType scalarType) -> - Just $ In.NonNullScalarType scalarType - Just (EnumType enumType) -> - Just $ In.NonNullEnumType enumType - Just (InputObjectType objectType) -> - Just $ In.NonNullInputObjectType objectType - _ -> Nothing -lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types - = In.NonNullListType - <$> lookupInputType nonNull types - coerceVariableValues :: Coerce.VariableValue a => forall m . HashMap Full.Name (Type m) diff --git a/src/Language/GraphQL/Type/Internal.hs b/src/Language/GraphQL/Type/Internal.hs index 364a7b1..6438ad1 100644 --- a/src/Language/GraphQL/Type/Internal.hs +++ b/src/Language/GraphQL/Type/Internal.hs @@ -10,12 +10,13 @@ module Language.GraphQL.Type.Internal , collectReferencedTypes , doesFragmentTypeApply , instanceOf + , lookupInputType , lookupTypeCondition ) where import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -import Language.GraphQL.AST (Name) +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 @@ -35,7 +36,7 @@ data AbstractType m deriving Eq -- | Traverses the schema and finds all referenced types. -collectReferencedTypes :: forall m. Schema m -> HashMap Name (Type m) +collectReferencedTypes :: forall m. Schema m -> HashMap Full.Name (Type m) collectReferencedTypes schema = let queryTypes = traverseObjectType (query schema) HashMap.empty mutationTypes = maybe queryTypes (`traverseObjectType` queryTypes) @@ -121,8 +122,8 @@ instanceOf objectType (AbstractUnionType unionType) = go unionMemberType acc = acc || objectType == unionMemberType lookupTypeCondition :: forall m - . Name - -> HashMap Name (Type m) + . Full.Name + -> HashMap Full.Name (Type m) -> Maybe (CompositeType m) lookupTypeCondition type' types' = case HashMap.lookup type' types' of @@ -131,3 +132,32 @@ lookupTypeCondition type' types' = Just (InterfaceType interfaceType) -> Just $ CompositeInterfaceType interfaceType _ -> Nothing + +lookupInputType + :: Full.Type + -> HashMap.HashMap Full.Name (Type m) + -> Maybe In.Type +lookupInputType (Full.TypeNamed name) types = + case HashMap.lookup name types of + Just (ScalarType scalarType) -> + Just $ In.NamedScalarType scalarType + Just (EnumType enumType) -> + Just $ In.NamedEnumType enumType + Just (InputObjectType objectType) -> + Just $ In.NamedInputObjectType objectType + _ -> Nothing +lookupInputType (Full.TypeList list) types + = In.ListType + <$> lookupInputType list types +lookupInputType (Full.TypeNonNull (Full.NonNullTypeNamed nonNull)) types = + case HashMap.lookup nonNull types of + Just (ScalarType scalarType) -> + Just $ In.NonNullScalarType scalarType + Just (EnumType enumType) -> + Just $ In.NonNullEnumType enumType + Just (InputObjectType objectType) -> + Just $ In.NonNullInputObjectType objectType + _ -> Nothing +lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types + = In.NonNullListType + <$> lookupInputType nonNull types diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs index 3af6145..645a62e 100644 --- a/src/Language/GraphQL/Validate/Rules.hs +++ b/src/Language/GraphQL/Validate/Rules.hs @@ -23,9 +23,10 @@ module Language.GraphQL.Validate.Rules , uniqueFragmentNamesRule , uniqueOperationNamesRule , uniqueVariableNamesRule + , variablesAreInputTypesRule ) where -import Control.Monad (foldM) +import Control.Monad ((>=>), foldM) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Reader (ReaderT, asks) import Control.Monad.Trans.State (StateT, evalStateT, gets, modify) @@ -67,6 +68,7 @@ specifiedRules = , uniqueDirectiveNamesRule -- Variables. , uniqueVariableNamesRule + , variablesAreInputTypesRule ] -- | Definition must be OperationDefinition or FragmentDefinition. @@ -505,3 +507,29 @@ uniqueVariableNamesRule = VariablesRule where extract (VariableDefinition variableName _ _ location) = (variableName, location) + +-- | Variables can only be input types. Objects, unions and interfaces cannot be +-- used as inputs. +variablesAreInputTypesRule :: forall m. Rule m +variablesAreInputTypesRule = VariablesRule + $ (traverse check . Seq.fromList) >=> lift + where + check (VariableDefinition name typeName _ location) + = asks types + >>= lift + . maybe (makeError name typeName location) (const mempty) + . lookupInputType typeName + makeError name typeName location = pure $ Error + { message = concat + [ "Variable \"$" + , Text.unpack name + , "\" cannot be non-input type \"" + , Text.unpack $ getTypeName typeName + , "\"." + ] + , locations = [location] + } + getTypeName (TypeNamed name) = name + getTypeName (TypeList name) = getTypeName name + getTypeName (TypeNonNull (NonNullTypeNamed nonNull)) = nonNull + getTypeName (TypeNonNull (NonNullTypeList nonNull)) = getTypeName nonNull diff --git a/stack.yaml b/stack.yaml index 5911955..34c7e27 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-16.14 +resolver: lts-16.15 packages: - . diff --git a/tests/Language/GraphQL/ValidateSpec.hs b/tests/Language/GraphQL/ValidateSpec.hs index 1822f57..340104d 100644 --- a/tests/Language/GraphQL/ValidateSpec.hs +++ b/tests/Language/GraphQL/ValidateSpec.hs @@ -456,3 +456,18 @@ spec = , locations = [AST.Location 2 39, AST.Location 2 63] } in validate queryString `shouldBe` Seq.singleton expected + + it "rejects non-input types as variables" $ + let queryString = [r| + query takesDogBang($dog: Dog!) { + dog { + isHousetrained(atOtherHomes: $dog) + } + } + |] + expected = Error + { message = + "Variable \"$dog\" cannot be non-input type \"Dog\"." + , locations = [AST.Location 2 34] + } + in validate queryString `shouldBe` Seq.singleton expected