Traverse input object properties once

CHANGELOG.md

@@ -14,8 +14,10 @@ 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
+- `valuesOfCorrectTypeRule` doesn't check lists recursively since the
   validation traverser calls it on all list items.
+- `valuesOfCorrectTypeRule` doesn't check objects recursively since the
+  validation traverser calls it on all object properties.
 
 ### Changed
 - `AST.Document.Value.List` and `AST.Document.ConstValue.ConstList` contain

graphql.cabal

@@ -88,9 +88,6 @@ test-suite graphql-test
       Test.DirectiveSpec
       Test.FragmentSpec
       Test.RootOperationSpec
-      Paths_graphql
-  autogen-modules:
-      Paths_graphql
   hs-source-dirs:
       tests
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall

src/Language/GraphQL/Validate/Rules.hs

@@ -1582,24 +1582,20 @@ valuesOfCorrectTypeRule = ValueRule go constGo
         , Full.ConstEnum memberValue <- node
         , HashMap.member memberValue members = mempty
     check (In.InputObjectBaseType objectType) Full.Node{ node }
-        | In.InputObjectType _ _ typeFields <- objectType
+        -- Skip, objects are checked recursively by the validation traverser.
-        , Full.ConstObject valueFields <- node =
+        | In.InputObjectType{}  <- objectType
-            foldMap (checkObjectField typeFields) valueFields
+        , Full.ConstObject{} <- node = mempty
     check (In.ListBaseType listType) constValue@Full.Node{ .. }
         -- Skip, lists are checked recursively by the validation traverser.
-        | Full.ConstList _ <- node = mempty
+        | Full.ConstList{} <- node = mempty
         | otherwise = check listType constValue
     check inputType Full.Node{ .. } = pure $ Error
         { message = concat
             [ "Value "
-            , show node, " cannot be coerced to type \""
+            , show node
+            , " cannot be coerced to type \""
             , show inputType
             , "\"."
             ]
         , locations = [location]
         }
-    checkObjectField typeFields Full.ObjectField{..}
-        | Just typeField <- HashMap.lookup name typeFields
-        , In.InputField _ fieldType _ <- typeField =
-            check fieldType value
-    checkObjectField _ _ = mempty

tests/Language/GraphQL/Validate/RulesSpec.hs

@@ -929,3 +929,18 @@ spec =
                         , locations = [AST.Location 4 54]
                         }
                  in validate queryString `shouldBe` [expected]
+
+            it "validates input object properties once" $
+                let queryString = [r|
+                  {
+                    findDog(complex: { name: 3 }) {
+                      name
+                    }
+                  }
+                |]
+                    expected = Error
+                        { message =
+                            "Value 3 cannot be coerced to type \"!String\"."
+                        , locations = [AST.Location 3 46]
+                        }
+                 in validate queryString `shouldBe` [expected]