summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--CHANGELOG.md1
-rw-r--r--src/Language/GraphQL/Execute/Transform.hs30
-rw-r--r--src/Language/GraphQL/Type/Internal.hs38
-rw-r--r--src/Language/GraphQL/Validate/Rules.hs30
-rw-r--r--stack.yaml2
-rw-r--r--tests/Language/GraphQL/ValidateSpec.hs15
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
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 22:24:54 +0000