From c37b9c88b1f64d842ad837a18bfbe01026324abb Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Wed, 10 Jun 2020 11:42:00 +0200
Subject: [PATCH] Skip unknown fields

---
 CHANGELOG.md                              |  3 +-
 src/Language/GraphQL/Execute/Execution.hs | 14 ++++----
 stack.yaml                                |  2 +-
 tests/Language/GraphQL/ExecuteSpec.hs     | 42 +++++++++++++++++++++++
 4 files changed, 51 insertions(+), 10 deletions(-)
 create mode 100644 tests/Language/GraphQL/ExecuteSpec.hs

diff --git a/CHANGELOG.md b/CHANGELOG.md
index ce71877..dc93324 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -13,10 +13,11 @@ and this project adheres to
   constants cannot be variables. `AST.Document.ConstValue` was added,
   `AST.Document.ObjectField` was modified.
 - AST transformation should never fail.
-    * Missing variable are assumed to be null.
+    * Arguments and fields with a missing variable as value should be left out.
     * Invalid (recusrive or non-existing) fragments should be skipped.
 - Argument value coercion.
 - Variable value coercion.
+- The executor should skip the fields missing in the object type and not fail.
 
 ### Changed
 - `Schema.Resolver` was moved to `Type.Out`, it is a field and resolver function
diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs
index 79646c3..a7b57f8 100644
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@@ -17,7 +17,6 @@ import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
 import Data.Sequence (Seq(..))
 import Data.Text (Text)
-import qualified Data.Text as Text
 import qualified Data.Sequence as Seq
 import Language.GraphQL.AST (Name)
 import Language.GraphQL.AST.Core
@@ -100,10 +99,10 @@ instanceOf objectType (AbstractUnionType unionType) =
 
 executeField :: Monad m
     => Definition.Value
-    -> Out.Resolver m
     -> Field m
+    -> Out.Resolver m
     -> CollectErrsT m Aeson.Value
-executeField prev (Out.Resolver fieldDefinition resolver) field = do
+executeField prev field (Out.Resolver fieldDefinition resolver) = do
     let Out.Field _ fieldType argumentDefinitions = fieldDefinition
     let Field _ _ arguments' _ = field
     case coerceArgumentValues argumentDefinitions arguments' of
@@ -160,13 +159,12 @@ executeSelectionSet result objectType@(Out.ObjectType _ _ _ resolvers) selection
     pure $ Aeson.toJSON resolvedValues
   where
     forEach _responseKey (field :<| _) =
-        tryResolvers field >>= lift . pure . pure
+        let Field _ name _ _ = field
+         in traverse (tryResolver field) $ lookupResolver name
     forEach _ _ = pure Nothing
     lookupResolver = flip HashMap.lookup resolvers
-    tryResolvers fld@(Field _ name _ _)
-        | Just typeField <- lookupResolver name =
-            executeField result typeField fld
-        | otherwise = errmsg $ Text.unwords ["field", name, "not resolved."]
+    tryResolver typeField field =
+        executeField result typeField field >>= lift . pure
 
 coerceArgumentValues
     :: HashMap Name In.Argument
diff --git a/stack.yaml b/stack.yaml
index 894eb1a..4df91ed 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-15.16
+resolver: lts-16.0
 
 packages:
 - .
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
new file mode 100644
index 0000000..d0e7a66
--- /dev/null
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GraphQL.ExecuteSpec
+    ( spec
+    ) where
+
+import Data.Aeson ((.=))
+import qualified Data.Aeson as Aeson
+import Data.Functor.Identity (Identity(..))
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import Language.GraphQL.AST (Name)
+import Language.GraphQL.AST.Parser (document)
+import Language.GraphQL.Error
+import Language.GraphQL.Execute
+import Language.GraphQL.Type
+import Language.GraphQL.Type.Out as Out
+import Test.Hspec (Spec, describe, it, shouldBe)
+import Text.Megaparsec (parse)
+
+schema :: Schema Identity
+schema = Schema {query = queryType, mutation = Nothing}
+
+queryType :: Out.ObjectType Identity
+queryType = Out.ObjectType "Query" Nothing []
+    $ HashMap.singleton "count"
+    $ Out.Resolver countField
+    $ pure
+    $ Int 8
+  where
+    countField = Out.Field Nothing (Out.NonNullScalarType int) HashMap.empty
+
+spec :: Spec
+spec =
+    describe "execute" $
+        it "skips unknown fields" $
+            let expected = Aeson.object
+                    ["data" .= Aeson.object ["count" .= (8 :: Int)]]
+                execute' = execute schema (mempty :: HashMap Name Aeson.Value)
+                actual = runIdentity
+                    $ either parseError execute'
+                    $ parse document "" "{ count number }"
+             in actual `shouldBe` expected