From 328e6acdeeaafa27501d6bcc88b5b79704791210 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Tue, 16 Mar 2021 10:08:13 +0100 Subject: [PATCH] Emit list item errors once --- CHANGELOG.md | 6 +++ src/Language/GraphQL/Validate/Rules.hs | 6 +-- stack.yaml | 2 +- tests/Language/GraphQL/Validate/RulesSpec.hs | 41 ++++++++++++++------ 4 files changed, 39 insertions(+), 16 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 017a14c..eec1c07 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,12 @@ and this project adheres to ### Fixed - Parser now accepts empty lists and objects. - Parser now accepts all directive locations. +- `valuesOfCorrectTypeRule` doesn't check list items recursively since the + validation traverser calls it on all list items. + +### Changed +- `AST.Document.Value.List` and `AST.Document.ConstValue.ConstList` contain + location information for each list item. ## [0.11.1.0] - 2021-02-07 ### Added diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs index ee2fdbe..905c2a7 100644 --- a/src/Language/GraphQL/Validate/Rules.hs +++ b/src/Language/GraphQL/Validate/Rules.hs @@ -1540,7 +1540,7 @@ valuesOfCorrectTypeRule = ValueRule go constGo go (Just inputType) value | Just constValue <- toConstNode value = lift $ check inputType constValue - go _ _ = lift mempty + go _ _ = lift mempty -- This rule checks only literals. toConstNode Full.Node{..} = flip Full.Node location <$> toConst node toConst (Full.Variable _) = Nothing toConst (Full.Int integer) = Just $ Full.ConstInt integer @@ -1586,8 +1586,8 @@ valuesOfCorrectTypeRule = ValueRule go constGo , Full.ConstObject valueFields <- node = foldMap (checkObjectField typeFields) valueFields check (In.ListBaseType listType) constValue@Full.Node{ .. } - | Full.ConstList listValues <- node = - foldMap (check listType) listValues + -- Skip, lists are checked recursively by the validation traverser. + | Full.ConstList _ <- node = mempty | otherwise = check listType constValue check inputType Full.Node{ .. } = pure $ Error { message = concat diff --git a/stack.yaml b/stack.yaml index 85def2a..c4861c3 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-17.3 +resolver: lts-17.6 packages: - . diff --git a/tests/Language/GraphQL/Validate/RulesSpec.hs b/tests/Language/GraphQL/Validate/RulesSpec.hs index 6f90436..ce12138 100644 --- a/tests/Language/GraphQL/Validate/RulesSpec.hs +++ b/tests/Language/GraphQL/Validate/RulesSpec.hs @@ -49,16 +49,18 @@ catType :: ObjectType IO catType = ObjectType "Cat" Nothing [petType] $ HashMap.fromList [ ("name", nameResolver) , ("nickname", nicknameResolver) - , ("doesKnowCommand", doesKnowCommandResolver) + , ("doesKnowCommands", doesKnowCommandsResolver) , ("meowVolume", meowVolumeResolver) ] where meowVolumeField = Field Nothing (Out.NamedScalarType int) mempty meowVolumeResolver = ValueResolver meowVolumeField $ pure $ Int 3 - doesKnowCommandField = Field Nothing (Out.NonNullScalarType boolean) - $ HashMap.singleton "catCommand" - $ In.Argument Nothing (In.NonNullEnumType catCommandType) Nothing - doesKnowCommandResolver = ValueResolver doesKnowCommandField + doesKnowCommandsType = In.NonNullListType + $ In.NonNullEnumType catCommandType + doesKnowCommandsField = Field Nothing (Out.NonNullScalarType boolean) + $ HashMap.singleton "catCommands" + $ In.Argument Nothing doesKnowCommandsType Nothing + doesKnowCommandsResolver = ValueResolver doesKnowCommandsField $ pure $ Boolean True nameResolver :: Resolver IO @@ -866,17 +868,17 @@ spec = context "variablesInAllowedPositionRule" $ do it "rejects wrongly typed variable arguments" $ let queryString = [r| - query catCommandArgQuery($catCommandArg: CatCommand) { - cat { - doesKnowCommand(catCommand: $catCommandArg) + query dogCommandArgQuery($dogCommandArg: DogCommand) { + dog { + doesKnowCommand(dogCommand: $dogCommandArg) } } |] expected = Error { message = - "Variable \"$catCommandArg\" of type \ - \\"CatCommand\" used in position expecting type \ - \\"!CatCommand\"." + "Variable \"$dogCommandArg\" of type \ + \\"DogCommand\" used in position expecting type \ + \\"!DogCommand\"." , locations = [AST.Location 2 44] } in validate queryString `shouldBe` [expected] @@ -897,7 +899,7 @@ spec = } in validate queryString `shouldBe` [expected] - context "valuesOfCorrectTypeRule" $ + context "valuesOfCorrectTypeRule" $ do it "rejects values of incorrect types" $ let queryString = [r| { @@ -912,3 +914,18 @@ spec = , locations = [AST.Location 4 52] } in validate queryString `shouldBe` [expected] + + it "uses the location of a single list value" $ + let queryString = [r| + { + cat { + doesKnowCommands(catCommands: [3]) + } + } + |] + expected = Error + { message = + "Value 3 cannot be coerced to type \"!CatCommand\"." + , locations = [AST.Location 4 54] + } + in validate queryString `shouldBe` [expected]