aboutsummaryrefslogtreecommitdiff
path: root/tests/Language
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Language')
-rw-r--r--tests/Language/GraphQL/AST/ParserSpec.hs51
-rw-r--r--tests/Language/GraphQL/ErrorSpec.hs34
-rw-r--r--tests/Language/GraphQL/Execute/OrderedMapSpec.hs72
-rw-r--r--tests/Language/GraphQL/ExecuteSpec.hs230
-rw-r--r--tests/Language/GraphQL/Validate/RulesSpec.hs74
5 files changed, 423 insertions, 38 deletions
diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs
index 5c4d39e..a47fc11 100644
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@@ -6,6 +6,7 @@ module Language.GraphQL.AST.ParserSpec
import Data.List.NonEmpty (NonEmpty(..))
import Language.GraphQL.AST.Document
+import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc
import Language.GraphQL.AST.Parser
import Test.Hspec (Spec, describe, it)
import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
@@ -119,6 +120,56 @@ spec = describe "Parser" $ do
| FRAGMENT_SPREAD
|]
+ it "parses two minimal directive definitions" $
+ let directive nm loc =
+ TypeSystemDefinition
+ (DirectiveDefinition
+ (Description Nothing)
+ nm
+ (ArgumentsDefinition [])
+ (loc :| []))
+ example1 =
+ directive "example1"
+ (DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition)
+ (Location {line = 2, column = 17})
+ example2 =
+ directive "example2"
+ (DirLoc.ExecutableDirectiveLocation DirLoc.Field)
+ (Location {line = 3, column = 17})
+ testSchemaExtension = example1 :| [ example2 ]
+ query = [r|
+ directive @example1 on FIELD_DEFINITION
+ directive @example2 on FIELD
+ |]
+ in parse document "" query `shouldParse` testSchemaExtension
+
+ it "parses a directive definition with a default empty list argument" $
+ let directive nm loc args =
+ TypeSystemDefinition
+ (DirectiveDefinition
+ (Description Nothing)
+ nm
+ (ArgumentsDefinition
+ [ InputValueDefinition
+ (Description Nothing)
+ argName
+ argType
+ argValue
+ []
+ | (argName, argType, argValue) <- args])
+ (loc :| []))
+ defn =
+ directive "test"
+ (DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition)
+ [("foo",
+ TypeList (TypeNamed "String"),
+ Just
+ $ Node (ConstList [])
+ $ Location {line = 1, column = 33})]
+ (Location {line = 1, column = 1})
+ query = [r|directive @test(foo: [String] = []) on FIELD_DEFINITION|]
+ in parse document "" query `shouldParse` (defn :| [ ])
+
it "parses schema extension with a new directive" $
parse document "" `shouldSucceedOn`[r|
extend schema @newDirective
diff --git a/tests/Language/GraphQL/ErrorSpec.hs b/tests/Language/GraphQL/ErrorSpec.hs
index 38d7d3a..f64e70a 100644
--- a/tests/Language/GraphQL/ErrorSpec.hs
+++ b/tests/Language/GraphQL/ErrorSpec.hs
@@ -8,17 +8,29 @@ module Language.GraphQL.ErrorSpec
) where
import qualified Data.Aeson as Aeson
-import qualified Data.Sequence as Seq
+import Data.List.NonEmpty (NonEmpty (..))
import Language.GraphQL.Error
-import Test.Hspec ( Spec
- , describe
- , it
- , shouldBe
- )
+import Test.Hspec
+ ( Spec
+ , describe
+ , it
+ , shouldBe
+ )
+import Text.Megaparsec (PosState(..))
+import Text.Megaparsec.Error (ParseError(..), ParseErrorBundle(..))
+import Text.Megaparsec.Pos (SourcePos(..), mkPos)
spec :: Spec
-spec = describe "singleError" $
- it "constructs an error with the given message" $
- let errors'' = Seq.singleton $ Error "Message." [] []
- expected = Response Aeson.Null errors''
- in singleError "Message." `shouldBe` expected
+spec = describe "parseError" $
+ it "generates response with a single error" $ do
+ let parseErrors = TrivialError 0 Nothing mempty :| []
+ posState = PosState
+ { pstateInput = ""
+ , pstateOffset = 0
+ , pstateSourcePos = SourcePos "" (mkPos 1) (mkPos 1)
+ , pstateTabWidth = mkPos 1
+ , pstateLinePrefix = ""
+ }
+ Response Aeson.Null actual <-
+ parseError (ParseErrorBundle parseErrors posState)
+ length actual `shouldBe` 1
diff --git a/tests/Language/GraphQL/Execute/OrderedMapSpec.hs b/tests/Language/GraphQL/Execute/OrderedMapSpec.hs
new file mode 100644
index 0000000..7c6a44f
--- /dev/null
+++ b/tests/Language/GraphQL/Execute/OrderedMapSpec.hs
@@ -0,0 +1,72 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+ v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Language.GraphQL.Execute.OrderedMapSpec
+ ( spec
+ ) where
+
+import Language.GraphQL.Execute.OrderedMap (OrderedMap)
+import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
+
+spec :: Spec
+spec =
+ describe "OrderedMap" $ do
+ it "creates an empty map" $
+ (mempty :: OrderedMap String) `shouldSatisfy` null
+
+ it "creates a singleton" $
+ let value :: String
+ value = "value"
+ in OrderedMap.size (OrderedMap.singleton "key" value) `shouldBe` 1
+
+ it "combines inserted vales" $
+ let key = "key"
+ map1 = OrderedMap.singleton key ("1" :: String)
+ map2 = OrderedMap.singleton key ("2" :: String)
+ in OrderedMap.lookup key (map1 <> map2) `shouldBe` Just "12"
+
+ it "shows the map" $
+ let actual = show
+ $ OrderedMap.insert "key1" "1"
+ $ OrderedMap.singleton "key2" ("2" :: String)
+ expected = "fromList [(\"key2\",\"2\"),(\"key1\",\"1\")]"
+ in actual `shouldBe` expected
+
+ it "traverses a map of just values" $
+ let actual = sequence
+ $ OrderedMap.insert "key1" (Just "2")
+ $ OrderedMap.singleton "key2" $ Just ("1" :: String)
+ expected = Just
+ $ OrderedMap.insert "key1" "2"
+ $ OrderedMap.singleton "key2" ("1" :: String)
+ in actual `shouldBe` expected
+
+ it "traverses a map with a Nothing" $
+ let actual = sequence
+ $ OrderedMap.insert "key1" Nothing
+ $ OrderedMap.singleton "key2" $ Just ("1" :: String)
+ expected = Nothing
+ in actual `shouldBe` expected
+
+ it "combines two maps preserving the order of the second one" $
+ let map1 :: OrderedMap String
+ map1 = OrderedMap.insert "key2" "2"
+ $ OrderedMap.singleton "key1" "1"
+ map2 :: OrderedMap String
+ map2 = OrderedMap.insert "key4" "4"
+ $ OrderedMap.singleton "key3" "3"
+ expected = OrderedMap.insert "key4" "4"
+ $ OrderedMap.insert "key3" "3"
+ $ OrderedMap.insert "key2" "2"
+ $ OrderedMap.singleton "key1" "1"
+ in (map1 <> map2) `shouldBe` expected
+
+ it "replaces existing values" $
+ let key = "key"
+ actual = OrderedMap.replace key ("2" :: String)
+ $ OrderedMap.singleton key ("1" :: String)
+ in OrderedMap.lookup key actual `shouldBe` Just "2"
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
index f6e3e6f..d14eb9d 100644
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -8,34 +8,87 @@ module Language.GraphQL.ExecuteSpec
( spec
) where
-import Control.Exception (SomeException)
+import Control.Exception (Exception(..), SomeException)
+import Control.Monad.Catch (throwM)
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (emptyObject)
import Data.Conduit
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
-import Language.GraphQL.AST (Document, Name)
+import Data.Typeable (cast)
+import Language.GraphQL.AST (Document, Location(..), Name)
import Language.GraphQL.AST.Parser (document)
import Language.GraphQL.Error
-import Language.GraphQL.Execute
-import Language.GraphQL.Type as Type
-import Language.GraphQL.Type.Out as Out
+import Language.GraphQL.Execute (execute)
+import qualified Language.GraphQL.Type.Schema as Schema
+import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.In as In
+import qualified Language.GraphQL.Type.Out as Out
+import Prelude hiding (id)
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Text.Megaparsec (parse)
import Text.RawString.QQ (r)
+data PhilosopherException = PhilosopherException
+ deriving Show
+
+instance Exception PhilosopherException where
+ toException = toException. ResolverException
+ fromException e = do
+ ResolverException resolverException <- fromException e
+ cast resolverException
+
philosopherSchema :: Schema (Either SomeException)
-philosopherSchema = schema queryType Nothing (Just subscriptionType) mempty
+philosopherSchema =
+ schemaWithTypes Nothing queryType Nothing subscriptionRoot extraTypes mempty
+ where
+ subscriptionRoot = Just subscriptionType
+ extraTypes =
+ [ Schema.ObjectType bookType
+ , Schema.ObjectType bookCollectionType
+ ]
queryType :: Out.ObjectType (Either SomeException)
queryType = Out.ObjectType "Query" Nothing []
- $ HashMap.singleton "philosopher"
- $ ValueResolver philosopherField
- $ pure $ Type.Object mempty
+ $ HashMap.fromList
+ [ ("philosopher", ValueResolver philosopherField philosopherResolver)
+ , ("genres", ValueResolver genresField genresResolver)
+ ]
where
philosopherField =
- Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
+ Out.Field Nothing (Out.NonNullObjectType philosopherType)
+ $ HashMap.singleton "id"
+ $ In.Argument Nothing (In.NamedScalarType id) Nothing
+ philosopherResolver = pure $ Object mempty
+ genresField =
+ let fieldType = Out.ListType $ Out.NonNullScalarType string
+ in Out.Field Nothing fieldType HashMap.empty
+ genresResolver :: Resolve (Either SomeException)
+ genresResolver = throwM PhilosopherException
+
+musicType :: Out.ObjectType (Either SomeException)
+musicType = Out.ObjectType "Music" Nothing []
+ $ HashMap.fromList resolvers
+ where
+ resolvers =
+ [ ("instrument", ValueResolver instrumentField instrumentResolver)
+ ]
+ instrumentResolver = pure $ String "piano"
+ instrumentField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+
+poetryType :: Out.ObjectType (Either SomeException)
+poetryType = Out.ObjectType "Poetry" Nothing []
+ $ HashMap.fromList resolvers
+ where
+ resolvers =
+ [ ("genre", ValueResolver genreField genreResolver)
+ ]
+ genreResolver = pure $ String "Futurism"
+ genreField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+
+interestType :: Out.UnionType (Either SomeException)
+interestType = Out.UnionType "Interest" Nothing [musicType, poetryType]
philosopherType :: Out.ObjectType (Either SomeException)
philosopherType = Out.ObjectType "Philosopher" Nothing []
@@ -44,19 +97,68 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
resolvers =
[ ("firstName", ValueResolver firstNameField firstNameResolver)
, ("lastName", ValueResolver lastNameField lastNameResolver)
+ , ("school", ValueResolver schoolField schoolResolver)
+ , ("interest", ValueResolver interestField interestResolver)
+ , ("majorWork", ValueResolver majorWorkField majorWorkResolver)
+ , ("century", ValueResolver centuryField centuryResolver)
]
firstNameField =
Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
- firstNameResolver = pure $ Type.String "Friedrich"
+ firstNameResolver = pure $ String "Friedrich"
lastNameField
= Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
- lastNameResolver = pure $ Type.String "Nietzsche"
+ lastNameResolver = pure $ String "Nietzsche"
+ schoolField
+ = Out.Field Nothing (Out.NonNullEnumType schoolType) HashMap.empty
+ schoolResolver = pure $ Enum "EXISTENTIALISM"
+ interestField
+ = Out.Field Nothing (Out.NonNullUnionType interestType) HashMap.empty
+ interestResolver = pure
+ $ Object
+ $ HashMap.fromList [("instrument", "piano")]
+ majorWorkField
+ = Out.Field Nothing (Out.NonNullInterfaceType workType) HashMap.empty
+ majorWorkResolver = pure
+ $ Object
+ $ HashMap.fromList
+ [ ("title", "Also sprach Zarathustra: Ein Buch für Alle und Keinen")
+ ]
+ centuryField =
+ Out.Field Nothing (Out.NonNullScalarType int) HashMap.empty
+ centuryResolver = pure $ Float 18.5
+
+workType :: Out.InterfaceType (Either SomeException)
+workType = Out.InterfaceType "Work" Nothing []
+ $ HashMap.fromList fields
+ where
+ fields = [("title", titleField)]
+ titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+
+bookType :: Out.ObjectType (Either SomeException)
+bookType = Out.ObjectType "Book" Nothing [workType]
+ $ HashMap.fromList resolvers
+ where
+ resolvers =
+ [ ("title", ValueResolver titleField titleResolver)
+ ]
+ titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+ titleResolver = pure "Also sprach Zarathustra: Ein Buch für Alle und Keinen"
+
+bookCollectionType :: Out.ObjectType (Either SomeException)
+bookCollectionType = Out.ObjectType "Book" Nothing [workType]
+ $ HashMap.fromList resolvers
+ where
+ resolvers =
+ [ ("title", ValueResolver titleField titleResolver)
+ ]
+ titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+ titleResolver = pure "The Three Critiques"
subscriptionType :: Out.ObjectType (Either SomeException)
subscriptionType = Out.ObjectType "Subscription" Nothing []
$ HashMap.singleton "newQuote"
- $ EventStreamResolver quoteField (pure $ Type.Object mempty)
- $ pure $ yield $ Type.Object mempty
+ $ EventStreamResolver quoteField (pure $ Object mempty)
+ $ pure $ yield $ Object mempty
where
quoteField =
Out.Field Nothing (Out.NonNullObjectType quoteType) HashMap.empty
@@ -70,6 +172,13 @@ quoteType = Out.ObjectType "Quote" Nothing []
quoteField =
Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+schoolType :: EnumType
+schoolType = EnumType "School" Nothing $ HashMap.fromList
+ [ ("NOMINALISM", EnumValue Nothing)
+ , ("REALISM", EnumValue Nothing)
+ , ("IDEALISM", EnumValue Nothing)
+ ]
+
type EitherStreamOrValue = Either
(ResponseEventStream (Either SomeException) Aeson.Value)
(Response Aeson.Value)
@@ -118,6 +227,99 @@ spec =
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
in actual `shouldBe` expected
+
+ it "errors on invalid output enum values" $
+ let data'' = Aeson.object
+ [ "philosopher" .= Aeson.object
+ [ "school" .= Aeson.Null
+ ]
+ ]
+ executionErrors = pure $ Error
+ { message = "Enum value completion failed."
+ , locations = [Location 1 17]
+ , path = []
+ }
+ expected = Response data'' executionErrors
+ Right (Right actual) = either (pure . parseError) execute'
+ $ parse document "" "{ philosopher { school } }"
+ in actual `shouldBe` expected
+
+ it "gives location information for non-null unions" $
+ let data'' = Aeson.object
+ [ "philosopher" .= Aeson.object
+ [ "interest" .= Aeson.Null
+ ]
+ ]
+ executionErrors = pure $ Error
+ { message = "Union value completion failed."
+ , locations = [Location 1 17]
+ , path = []
+ }
+ expected = Response data'' executionErrors
+ Right (Right actual) = either (pure . parseError) execute'
+ $ parse document "" "{ philosopher { interest } }"
+ in actual `shouldBe` expected
+
+ it "gives location information for invalid interfaces" $
+ let data'' = Aeson.object
+ [ "philosopher" .= Aeson.object
+ [ "majorWork" .= Aeson.Null
+ ]
+ ]
+ executionErrors = pure $ Error
+ { message = "Interface value completion failed."
+ , locations = [Location 1 17]
+ , path = []
+ }
+ expected = Response data'' executionErrors
+ Right (Right actual) = either (pure . parseError) execute'
+ $ parse document "" "{ philosopher { majorWork { title } } }"
+ in actual `shouldBe` expected
+
+ it "gives location information for invalid scalar arguments" $
+ let data'' = Aeson.object
+ [ "philosopher" .= Aeson.Null
+ ]
+ executionErrors = pure $ Error
+ { message = "Argument coercing failed."
+ , locations = [Location 1 15]
+ , path = []
+ }
+ expected = Response data'' executionErrors
+ Right (Right actual) = either (pure . parseError) execute'
+ $ parse document "" "{ philosopher(id: true) { lastName } }"
+ in actual `shouldBe` expected
+
+ it "gives location information for failed result coercion" $
+ let data'' = Aeson.object
+ [ "philosopher" .= Aeson.object
+ [ "century" .= Aeson.Null
+ ]
+ ]
+ executionErrors = pure $ Error
+ { message = "Result coercion failed."
+ , locations = [Location 1 26]
+ , path = []
+ }
+ expected = Response data'' executionErrors
+ Right (Right actual) = either (pure . parseError) execute'
+ $ parse document "" "{ philosopher(id: \"1\") { century } }"
+ in actual `shouldBe` expected
+
+ it "gives location information for failed result coercion" $
+ let data'' = Aeson.object
+ [ "genres" .= Aeson.Null
+ ]
+ executionErrors = pure $ Error
+ { message = "PhilosopherException"
+ , locations = [Location 1 3]
+ , path = []
+ }
+ expected = Response data'' executionErrors
+ Right (Right actual) = either (pure . parseError) execute'
+ $ parse document "" "{ genres }"
+ in actual `shouldBe` expected
+
context "Subscription" $
it "subscribes" $
let data'' = Aeson.object
diff --git a/tests/Language/GraphQL/Validate/RulesSpec.hs b/tests/Language/GraphQL/Validate/RulesSpec.hs
index 6f90436..f75aef6 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
@@ -845,7 +847,7 @@ spec =
}
in validate queryString `shouldBe` [expected]
- context "providedRequiredArgumentsRule" $
+ context "providedRequiredArgumentsRule" $ do
it "checks for (non-)nullable arguments" $
let queryString = [r|
{
@@ -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,49 @@ 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]
+
+ 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]
+
+ it "checks for required list members" $
+ let queryString = [r|
+ {
+ cat {
+ doesKnowCommands(catCommands: [null])
+ }
+ }
+ |]
+ expected = Error
+ { message =
+ "List of non-null values of type \"CatCommand\" \
+ \cannot contain null values."
+ , locations = [AST.Location 4 54]
+ }
+ in validate queryString `shouldBe` [expected]
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 08:52:43 +0000