Validate arguments are defined

7 files changed, 52 insertions, 23 deletions

diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
index 7b67824..e6dd8d9 100644
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -25,11 +25,12 @@ import Test.Hspec (Spec, context, describe, it, shouldBe)
 import Text.Megaparsec (parse)
 import Text.RawString.QQ (r)
 
-schema :: Schema (Either SomeException)
-schema = Schema
+philosopherSchema :: Schema (Either SomeException)
+philosopherSchema = Schema
     { query = queryType
     , mutation = Nothing
     , subscription = Just subscriptionType
+    , directives = HashMap.empty
     }
 
 queryType :: Out.ObjectType (Either SomeException)
@@ -79,7 +80,8 @@ type EitherStreamOrValue = Either
     (Response Aeson.Value)
 
 execute' :: Document -> Either SomeException EitherStreamOrValue
-execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
+execute' =
+    execute philosopherSchema Nothing (mempty :: HashMap Name Aeson.Value)
 
 spec :: Spec
 spec =
diff --git a/tests/Language/GraphQL/ValidateSpec.hs b/tests/Language/GraphQL/ValidateSpec.hs
index 1649ad1..84bdfba 100644
--- a/tests/Language/GraphQL/ValidateSpec.hs
+++ b/tests/Language/GraphQL/ValidateSpec.hs
@@ -21,11 +21,12 @@ import Test.Hspec (Spec, describe, it, shouldBe, shouldContain)
 import Text.Megaparsec (parse)
 import Text.RawString.QQ (r)
 
-schema :: Schema IO
-schema = Schema
+petSchema :: Schema IO
+petSchema = Schema
     { query = queryType
     , mutation = Nothing
     , subscription = Just subscriptionType
+    , directives = HashMap.empty
     } 
 
 queryType :: ObjectType IO
@@ -132,7 +133,7 @@ validate :: Text -> [Error]
 validate queryString =
     case parse AST.document "" queryString of
         Left _ -> []
-        Right ast -> toList $ document schema specifiedRules ast
+        Right ast -> toList $ document petSchema specifiedRules ast
 
 spec :: Spec
 spec =
@@ -544,3 +545,34 @@ spec =
                     , locations = [AST.Location 4 19]
                     }
              in validate queryString `shouldBe` [expected]
+
+        it "rejects field arguments missing in the type" $
+            let queryString = [r|
+              {
+                dog {
+                  doesKnowCommand(command: CLEAN_UP_HOUSE)
+                }
+              }
+            |]
+                expected = Error
+                    { message =
+                        "Unknown argument \"command\" on field \
+                        \\"Dog.doesKnowCommand\"."
+                    , locations = [AST.Location 4 35]
+                    }
+             in validate queryString `shouldBe` [expected]
+
+        it "rejects directive arguments missing in the definition" $
+            let queryString = [r|
+              {
+                dog {
+                  isHousetrained(atOtherHomes: true) @include(unless: false)
+                }
+              }
+            |]
+                expected = Error
+                    { message =
+                        "Unknown argument \"unless\" on directive \"@include\"."
+                    , locations = [AST.Location 4 63]
+                    }
+             in validate queryString `shouldBe` [expected]
diff --git a/tests/Test/DirectiveSpec.hs b/tests/Test/DirectiveSpec.hs
index 800189e..c115163 100644
--- a/tests/Test/DirectiveSpec.hs
+++ b/tests/Test/DirectiveSpec.hs
@@ -19,8 +19,7 @@ import Test.Hspec.GraphQL
 import Text.RawString.QQ (r)
 
 experimentalResolver :: Schema IO
-experimentalResolver = Schema
-    { query = queryType, mutation = Nothing, subscription = Nothing }
+experimentalResolver = schema queryType
   where
     queryType = Out.ObjectType "Query" Nothing []
         $ HashMap.singleton "experimentalField"
diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs
index 8ee1ad2..4fecad8 100644
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@@ -67,8 +67,7 @@ sizeFieldType
     $ pure $ snd size
 
 toSchema :: Text -> (Text, Value) -> Schema IO
-toSchema t (_, resolve) = Schema
-    { query = queryType, mutation = Nothing, subscription = Nothing }
+toSchema t (_, resolve) = schema queryType
   where
     garmentType = Out.UnionType "Garment" Nothing [hatType, shirtType]
     typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty
diff --git a/tests/Test/RootOperationSpec.hs b/tests/Test/RootOperationSpec.hs
index ea89279..33b5d3b 100644
--- a/tests/Test/RootOperationSpec.hs
+++ b/tests/Test/RootOperationSpec.hs
@@ -23,11 +23,12 @@ hatType = Out.ObjectType "Hat" Nothing []
     $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
     $ pure $ Int 60
 
-schema :: Schema IO
-schema = Schema
+garmentSchema :: Schema IO
+garmentSchema = Schema
     { query = Out.ObjectType "Query" Nothing [] hatFieldResolver
     , mutation = Just $ Out.ObjectType "Mutation" Nothing [] incrementFieldResolver
     , subscription = Nothing
+    , directives = HashMap.empty
     }
   where
     garment = pure $ Object $ HashMap.fromList
@@ -57,7 +58,7 @@ spec =
                             [ "circumference" .= (60 :: Int)
                             ]
                         ]
-            actual <- graphql schema querySource
+            actual <- graphql garmentSchema querySource
             actual `shouldResolveTo` expected
 
         it "chooses Mutation" $ do
@@ -70,5 +71,5 @@ spec =
                     $ object
                         [ "incrementCircumference" .= (61 :: Int)
                         ]
-            actual <- graphql schema querySource
+            actual <- graphql garmentSchema querySource
             actual `shouldResolveTo` expected
diff --git a/tests/Test/StarWars/QuerySpec.hs b/tests/Test/StarWars/QuerySpec.hs
index 8d744ab..f9b13d9 100644
--- a/tests/Test/StarWars/QuerySpec.hs
+++ b/tests/Test/StarWars/QuerySpec.hs
@@ -357,10 +357,10 @@ spec = describe "Star Wars Query Tests" $ do
 
 testQuery :: Text -> Aeson.Value -> Expectation
 testQuery q expected =
-    let Right (Right actual) = graphql schema q
+    let Right (Right actual) = graphql starWarsSchema q
      in Aeson.Object actual `shouldBe` expected
 
 testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation
 testQueryParams f q expected =
-    let Right (Right actual) = graphqlSubs schema Nothing f q
+    let Right (Right actual) = graphqlSubs starWarsSchema Nothing f q
      in Aeson.Object actual `shouldBe` expected
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index 34a6a35..706d9b3 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module Test.StarWars.Schema
-    ( schema
+    ( starWarsSchema
     ) where
 
 import Control.Monad.Catch (MonadThrow(..), SomeException)
@@ -17,12 +17,8 @@ import Prelude hiding (id)
 
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
 
-schema :: Schema (Either SomeException)
-schema = Schema
-    { query = queryType
-    , mutation = Nothing
-    , subscription = Nothing
-    }
+starWarsSchema :: Schema (Either SomeException)
+starWarsSchema = schema queryType
   where
     queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
         [ ("hero", heroFieldResolver)