From 5654b78935b38a88f3dd4998eb8667a2695aea14 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Mon, 12 Apr 2021 07:09:39 +0200
Subject: [PATCH] Traverse input object properties once

---
 CHANGELOG.md                                 |  4 +++-
 graphql.cabal                                |  3 ---
 src/Language/GraphQL/Validate/Rules.hs       | 16 ++++++----------
 tests/Language/GraphQL/Validate/RulesSpec.hs | 15 +++++++++++++++
 4 files changed, 24 insertions(+), 14 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index eec1c07..2854191 100644
--- a/CHANGELOG.md
+++ b/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
diff --git a/graphql.cabal b/graphql.cabal
index 294787e..b2316de 100644
--- a/graphql.cabal
+++ b/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
diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs
index 905c2a7..a6bc43b 100644
--- a/src/Language/GraphQL/Validate/Rules.hs
+++ b/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
-        , Full.ConstObject valueFields <- node =
-            foldMap (checkObjectField typeFields) valueFields
+        -- Skip, objects are checked recursively by the validation traverser.
+        | In.InputObjectType{}  <- objectType
+        , 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
diff --git a/tests/Language/GraphQL/Validate/RulesSpec.hs b/tests/Language/GraphQL/Validate/RulesSpec.hs
index ce12138..02b14ae 100644
--- a/tests/Language/GraphQL/Validate/RulesSpec.hs
+++ b/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]