aboutsummaryrefslogtreecommitdiff
path: root/tests/Language
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Language')
-rw-r--r--tests/Language/GraphQL/AST/EncoderSpec.hs156
-rw-r--r--tests/Language/GraphQL/AST/LexerSpec.hs38
-rw-r--r--tests/Language/GraphQL/AST/ParserSpec.hs60
-rw-r--r--tests/Language/GraphQL/ExecuteSpec.hs87
-rw-r--r--tests/Language/GraphQL/Validate/RulesSpec.hs172
5 files changed, 291 insertions, 222 deletions
diff --git a/tests/Language/GraphQL/AST/EncoderSpec.hs b/tests/Language/GraphQL/AST/EncoderSpec.hs
index 0c7dd39..bc6aac4 100644
--- a/tests/Language/GraphQL/AST/EncoderSpec.hs
+++ b/tests/Language/GraphQL/AST/EncoderSpec.hs
@@ -6,10 +6,10 @@ module Language.GraphQL.AST.EncoderSpec
import qualified Language.GraphQL.AST.Document as Full
import Language.GraphQL.AST.Encoder
+import Language.GraphQL.TH
import Test.Hspec (Spec, context, describe, it, shouldBe, shouldStartWith, shouldEndWith, shouldNotContain)
import Test.QuickCheck (choose, oneof, forAll)
-import Text.RawString.QQ (r)
-import Data.Text.Lazy (cons, toStrict, unpack)
+import qualified Data.Text.Lazy as Text.Lazy
spec :: Spec
spec = do
@@ -48,23 +48,32 @@ spec = do
it "uses strings for short string values" $
value pretty (Full.String "Short text") `shouldBe` "\"Short text\""
it "uses block strings for text with new lines, with newline symbol" $
- value pretty (Full.String "Line 1\nLine 2")
- `shouldBe` [r|"""
- Line 1
- Line 2
-"""|]
+ let expected = [gql|
+ """
+ Line 1
+ Line 2
+ """
+ |]
+ actual = value pretty $ Full.String "Line 1\nLine 2"
+ in actual `shouldBe` expected
it "uses block strings for text with new lines, with CR symbol" $
- value pretty (Full.String "Line 1\rLine 2")
- `shouldBe` [r|"""
- Line 1
- Line 2
-"""|]
+ let expected = [gql|
+ """
+ Line 1
+ Line 2
+ """
+ |]
+ actual = value pretty $ Full.String "Line 1\rLine 2"
+ in actual `shouldBe` expected
it "uses block strings for text with new lines, with CR symbol followed by newline" $
- value pretty (Full.String "Line 1\r\nLine 2")
- `shouldBe` [r|"""
- Line 1
- Line 2
-"""|]
+ let expected = [gql|
+ """
+ Line 1
+ Line 2
+ """
+ |]
+ actual = value pretty $ Full.String "Line 1\r\nLine 2"
+ in actual `shouldBe` expected
it "encodes as one line string if has escaped symbols" $ do
let
genNotAllowedSymbol = oneof
@@ -76,48 +85,74 @@ spec = do
forAll genNotAllowedSymbol $ \x -> do
let
- rawValue = "Short \n" <> cons x "text"
- encoded = value pretty (Full.String $ toStrict rawValue)
- shouldStartWith (unpack encoded) "\""
- shouldEndWith (unpack encoded) "\""
- shouldNotContain (unpack encoded) "\"\"\""
-
- it "Hello world" $ value pretty (Full.String "Hello,\n World!\n\nYours,\n GraphQL.")
- `shouldBe` [r|"""
- Hello,
- World!
-
- Yours,
- GraphQL.
-"""|]
-
- it "has only newlines" $ value pretty (Full.String "\n") `shouldBe` [r|"""
-
-
-"""|]
+ rawValue = "Short \n" <> Text.Lazy.cons x "text"
+ encoded = value pretty
+ $ Full.String $ Text.Lazy.toStrict rawValue
+ shouldStartWith (Text.Lazy.unpack encoded) "\""
+ shouldEndWith (Text.Lazy.unpack encoded) "\""
+ shouldNotContain (Text.Lazy.unpack encoded) "\"\"\""
+
+ it "Hello world" $
+ let actual = value pretty
+ $ Full.String "Hello,\n World!\n\nYours,\n GraphQL."
+ expected = [gql|
+ """
+ Hello,
+ World!
+
+ Yours,
+ GraphQL.
+ """
+ |]
+ in actual `shouldBe` expected
+
+ it "has only newlines" $
+ let actual = value pretty $ Full.String "\n"
+ expected = [gql|
+ """
+
+
+ """
+ |]
+ in actual `shouldBe` expected
it "has newlines and one symbol at the begining" $
- value pretty (Full.String "a\n\n") `shouldBe` [r|"""
- a
+ let actual = value pretty $ Full.String "a\n\n"
+ expected = [gql|
+ """
+ a
-"""|]
+ """|]
+ in actual `shouldBe` expected
it "has newlines and one symbol at the end" $
- value pretty (Full.String "\n\na") `shouldBe` [r|"""
+ let actual = value pretty $ Full.String "\n\na"
+ expected = [gql|
+ """
- a
-"""|]
+ a
+ """
+ |]
+ in actual `shouldBe` expected
it "has newlines and one symbol in the middle" $
- value pretty (Full.String "\na\n") `shouldBe` [r|"""
-
- a
-
-"""|]
- it "skip trailing whitespaces" $ value pretty (Full.String " Short\ntext ")
- `shouldBe` [r|"""
- Short
- text
-"""|]
+ let actual = value pretty $ Full.String "\na\n"
+ expected = [gql|
+ """
+
+ a
+
+ """
+ |]
+ in actual `shouldBe` expected
+ it "skip trailing whitespaces" $
+ let actual = value pretty $ Full.String " Short\ntext "
+ expected = [gql|
+ """
+ Short
+ text
+ """
+ |]
+ in actual `shouldBe` expected
describe "definition" $
it "indents block strings in arguments" $
@@ -128,10 +163,13 @@ spec = do
fieldSelection = pure $ Full.FieldSelection field
operation = Full.DefinitionOperation
$ Full.SelectionSet fieldSelection location
- in definition pretty operation `shouldBe` [r|{
- field(message: """
- line1
- line2
- """)
-}
-|]
+ expected = Text.Lazy.snoc [gql|
+ {
+ field(message: """
+ line1
+ line2
+ """)
+ }
+ |] '\n'
+ actual = definition pretty operation
+ in actual `shouldBe` expected
diff --git a/tests/Language/GraphQL/AST/LexerSpec.hs b/tests/Language/GraphQL/AST/LexerSpec.hs
index c4fae45..e22c6b0 100644
--- a/tests/Language/GraphQL/AST/LexerSpec.hs
+++ b/tests/Language/GraphQL/AST/LexerSpec.hs
@@ -7,10 +7,10 @@ module Language.GraphQL.AST.LexerSpec
import Data.Text (Text)
import Data.Void (Void)
import Language.GraphQL.AST.Lexer
+import Language.GraphQL.TH
import Test.Hspec (Spec, context, describe, it)
import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
import Text.Megaparsec (ParseErrorBundle, parse)
-import Text.RawString.QQ (r)
spec :: Spec
spec = describe "Lexer" $ do
@@ -19,32 +19,32 @@ spec = describe "Lexer" $ do
parse unicodeBOM "" `shouldSucceedOn` "\xfeff"
it "lexes strings" $ do
- parse string "" [r|"simple"|] `shouldParse` "simple"
- parse string "" [r|" white space "|] `shouldParse` " white space "
- parse string "" [r|"quote \""|] `shouldParse` [r|quote "|]
- parse string "" [r|"escaped \n"|] `shouldParse` "escaped \n"
- parse string "" [r|"slashes \\ \/"|] `shouldParse` [r|slashes \ /|]
- parse string "" [r|"unicode \u1234\u5678\u90AB\uCDEF"|]
+ parse string "" [gql|"simple"|] `shouldParse` "simple"
+ parse string "" [gql|" white space "|] `shouldParse` " white space "
+ parse string "" [gql|"quote \""|] `shouldParse` [gql|quote "|]
+ parse string "" [gql|"escaped \n"|] `shouldParse` "escaped \n"
+ parse string "" [gql|"slashes \\ \/"|] `shouldParse` [gql|slashes \ /|]
+ parse string "" [gql|"unicode \u1234\u5678\u90AB\uCDEF"|]
`shouldParse` "unicode ሴ噸邫췯"
it "lexes block string" $ do
- parse blockString "" [r|"""simple"""|] `shouldParse` "simple"
- parse blockString "" [r|""" white space """|]
+ parse blockString "" [gql|"""simple"""|] `shouldParse` "simple"
+ parse blockString "" [gql|""" white space """|]
`shouldParse` " white space "
- parse blockString "" [r|"""contains " quote"""|]
- `shouldParse` [r|contains " quote|]
- parse blockString "" [r|"""contains \""" triplequote"""|]
- `shouldParse` [r|contains """ triplequote|]
+ parse blockString "" [gql|"""contains " quote"""|]
+ `shouldParse` [gql|contains " quote|]
+ parse blockString "" [gql|"""contains \""" triplequote"""|]
+ `shouldParse` [gql|contains """ triplequote|]
parse blockString "" "\"\"\"multi\nline\"\"\"" `shouldParse` "multi\nline"
parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
`shouldParse` "multi\nline\nnormalized"
parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
`shouldParse` "multi\nline\nnormalized"
- parse blockString "" [r|"""unescaped \n\r\b\t\f\u1234"""|]
- `shouldParse` [r|unescaped \n\r\b\t\f\u1234|]
- parse blockString "" [r|"""slashes \\ \/"""|]
- `shouldParse` [r|slashes \\ \/|]
- parse blockString "" [r|"""
+ parse blockString "" [gql|"""unescaped \n\r\b\t\f\u1234"""|]
+ `shouldParse` [gql|unescaped \n\r\b\t\f\u1234|]
+ parse blockString "" [gql|"""slashes \\ \/"""|]
+ `shouldParse` [gql|slashes \\ \/|]
+ parse blockString "" [gql|"""
spans
multiple
@@ -84,7 +84,7 @@ spec = describe "Lexer" $ do
context "Implementation tests" $ do
it "lexes empty block strings" $
- parse blockString "" [r|""""""|] `shouldParse` ""
+ parse blockString "" [gql|""""""|] `shouldParse` ""
it "lexes ampersand" $
parse amp "" "&" `shouldParse` "&"
it "lexes schema extensions" $
diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs
index a47fc11..702beab 100644
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@@ -8,10 +8,10 @@ import Data.List.NonEmpty (NonEmpty(..))
import Language.GraphQL.AST.Document
import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc
import Language.GraphQL.AST.Parser
+import Language.GraphQL.TH
import Test.Hspec (Spec, describe, it)
import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
import Text.Megaparsec (parse)
-import Text.RawString.QQ (r)
spec :: Spec
spec = describe "Parser" $ do
@@ -19,74 +19,74 @@ spec = describe "Parser" $ do
parse document "" `shouldSucceedOn` "\xfeff{foo}"
it "accepts block strings as argument" $
- parse document "" `shouldSucceedOn` [r|{
+ parse document "" `shouldSucceedOn` [gql|{
hello(text: """Argument""")
}|]
it "accepts strings as argument" $
- parse document "" `shouldSucceedOn` [r|{
+ parse document "" `shouldSucceedOn` [gql|{
hello(text: "Argument")
}|]
it "accepts two required arguments" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
mutation auth($username: String!, $password: String!){
test
}|]
it "accepts two string arguments" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
mutation auth{
test(username: "username", password: "password")
}|]
it "accepts two block string arguments" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
mutation auth{
test(username: """username""", password: """password""")
}|]
it "parses minimal schema definition" $
- parse document "" `shouldSucceedOn` [r|schema { query: Query }|]
+ parse document "" `shouldSucceedOn` [gql|schema { query: Query }|]
it "parses minimal scalar definition" $
- parse document "" `shouldSucceedOn` [r|scalar Time|]
+ parse document "" `shouldSucceedOn` [gql|scalar Time|]
it "parses ImplementsInterfaces" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
type Person implements NamedEntity & ValuedEntity {
name: String
}
|]
it "parses a type without ImplementsInterfaces" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
type Person {
name: String
}
|]
it "parses ArgumentsDefinition in an ObjectDefinition" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
type Person {
name(first: String, last: String): String
}
|]
it "parses minimal union type definition" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
union SearchResult = Photo | Person
|]
it "parses minimal interface type definition" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
interface NamedEntity {
name: String
}
|]
it "parses minimal enum type definition" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
enum Direction {
NORTH
EAST
@@ -96,7 +96,7 @@ spec = describe "Parser" $ do
|]
it "parses minimal enum type definition" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
enum Direction {
NORTH
EAST
@@ -106,7 +106,7 @@ spec = describe "Parser" $ do
|]
it "parses minimal input object type definition" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
input Point2D {
x: Float
y: Float
@@ -114,7 +114,7 @@ spec = describe "Parser" $ do
|]
it "parses minimal input enum definition with an optional pipe" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
directive @example on
| FIELD
| FRAGMENT_SPREAD
@@ -131,15 +131,15 @@ spec = describe "Parser" $ do
example1 =
directive "example1"
(DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition)
- (Location {line = 2, column = 17})
+ (Location {line = 1, column = 1})
example2 =
directive "example2"
(DirLoc.ExecutableDirectiveLocation DirLoc.Field)
- (Location {line = 3, column = 17})
+ (Location {line = 2, column = 1})
testSchemaExtension = example1 :| [ example2 ]
- query = [r|
- directive @example1 on FIELD_DEFINITION
- directive @example2 on FIELD
+ query = [gql|
+ directive @example1 on FIELD_DEFINITION
+ directive @example2 on FIELD
|]
in parse document "" query `shouldParse` testSchemaExtension
@@ -167,16 +167,16 @@ spec = describe "Parser" $ do
$ Node (ConstList [])
$ Location {line = 1, column = 33})]
(Location {line = 1, column = 1})
- query = [r|directive @test(foo: [String] = []) on FIELD_DEFINITION|]
+ query = [gql|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|
+ parse document "" `shouldSucceedOn`[gql|
extend schema @newDirective
|]
it "parses schema extension with an operation type definition" $
- parse document "" `shouldSucceedOn` [r|extend schema { query: Query }|]
+ parse document "" `shouldSucceedOn` [gql|extend schema { query: Query }|]
it "parses schema extension with an operation type and directive" $
let newDirective = Directive "newDirective" [] $ Location 1 15
@@ -185,25 +185,25 @@ spec = describe "Parser" $ do
$ OperationTypeDefinition Query "Query" :| []
testSchemaExtension = TypeSystemExtension schemaExtension
$ Location 1 1
- query = [r|extend schema @newDirective { query: Query }|]
+ query = [gql|extend schema @newDirective { query: Query }|]
in parse document "" query `shouldParse` (testSchemaExtension :| [])
it "parses an object extension" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
extend type Story {
isHiddenLocally: Boolean
}
|]
it "rejects variables in DefaultValue" $
- parse document "" `shouldFailOn` [r|
+ parse document "" `shouldFailOn` [gql|
query ($book: String = "Zarathustra", $author: String = $book) {
title
}
|]
it "parses documents beginning with a comment" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
"""
Query
"""
@@ -213,7 +213,7 @@ spec = describe "Parser" $ do
|]
it "parses subscriptions" $
- parse document "" `shouldSucceedOn` [r|
+ parse document "" `shouldSucceedOn` [gql|
subscription NewMessages {
newMessage(roomId: 123) {
sender
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
index d14eb9d..6723524 100644
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -21,6 +21,7 @@ import Language.GraphQL.AST (Document, Location(..), Name)
import Language.GraphQL.AST.Parser (document)
import Language.GraphQL.Error
import Language.GraphQL.Execute (execute)
+import Language.GraphQL.TH
import qualified Language.GraphQL.Type.Schema as Schema
import Language.GraphQL.Type
import qualified Language.GraphQL.Type.In as In
@@ -28,7 +29,6 @@ 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
@@ -54,18 +54,23 @@ queryType = Out.ObjectType "Query" Nothing []
$ HashMap.fromList
[ ("philosopher", ValueResolver philosopherField philosopherResolver)
, ("genres", ValueResolver genresField genresResolver)
+ , ("count", ValueResolver countField countResolver)
]
where
philosopherField =
- Out.Field Nothing (Out.NonNullObjectType philosopherType)
+ Out.Field Nothing (Out.NamedObjectType 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
+ let fieldType = Out.ListType $ Out.NonNullScalarType string
+ in Out.Field Nothing fieldType HashMap.empty
genresResolver :: Resolve (Either SomeException)
genresResolver = throwM PhilosopherException
+ countField =
+ let fieldType = Out.NonNullScalarType int
+ in Out.Field Nothing fieldType HashMap.empty
+ countResolver = pure ""
musicType :: Out.ObjectType (Either SomeException)
musicType = Out.ObjectType "Music" Nothing []
@@ -101,6 +106,7 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
, ("interest", ValueResolver interestField interestResolver)
, ("majorWork", ValueResolver majorWorkField majorWorkResolver)
, ("century", ValueResolver centuryField centuryResolver)
+ , ("firstLanguage", ValueResolver firstLanguageField firstLanguageResolver)
]
firstNameField =
Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
@@ -126,6 +132,9 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
centuryField =
Out.Field Nothing (Out.NonNullScalarType int) HashMap.empty
centuryResolver = pure $ Float 18.5
+ firstLanguageField
+ = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+ firstLanguageResolver = pure Null
workType :: Out.InterfaceType (Either SomeException)
workType = Out.InterfaceType "Work" Nothing []
@@ -191,7 +200,7 @@ spec :: Spec
spec =
describe "execute" $ do
it "rejects recursive fragments" $
- let sourceQuery = [r|
+ let sourceQuery = [gql|
{
...cyclicFragment
}
@@ -230,14 +239,13 @@ spec =
it "errors on invalid output enum values" $
let data'' = Aeson.object
- [ "philosopher" .= Aeson.object
- [ "school" .= Aeson.Null
- ]
+ [ "philosopher" .= Aeson.Null
]
executionErrors = pure $ Error
- { message = "Enum value completion failed."
+ { message =
+ "Value completion error. Expected type !School, found: EXISTENTIALISM."
, locations = [Location 1 17]
- , path = []
+ , path = [Segment "philosopher", Segment "school"]
}
expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute'
@@ -246,14 +254,13 @@ spec =
it "gives location information for non-null unions" $
let data'' = Aeson.object
- [ "philosopher" .= Aeson.object
- [ "interest" .= Aeson.Null
- ]
+ [ "philosopher" .= Aeson.Null
]
executionErrors = pure $ Error
- { message = "Union value completion failed."
+ { message =
+ "Value completion error. Expected type !Interest, found: { instrument: \"piano\" }."
, locations = [Location 1 17]
- , path = []
+ , path = [Segment "philosopher", Segment "interest"]
}
expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute'
@@ -262,14 +269,14 @@ spec =
it "gives location information for invalid interfaces" $
let data'' = Aeson.object
- [ "philosopher" .= Aeson.object
- [ "majorWork" .= Aeson.Null
- ]
+ [ "philosopher" .= Aeson.Null
]
executionErrors = pure $ Error
- { message = "Interface value completion failed."
+ { message
+ = "Value completion error. Expected type !Work, found:\
+ \ { title: \"Also sprach Zarathustra: Ein Buch f\252r Alle und Keinen\" }."
, locations = [Location 1 17]
- , path = []
+ , path = [Segment "philosopher", Segment "majorWork"]
}
expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute'
@@ -281,9 +288,10 @@ spec =
[ "philosopher" .= Aeson.Null
]
executionErrors = pure $ Error
- { message = "Argument coercing failed."
+ { message =
+ "Argument \"id\" has invalid type. Expected type ID, found: True."
, locations = [Location 1 15]
- , path = []
+ , path = [Segment "philosopher"]
}
expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute'
@@ -292,14 +300,12 @@ spec =
it "gives location information for failed result coercion" $
let data'' = Aeson.object
- [ "philosopher" .= Aeson.object
- [ "century" .= Aeson.Null
- ]
+ [ "philosopher" .= Aeson.Null
]
executionErrors = pure $ Error
- { message = "Result coercion failed."
+ { message = "Unable to coerce result to !Int."
, locations = [Location 1 26]
- , path = []
+ , path = [Segment "philosopher", Segment "century"]
}
expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute'
@@ -313,13 +319,38 @@ spec =
executionErrors = pure $ Error
{ message = "PhilosopherException"
, locations = [Location 1 3]
- , path = []
+ , path = [Segment "genres"]
}
expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ genres }"
in actual `shouldBe` expected
+ it "sets data to null if a root field isn't nullable" $
+ let executionErrors = pure $ Error
+ { message = "Unable to coerce result to !Int."
+ , locations = [Location 1 3]
+ , path = [Segment "count"]
+ }
+ expected = Response Aeson.Null executionErrors
+ Right (Right actual) = either (pure . parseError) execute'
+ $ parse document "" "{ count }"
+ in actual `shouldBe` expected
+
+ it "detects nullability errors" $
+ let data'' = Aeson.object
+ [ "philosopher" .= Aeson.Null
+ ]
+ executionErrors = pure $ Error
+ { message = "Value completion error. Expected type !String, found: null."
+ , locations = [Location 1 26]
+ , path = [Segment "philosopher", Segment "firstLanguage"]
+ }
+ expected = Response data'' executionErrors
+ Right (Right actual) = either (pure . parseError) execute'
+ $ parse document "" "{ philosopher(id: \"1\") { firstLanguage } }"
+ 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 f75aef6..7a5f4cc 100644
--- a/tests/Language/GraphQL/Validate/RulesSpec.hs
+++ b/tests/Language/GraphQL/Validate/RulesSpec.hs
@@ -13,13 +13,13 @@ import Data.Foldable (toList)
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import qualified Language.GraphQL.AST as AST
+import Language.GraphQL.TH
import Language.GraphQL.Type
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Validate
import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain)
import Text.Megaparsec (parse, errorBundlePretty)
-import Text.RawString.QQ (r)
petSchema :: Schema IO
petSchema = schema queryType Nothing (Just subscriptionType) mempty
@@ -163,7 +163,7 @@ spec =
describe "document" $ do
context "executableDefinitionsRule" $
it "rejects type definitions" $
- let queryString = [r|
+ let queryString = [gql|
query getDogName {
dog {
name
@@ -179,13 +179,13 @@ spec =
{ message =
"Definition must be OperationDefinition or \
\FragmentDefinition."
- , locations = [AST.Location 9 19]
+ , locations = [AST.Location 8 1]
}
in validate queryString `shouldContain` [expected]
context "singleFieldSubscriptionsRule" $ do
it "rejects multiple subscription root fields" $
- let queryString = [r|
+ let queryString = [gql|
subscription sub {
newMessage {
body
@@ -198,12 +198,12 @@ spec =
{ message =
"Subscription \"sub\" must select only one top \
\level field."
- , locations = [AST.Location 2 19]
+ , locations = [AST.Location 1 1]
}
in validate queryString `shouldContain` [expected]
it "rejects multiple subscription root fields coming from a fragment" $
- let queryString = [r|
+ let queryString = [gql|
subscription sub {
...multipleSubscriptions
}
@@ -220,12 +220,12 @@ spec =
{ message =
"Subscription \"sub\" must select only one top \
\level field."
- , locations = [AST.Location 2 19]
+ , locations = [AST.Location 1 1]
}
in validate queryString `shouldContain` [expected]
it "finds corresponding subscription fragment" $
- let queryString = [r|
+ let queryString = [gql|
subscription sub {
...anotherSubscription
...multipleSubscriptions
@@ -249,13 +249,13 @@ spec =
{ message =
"Subscription \"sub\" must select only one top \
\level field."
- , locations = [AST.Location 2 19]
+ , locations = [AST.Location 1 1]
}
in validate queryString `shouldBe` [expected]
context "loneAnonymousOperationRule" $
it "rejects multiple anonymous operations" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
name
@@ -274,13 +274,13 @@ spec =
{ message =
"This anonymous operation must be the only defined \
\operation."
- , locations = [AST.Location 2 19]
+ , locations = [AST.Location 1 1]
}
in validate queryString `shouldBe` [expected]
context "uniqueOperationNamesRule" $
it "rejects operations with the same name" $
- let queryString = [r|
+ let queryString = [gql|
query dogOperation {
dog {
name
@@ -297,13 +297,13 @@ spec =
{ message =
"There can be only one operation named \
\\"dogOperation\"."
- , locations = [AST.Location 2 19, AST.Location 8 19]
+ , locations = [AST.Location 1 1, AST.Location 7 1]
}
in validate queryString `shouldBe` [expected]
context "uniqueFragmentNamesRule" $
it "rejects fragments with the same name" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
...fragmentOne
@@ -324,13 +324,13 @@ spec =
{ message =
"There can be only one fragment named \
\\"fragmentOne\"."
- , locations = [AST.Location 8 19, AST.Location 12 19]
+ , locations = [AST.Location 7 1, AST.Location 11 1]
}
in validate queryString `shouldBe` [expected]
context "fragmentSpreadTargetDefinedRule" $
it "rejects the fragment spread without a target" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
...undefinedFragment
@@ -341,13 +341,13 @@ spec =
{ message =
"Fragment target \"undefinedFragment\" is \
\undefined."
- , locations = [AST.Location 4 23]
+ , locations = [AST.Location 3 5]
}
in validate queryString `shouldBe` [expected]
context "fragmentSpreadTypeExistenceRule" $ do
it "rejects fragment spreads without an unknown target type" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
...notOnExistingType
@@ -362,12 +362,12 @@ spec =
"Fragment \"notOnExistingType\" is specified on \
\type \"NotInSchema\" which doesn't exist in the \
\schema."
- , locations = [AST.Location 4 23]
+ , locations = [AST.Location 3 5]
}
in validate queryString `shouldBe` [expected]
it "rejects inline fragments without a target" $
- let queryString = [r|
+ let queryString = [gql|
{
... on NotInSchema {
name
@@ -378,13 +378,13 @@ spec =
{ message =
"Inline fragment is specified on type \
\\"NotInSchema\" which doesn't exist in the schema."
- , locations = [AST.Location 3 21]
+ , locations = [AST.Location 2 3]
}
in validate queryString `shouldBe` [expected]
context "fragmentsOnCompositeTypesRule" $ do
it "rejects fragments on scalar types" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
...fragOnScalar
@@ -398,12 +398,12 @@ spec =
{ message =
"Fragment cannot condition on non composite type \
\\"Int\"."
- , locations = [AST.Location 7 19]
+ , locations = [AST.Location 6 1]
}
in validate queryString `shouldContain` [expected]
it "rejects inline fragments on scalar types" $
- let queryString = [r|
+ let queryString = [gql|
{
... on Boolean {
name
@@ -414,13 +414,13 @@ spec =
{ message =
"Fragment cannot condition on non composite type \
\\"Boolean\"."
- , locations = [AST.Location 3 21]
+ , locations = [AST.Location 2 3]
}
in validate queryString `shouldContain` [expected]
context "noUnusedFragmentsRule" $
it "rejects unused fragments" $
- let queryString = [r|
+ let queryString = [gql|
fragment nameFragment on Dog { # unused
name
}
@@ -434,13 +434,13 @@ spec =
expected = Error
{ message =
"Fragment \"nameFragment\" is never used."
- , locations = [AST.Location 2 19]
+ , locations = [AST.Location 1 1]
}
in validate queryString `shouldBe` [expected]
context "noFragmentCyclesRule" $
it "rejects spreads that form cycles" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
...nameFragment
@@ -460,20 +460,20 @@ spec =
"Cannot spread fragment \"barkVolumeFragment\" \
\within itself (via barkVolumeFragment -> \
\nameFragment -> barkVolumeFragment)."
- , locations = [AST.Location 11 19]
+ , locations = [AST.Location 10 1]
}
error2 = Error
{ message =
"Cannot spread fragment \"nameFragment\" within \
\itself (via nameFragment -> barkVolumeFragment -> \
\nameFragment)."
- , locations = [AST.Location 7 19]
+ , locations = [AST.Location 6 1]
}
in validate queryString `shouldBe` [error1, error2]
context "uniqueArgumentNamesRule" $
it "rejects duplicate field arguments" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
isHousetrained(atOtherHomes: true, atOtherHomes: true)
@@ -484,13 +484,13 @@ spec =
{ message =
"There can be only one argument named \
\\"atOtherHomes\"."
- , locations = [AST.Location 4 38, AST.Location 4 58]
+ , locations = [AST.Location 3 20, AST.Location 3 40]
}
in validate queryString `shouldBe` [expected]
context "uniqueDirectiveNamesRule" $
it "rejects more than one directive per location" $
- let queryString = [r|
+ let queryString = [gql|
query ($foo: Boolean = true, $bar: Boolean = false) {
dog @skip(if: $foo) @skip(if: $bar) {
name
@@ -500,13 +500,13 @@ spec =
expected = Error
{ message =
"There can be only one directive named \"skip\"."
- , locations = [AST.Location 3 25, AST.Location 3 41]
+ , locations = [AST.Location 2 7, AST.Location 2 23]
}
in validate queryString `shouldBe` [expected]
context "uniqueVariableNamesRule" $
it "rejects duplicate variables" $
- let queryString = [r|
+ let queryString = [gql|
query houseTrainedQuery($atOtherHomes: Boolean, $atOtherHomes: Boolean) {
dog {
isHousetrained(atOtherHomes: $atOtherHomes)
@@ -517,13 +517,13 @@ spec =
{ message =
"There can be only one variable named \
\\"atOtherHomes\"."
- , locations = [AST.Location 2 43, AST.Location 2 67]
+ , locations = [AST.Location 1 25, AST.Location 1 49]
}
in validate queryString `shouldBe` [expected]
context "variablesAreInputTypesRule" $
it "rejects non-input types as variables" $
- let queryString = [r|
+ let queryString = [gql|
query takesDogBang($dog: Dog!) {
dog {
isHousetrained(atOtherHomes: $dog)
@@ -534,13 +534,13 @@ spec =
{ message =
"Variable \"$dog\" cannot be non-input type \
\\"Dog\"."
- , locations = [AST.Location 2 38]
+ , locations = [AST.Location 1 20]
}
in validate queryString `shouldContain` [expected]
context "noUndefinedVariablesRule" $
it "rejects undefined variables" $
- let queryString = [r|
+ let queryString = [gql|
query variableIsNotDefinedUsedInSingleFragment {
dog {
...isHousetrainedFragment
@@ -556,13 +556,13 @@ spec =
"Variable \"$atOtherHomes\" is not defined by \
\operation \
\\"variableIsNotDefinedUsedInSingleFragment\"."
- , locations = [AST.Location 9 50]
+ , locations = [AST.Location 8 32]
}
in validate queryString `shouldBe` [expected]
context "noUnusedVariablesRule" $
it "rejects unused variables" $
- let queryString = [r|
+ let queryString = [gql|
query variableUnused($atOtherHomes: Boolean) {
dog {
isHousetrained
@@ -573,13 +573,13 @@ spec =
{ message =
"Variable \"$atOtherHomes\" is never used in \
\operation \"variableUnused\"."
- , locations = [AST.Location 2 40]
+ , locations = [AST.Location 1 22]
}
in validate queryString `shouldBe` [expected]
context "uniqueInputFieldNamesRule" $
it "rejects duplicate fields in input objects" $
- let queryString = [r|
+ let queryString = [gql|
{
findDog(complex: { name: "Fido", name: "Jack" }) {
name
@@ -589,13 +589,13 @@ spec =
expected = Error
{ message =
"There can be only one input field named \"name\"."
- , locations = [AST.Location 3 40, AST.Location 3 54]
+ , locations = [AST.Location 2 22, AST.Location 2 36]
}
in validate queryString `shouldBe` [expected]
context "fieldsOnCorrectTypeRule" $
it "rejects undefined fields" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
meowVolume
@@ -605,13 +605,13 @@ spec =
expected = Error
{ message =
"Cannot query field \"meowVolume\" on type \"Dog\"."
- , locations = [AST.Location 4 23]
+ , locations = [AST.Location 3 5]
}
in validate queryString `shouldBe` [expected]
context "scalarLeafsRule" $
it "rejects scalar fields with not empty selection set" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
barkVolume {
@@ -624,13 +624,13 @@ spec =
{ message =
"Field \"barkVolume\" must not have a selection \
\since type \"Int\" has no subfields."
- , locations = [AST.Location 4 23]
+ , locations = [AST.Location 3 5]
}
in validate queryString `shouldBe` [expected]
context "knownArgumentNamesRule" $ do
it "rejects field arguments missing in the type" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
doesKnowCommand(command: CLEAN_UP_HOUSE, dogCommand: SIT)
@@ -641,12 +641,12 @@ spec =
{ message =
"Unknown argument \"command\" on field \
\\"Dog.doesKnowCommand\"."
- , locations = [AST.Location 4 39]
+ , locations = [AST.Location 3 21]
}
in validate queryString `shouldBe` [expected]
it "rejects directive arguments missing in the definition" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
isHousetrained(atOtherHomes: true) @include(unless: false, if: true)
@@ -657,13 +657,13 @@ spec =
{ message =
"Unknown argument \"unless\" on directive \
\\"@include\"."
- , locations = [AST.Location 4 67]
+ , locations = [AST.Location 3 49]
}
in validate queryString `shouldBe` [expected]
context "knownDirectiveNamesRule" $
it "rejects undefined directives" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
isHousetrained(atOtherHomes: true) @ignore(if: true)
@@ -672,13 +672,13 @@ spec =
|]
expected = Error
{ message = "Unknown directive \"@ignore\"."
- , locations = [AST.Location 4 58]
+ , locations = [AST.Location 3 40]
}
in validate queryString `shouldBe` [expected]
context "knownInputFieldNamesRule" $
it "rejects undefined input object fields" $
- let queryString = [r|
+ let queryString = [gql|
{
findDog(complex: { favoriteCookieFlavor: "Bacon", name: "Jack" }) {
name
@@ -689,13 +689,13 @@ spec =
{ message =
"Field \"favoriteCookieFlavor\" is not defined \
\by type \"DogData\"."
- , locations = [AST.Location 3 40]
+ , locations = [AST.Location 2 22]
}
in validate queryString `shouldBe` [expected]
context "directivesInValidLocationsRule" $
it "rejects directives in invalid locations" $
- let queryString = [r|
+ let queryString = [gql|
query @skip(if: $foo) {
dog {
name
@@ -705,13 +705,13 @@ spec =
expected = Error
{ message =
"Directive \"@skip\" may not be used on QUERY."
- , locations = [AST.Location 2 25]
+ , locations = [AST.Location 1 7]
}
in validate queryString `shouldBe` [expected]
context "overlappingFieldsCanBeMergedRule" $ do
it "fails to merge fields of mismatching types" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
name: nickname
@@ -725,12 +725,12 @@ spec =
\\"name\" are different fields. Use different \
\aliases on the fields to fetch both if this was \
\intentional."
- , locations = [AST.Location 4 23, AST.Location 5 23]
+ , locations = [AST.Location 3 5, AST.Location 4 5]
}
in validate queryString `shouldBe` [expected]
it "fails if the arguments of the same field don't match" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
doesKnowCommand(dogCommand: SIT)
@@ -744,12 +744,12 @@ spec =
\have different arguments. Use different aliases \
\on the fields to fetch both if this was \
\intentional."
- , locations = [AST.Location 4 23, AST.Location 5 23]
+ , locations = [AST.Location 3 5, AST.Location 4 5]
}
in validate queryString `shouldBe` [expected]
it "fails to merge same-named field and alias" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
doesKnowCommand(dogCommand: SIT)
@@ -763,12 +763,12 @@ spec =
\\"doesKnowCommand\" and \"isHousetrained\" are \
\different fields. Use different aliases on the \
\fields to fetch both if this was intentional."
- , locations = [AST.Location 4 23, AST.Location 5 23]
+ , locations = [AST.Location 3 5, AST.Location 4 5]
}
in validate queryString `shouldBe` [expected]
it "looks for fields after a successfully merged field pair" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
name
@@ -786,13 +786,13 @@ spec =
\\"doesKnowCommand\" and \"isHousetrained\" are \
\different fields. Use different aliases on the \
\fields to fetch both if this was intentional."
- , locations = [AST.Location 5 23, AST.Location 9 23]
+ , locations = [AST.Location 4 5, AST.Location 8 5]
}
in validate queryString `shouldBe` [expected]
context "possibleFragmentSpreadsRule" $ do
it "rejects object inline spreads outside object scope" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
... on Cat {
@@ -805,12 +805,12 @@ spec =
{ message =
"Fragment cannot be spread here as objects of type \
\\"Dog\" can never be of type \"Cat\"."
- , locations = [AST.Location 4 23]
+ , locations = [AST.Location 3 5]
}
in validate queryString `shouldBe` [expected]
it "rejects object named spreads outside object scope" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
... catInDogFragmentInvalid
@@ -826,13 +826,13 @@ spec =
"Fragment \"catInDogFragmentInvalid\" cannot be \
\spread here as objects of type \"Dog\" can never \
\be of type \"Cat\"."
- , locations = [AST.Location 4 23]
+ , locations = [AST.Location 3 5]
}
in validate queryString `shouldBe` [expected]
context "providedRequiredInputFieldsRule" $
it "rejects missing required input fields" $
- let queryString = [r|
+ let queryString = [gql|
{
findDog(complex: { name: null }) {
name
@@ -843,13 +843,13 @@ spec =
{ message =
"Input field \"name\" of type \"DogData\" is \
\required, but it was not provided."
- , locations = [AST.Location 3 38]
+ , locations = [AST.Location 2 20]
}
in validate queryString `shouldBe` [expected]
context "providedRequiredArgumentsRule" $ do
it "checks for (non-)nullable arguments" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
doesKnowCommand(dogCommand: null)
@@ -861,13 +861,13 @@ spec =
"Field \"doesKnowCommand\" argument \"dogCommand\" \
\of type \"DogCommand\" is required, but it was \
\not provided."
- , locations = [AST.Location 4 23]
+ , locations = [AST.Location 3 5]
}
in validate queryString `shouldBe` [expected]
context "variablesInAllowedPositionRule" $ do
it "rejects wrongly typed variable arguments" $
- let queryString = [r|
+ let queryString = [gql|
query dogCommandArgQuery($dogCommandArg: DogCommand) {
dog {
doesKnowCommand(dogCommand: $dogCommandArg)
@@ -879,12 +879,12 @@ spec =
"Variable \"$dogCommandArg\" of type \
\\"DogCommand\" used in position expecting type \
\\"!DogCommand\"."
- , locations = [AST.Location 2 44]
+ , locations = [AST.Location 1 26]
}
in validate queryString `shouldBe` [expected]
it "rejects wrongly typed variable arguments" $
- let queryString = [r|
+ let queryString = [gql|
query intCannotGoIntoBoolean($intArg: Int) {
dog {
isHousetrained(atOtherHomes: $intArg)
@@ -895,13 +895,13 @@ spec =
{ message =
"Variable \"$intArg\" of type \"Int\" used in \
\position expecting type \"Boolean\"."
- , locations = [AST.Location 2 48]
+ , locations = [AST.Location 1 30]
}
in validate queryString `shouldBe` [expected]
context "valuesOfCorrectTypeRule" $ do
it "rejects values of incorrect types" $
- let queryString = [r|
+ let queryString = [gql|
{
dog {
isHousetrained(atOtherHomes: 3)
@@ -911,12 +911,12 @@ spec =
expected = Error
{ message =
"Value 3 cannot be coerced to type \"Boolean\"."
- , locations = [AST.Location 4 52]
+ , locations = [AST.Location 3 34]
}
in validate queryString `shouldBe` [expected]
it "uses the location of a single list value" $
- let queryString = [r|
+ let queryString = [gql|
{
cat {
doesKnowCommands(catCommands: [3])
@@ -926,12 +926,12 @@ spec =
expected = Error
{ message =
"Value 3 cannot be coerced to type \"!CatCommand\"."
- , locations = [AST.Location 4 54]
+ , locations = [AST.Location 3 36]
}
in validate queryString `shouldBe` [expected]
it "validates input object properties once" $
- let queryString = [r|
+ let queryString = [gql|
{
findDog(complex: { name: 3 }) {
name
@@ -941,12 +941,12 @@ spec =
expected = Error
{ message =
"Value 3 cannot be coerced to type \"!String\"."
- , locations = [AST.Location 3 46]
+ , locations = [AST.Location 2 28]
}
in validate queryString `shouldBe` [expected]
it "checks for required list members" $
- let queryString = [r|
+ let queryString = [gql|
{
cat {
doesKnowCommands(catCommands: [null])
@@ -957,6 +957,6 @@ spec =
{ message =
"List of non-null values of type \"CatCommand\" \
\cannot contain null values."
- , locations = [AST.Location 4 54]
+ , locations = [AST.Location 3 36]
}
in validate queryString `shouldBe` [expected]
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 09:37:04 +0000