diff options
Diffstat (limited to 'tests/Language/GraphQL')
| -rw-r--r-- | tests/Language/GraphQL/AST/EncoderSpec.hs | 64 | ||||
| -rw-r--r-- | tests/Language/GraphQL/AST/LexerSpec.hs | 4 | ||||
| -rw-r--r-- | tests/Language/GraphQL/AST/ParserSpec.hs | 2 | ||||
| -rw-r--r-- | tests/Language/GraphQL/ErrorSpec.hs | 2 | ||||
| -rw-r--r-- | tests/Language/GraphQL/ExecuteSpec.hs | 39 | ||||
| -rw-r--r-- | tests/Language/GraphQL/ValidateSpec.hs | 522 |
6 files changed, 518 insertions, 115 deletions
diff --git a/tests/Language/GraphQL/AST/EncoderSpec.hs b/tests/Language/GraphQL/AST/EncoderSpec.hs index 5fa3706..0c7dd39 100644 --- a/tests/Language/GraphQL/AST/EncoderSpec.hs +++ b/tests/Language/GraphQL/AST/EncoderSpec.hs @@ -4,7 +4,7 @@ module Language.GraphQL.AST.EncoderSpec ( spec ) where -import Language.GraphQL.AST +import qualified Language.GraphQL.AST.Document as Full import Language.GraphQL.AST.Encoder import Test.Hspec (Spec, context, describe, it, shouldBe, shouldStartWith, shouldEndWith, shouldNotContain) import Test.QuickCheck (choose, oneof, forAll) @@ -15,52 +15,52 @@ spec :: Spec spec = do describe "value" $ do context "null value" $ do - let testNull formatter = value formatter Null `shouldBe` "null" + let testNull formatter = value formatter Full.Null `shouldBe` "null" it "minified" $ testNull minified it "pretty" $ testNull pretty context "minified" $ do it "escapes \\" $ - value minified (String "\\") `shouldBe` "\"\\\\\"" + value minified (Full.String "\\") `shouldBe` "\"\\\\\"" it "escapes double quotes" $ - value minified (String "\"") `shouldBe` "\"\\\"\"" + value minified (Full.String "\"") `shouldBe` "\"\\\"\"" it "escapes \\f" $ - value minified (String "\f") `shouldBe` "\"\\f\"" + value minified (Full.String "\f") `shouldBe` "\"\\f\"" it "escapes \\n" $ - value minified (String "\n") `shouldBe` "\"\\n\"" + value minified (Full.String "\n") `shouldBe` "\"\\n\"" it "escapes \\r" $ - value minified (String "\r") `shouldBe` "\"\\r\"" + value minified (Full.String "\r") `shouldBe` "\"\\r\"" it "escapes \\t" $ - value minified (String "\t") `shouldBe` "\"\\t\"" + value minified (Full.String "\t") `shouldBe` "\"\\t\"" it "escapes backspace" $ - value minified (String "a\bc") `shouldBe` "\"a\\bc\"" + value minified (Full.String "a\bc") `shouldBe` "\"a\\bc\"" context "escapes Unicode for chars less than 0010" $ do - it "Null" $ value minified (String "\x0000") `shouldBe` "\"\\u0000\"" - it "bell" $ value minified (String "\x0007") `shouldBe` "\"\\u0007\"" + it "Null" $ value minified (Full.String "\x0000") `shouldBe` "\"\\u0000\"" + it "bell" $ value minified (Full.String "\x0007") `shouldBe` "\"\\u0007\"" context "escapes Unicode for char less than 0020" $ do - it "DLE" $ value minified (String "\x0010") `shouldBe` "\"\\u0010\"" - it "EM" $ value minified (String "\x0019") `shouldBe` "\"\\u0019\"" + it "DLE" $ value minified (Full.String "\x0010") `shouldBe` "\"\\u0010\"" + it "EM" $ value minified (Full.String "\x0019") `shouldBe` "\"\\u0019\"" context "encodes without escape" $ do - it "space" $ value minified (String "\x0020") `shouldBe` "\" \"" - it "~" $ value minified (String "\x007E") `shouldBe` "\"~\"" + it "space" $ value minified (Full.String "\x0020") `shouldBe` "\" \"" + it "~" $ value minified (Full.String "\x007E") `shouldBe` "\"~\"" context "pretty" $ do it "uses strings for short string values" $ - value pretty (String "Short text") `shouldBe` "\"Short text\"" + value pretty (Full.String "Short text") `shouldBe` "\"Short text\"" it "uses block strings for text with new lines, with newline symbol" $ - value pretty (String "Line 1\nLine 2") + value pretty (Full.String "Line 1\nLine 2") `shouldBe` [r|""" Line 1 Line 2 """|] it "uses block strings for text with new lines, with CR symbol" $ - value pretty (String "Line 1\rLine 2") + value pretty (Full.String "Line 1\rLine 2") `shouldBe` [r|""" Line 1 Line 2 """|] it "uses block strings for text with new lines, with CR symbol followed by newline" $ - value pretty (String "Line 1\r\nLine 2") + value pretty (Full.String "Line 1\r\nLine 2") `shouldBe` [r|""" Line 1 Line 2 @@ -77,12 +77,12 @@ spec = do forAll genNotAllowedSymbol $ \x -> do let rawValue = "Short \n" <> cons x "text" - encoded = value pretty (String $ toStrict rawValue) + encoded = value pretty (Full.String $ toStrict rawValue) shouldStartWith (unpack encoded) "\"" shouldEndWith (unpack encoded) "\"" shouldNotContain (unpack encoded) "\"\"\"" - it "Hello world" $ value pretty (String "Hello,\n World!\n\nYours,\n GraphQL.") + it "Hello world" $ value pretty (Full.String "Hello,\n World!\n\nYours,\n GraphQL.") `shouldBe` [r|""" Hello, World! @@ -91,29 +91,29 @@ spec = do GraphQL. """|] - it "has only newlines" $ value pretty (String "\n") `shouldBe` [r|""" + it "has only newlines" $ value pretty (Full.String "\n") `shouldBe` [r|""" """|] it "has newlines and one symbol at the begining" $ - value pretty (String "a\n\n") `shouldBe` [r|""" + value pretty (Full.String "a\n\n") `shouldBe` [r|""" a """|] it "has newlines and one symbol at the end" $ - value pretty (String "\n\na") `shouldBe` [r|""" + value pretty (Full.String "\n\na") `shouldBe` [r|""" a """|] it "has newlines and one symbol in the middle" $ - value pretty (String "\na\n") `shouldBe` [r|""" + value pretty (Full.String "\na\n") `shouldBe` [r|""" a """|] - it "skip trailing whitespaces" $ value pretty (String " Short\ntext ") + it "skip trailing whitespaces" $ value pretty (Full.String " Short\ntext ") `shouldBe` [r|""" Short text @@ -121,11 +121,13 @@ spec = do describe "definition" $ it "indents block strings in arguments" $ - let arguments = [Argument "message" (String "line1\nline2")] - field = Field Nothing "field" arguments [] [] - operation = DefinitionOperation - $ SelectionSet (pure field) - $ Location 0 0 + let location = Full.Location 0 0 + argumentValue = Full.Node (Full.String "line1\nline2") location + arguments = [Full.Argument "message" argumentValue location] + field = Full.Field Nothing "field" arguments [] [] location + fieldSelection = pure $ Full.FieldSelection field + operation = Full.DefinitionOperation + $ Full.SelectionSet fieldSelection location in definition pretty operation `shouldBe` [r|{ field(message: """ line1 diff --git a/tests/Language/GraphQL/AST/LexerSpec.hs b/tests/Language/GraphQL/AST/LexerSpec.hs index 0b4cb31..c4fae45 100644 --- a/tests/Language/GraphQL/AST/LexerSpec.hs +++ b/tests/Language/GraphQL/AST/LexerSpec.hs @@ -75,9 +75,9 @@ spec = describe "Lexer" $ do parse dollar "" "$" `shouldParse` "$" runBetween parens `shouldSucceedOn` "()" parse spread "" "..." `shouldParse` "..." - parse colon "" ":" `shouldParse` ":" + parse colon "" `shouldSucceedOn` ":" parse equals "" "=" `shouldParse` "=" - parse at "" "@" `shouldParse` "@" + parse at "" `shouldSucceedOn` "@" runBetween brackets `shouldSucceedOn` "[]" runBetween braces `shouldSucceedOn` "{}" parse pipe "" "|" `shouldParse` "|" diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs index f59e5a9..5c4d39e 100644 --- a/tests/Language/GraphQL/AST/ParserSpec.hs +++ b/tests/Language/GraphQL/AST/ParserSpec.hs @@ -128,7 +128,7 @@ spec = describe "Parser" $ do parse document "" `shouldSucceedOn` [r|extend schema { query: Query }|] it "parses schema extension with an operation type and directive" $ - let newDirective = Directive "newDirective" [] + let newDirective = Directive "newDirective" [] $ Location 1 15 schemaExtension = SchemaExtension $ SchemaOperationExtension [newDirective] $ OperationTypeDefinition Query "Query" :| [] diff --git a/tests/Language/GraphQL/ErrorSpec.hs b/tests/Language/GraphQL/ErrorSpec.hs index 1497c48..38d7d3a 100644 --- a/tests/Language/GraphQL/ErrorSpec.hs +++ b/tests/Language/GraphQL/ErrorSpec.hs @@ -19,6 +19,6 @@ import Test.Hspec ( Spec spec :: Spec spec = describe "singleError" $ it "constructs an error with the given message" $ - let errors'' = Seq.singleton $ Error "Message." [] + let errors'' = Seq.singleton $ Error "Message." [] [] expected = Response Aeson.Null errors'' in singleError "Message." `shouldBe` expected diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs index 8fbb55b..f6e3e6f 100644 --- a/tests/Language/GraphQL/ExecuteSpec.hs +++ b/tests/Language/GraphQL/ExecuteSpec.hs @@ -3,6 +3,7 @@ obtain one at https://mozilla.org/MPL/2.0/. -} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} module Language.GraphQL.ExecuteSpec ( spec ) where @@ -10,10 +11,11 @@ module Language.GraphQL.ExecuteSpec import Control.Exception (SomeException) 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 (Name) +import Language.GraphQL.AST (Document, Name) import Language.GraphQL.AST.Parser (document) import Language.GraphQL.Error import Language.GraphQL.Execute @@ -21,13 +23,10 @@ import Language.GraphQL.Type as Type import Language.GraphQL.Type.Out as Out import Test.Hspec (Spec, context, describe, it, shouldBe) import Text.Megaparsec (parse) +import Text.RawString.QQ (r) -schema :: Schema (Either SomeException) -schema = Schema - { query = queryType - , mutation = Nothing - , subscription = Just subscriptionType - } +philosopherSchema :: Schema (Either SomeException) +philosopherSchema = schema queryType Nothing (Just subscriptionType) mempty queryType :: Out.ObjectType (Either SomeException) queryType = Out.ObjectType "Query" Nothing [] @@ -71,9 +70,32 @@ quoteType = Out.ObjectType "Quote" Nothing [] quoteField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty +type EitherStreamOrValue = Either + (ResponseEventStream (Either SomeException) Aeson.Value) + (Response Aeson.Value) + +execute' :: Document -> Either SomeException EitherStreamOrValue +execute' = + execute philosopherSchema Nothing (mempty :: HashMap Name Aeson.Value) + spec :: Spec spec = describe "execute" $ do + it "rejects recursive fragments" $ + let sourceQuery = [r| + { + ...cyclicFragment + } + + fragment cyclicFragment on Query { + ...cyclicFragment + } + |] + expected = Response emptyObject mempty + Right (Right actual) = either (pure . parseError) execute' + $ parse document "" sourceQuery + in actual `shouldBe` expected + context "Query" $ do it "skips unknown fields" $ let data'' = Aeson.object @@ -82,7 +104,6 @@ spec = ] ] expected = Response data'' mempty - execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value) Right (Right actual) = either (pure . parseError) execute' $ parse document "" "{ philosopher { firstName surname } }" in actual `shouldBe` expected @@ -94,7 +115,6 @@ spec = ] ] expected = Response data'' mempty - execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value) Right (Right actual) = either (pure . parseError) execute' $ parse document "" "{ philosopher { firstName } philosopher { lastName } }" in actual `shouldBe` expected @@ -106,7 +126,6 @@ spec = ] ] expected = Response data'' mempty - execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value) Right (Left stream) = either (pure . parseError) execute' $ parse document "" "subscription { newQuote { quote } }" Right (Just actual) = runConduit $ stream .| await diff --git a/tests/Language/GraphQL/ValidateSpec.hs b/tests/Language/GraphQL/ValidateSpec.hs index 8f6626b..318045c 100644 --- a/tests/Language/GraphQL/ValidateSpec.hs +++ b/tests/Language/GraphQL/ValidateSpec.hs @@ -9,8 +9,7 @@ module Language.GraphQL.ValidateSpec ( spec ) where -import Data.Sequence (Seq(..)) -import qualified Data.Sequence as Seq +import Data.Foldable (toList) import qualified Data.HashMap.Strict as HashMap import Data.Text (Text) import qualified Language.GraphQL.AST as AST @@ -18,23 +17,25 @@ 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, describe, it, shouldBe) +import Test.Hspec (Spec, describe, it, shouldBe, shouldContain) import Text.Megaparsec (parse) import Text.RawString.QQ (r) -schema :: Schema IO -schema = Schema - { query = queryType - , mutation = Nothing - , subscription = Nothing - } +petSchema :: Schema IO +petSchema = schema queryType Nothing (Just subscriptionType) mempty queryType :: ObjectType IO -queryType = ObjectType "Query" Nothing [] - $ HashMap.singleton "dog" dogResolver +queryType = ObjectType "Query" Nothing [] $ HashMap.fromList + [ ("dog", dogResolver) + , ("findDog", findDogResolver) + ] where dogField = Field Nothing (Out.NamedObjectType dogType) mempty dogResolver = ValueResolver dogField $ pure Null + findDogArguments = HashMap.singleton "complex" + $ In.Argument Nothing (In.NonNullInputObjectType dogDataType) Nothing + findDogField = Field Nothing (Out.NamedObjectType dogType) findDogArguments + findDogResolver = ValueResolver findDogField $ pure Null dogCommandType :: EnumType dogCommandType = EnumType "DogCommand" Nothing $ HashMap.fromList @@ -72,6 +73,12 @@ dogType = ObjectType "Dog" Nothing [petType] $ HashMap.fromList ownerField = Field Nothing (Out.NamedObjectType humanType) mempty ownerResolver = ValueResolver ownerField $ pure Null +dogDataType :: InputObjectType +dogDataType = InputObjectType "DogData" Nothing + $ HashMap.singleton "name" nameInputField + where + nameInputField = InputField Nothing (In.NonNullScalarType string) Nothing + sentientType :: InterfaceType IO sentientType = InterfaceType "Sentient" Nothing [] $ HashMap.singleton "name" @@ -81,19 +88,28 @@ petType :: InterfaceType IO petType = InterfaceType "Pet" Nothing [] $ HashMap.singleton "name" $ Field Nothing (Out.NonNullScalarType string) mempty -{- -alienType :: ObjectType IO -alienType = ObjectType "Alien" Nothing [sentientType] $ HashMap.fromList - [ ("name", nameResolver) - , ("homePlanet", homePlanetResolver) + +subscriptionType :: ObjectType IO +subscriptionType = ObjectType "Subscription" Nothing [] $ HashMap.fromList + [ ("newMessage", newMessageResolver) + , ("disallowedSecondRootField", newMessageResolver) ] where - nameField = Field Nothing (Out.NonNullScalarType string) mempty - nameResolver = ValueResolver nameField $ pure "Name" - homePlanetField = - Field Nothing (Out.NamedScalarType string) mempty - homePlanetResolver = ValueResolver homePlanetField $ pure "Home planet" --} + newMessageField = Field Nothing (Out.NonNullObjectType messageType) mempty + newMessageResolver = ValueResolver newMessageField + $ pure $ Object HashMap.empty + +messageType :: ObjectType IO +messageType = ObjectType "Message" Nothing [] $ HashMap.fromList + [ ("sender", senderResolver) + , ("body", bodyResolver) + ] + where + senderField = Field Nothing (Out.NonNullScalarType string) mempty + senderResolver = ValueResolver senderField $ pure "Sender" + bodyField = Field Nothing (Out.NonNullScalarType string) mempty + bodyResolver = ValueResolver bodyField $ pure "Message body." + humanType :: ObjectType IO humanType = ObjectType "Human" Nothing [sentientType] $ HashMap.fromList [ ("name", nameResolver) @@ -106,45 +122,14 @@ humanType = ObjectType "Human" Nothing [sentientType] $ HashMap.fromList Field Nothing (Out.ListType $ Out.NonNullInterfaceType petType) mempty petsResolver = ValueResolver petsField $ pure $ List [] {- -catCommandType :: EnumType -catCommandType = EnumType "CatCommand" Nothing $ HashMap.fromList - [ ("JUMP", EnumValue Nothing) - ] - -catType :: ObjectType IO -catType = ObjectType "Cat" Nothing [petType] $ HashMap.fromList - [ ("name", nameResolver) - , ("nickname", nicknameResolver) - , ("doesKnowCommand", doesKnowCommandResolver) - , ("meowVolume", meowVolumeResolver) - ] - where - nameField = Field Nothing (Out.NonNullScalarType string) mempty - nameResolver = ValueResolver nameField $ pure "Name" - nicknameField = Field Nothing (Out.NamedScalarType string) mempty - nicknameResolver = ValueResolver nicknameField $ pure "Nickname" - doesKnowCommandField = Field Nothing (Out.NonNullScalarType boolean) - $ HashMap.singleton "catCommand" - $ In.Argument Nothing (In.NonNullEnumType catCommandType) Nothing - doesKnowCommandResolver = ValueResolver doesKnowCommandField - $ pure $ Boolean True - meowVolumeField = Field Nothing (Out.NamedScalarType int) mempty - meowVolumeResolver = ValueResolver meowVolumeField $ pure $ Int 2 - catOrDogType :: UnionType IO catOrDogType = UnionType "CatOrDog" Nothing [catType, dogType] - -dogOrHumanType :: UnionType IO -dogOrHumanType = UnionType "DogOrHuman" Nothing [dogType, humanType] - -humanOrAlienType :: UnionType IO -humanOrAlienType = UnionType "HumanOrAlien" Nothing [humanType, alienType] -} -validate :: Text -> Seq Error +validate :: Text -> [Error] validate queryString = case parse AST.document "" queryString of - Left _ -> Seq.empty - Right ast -> document schema specifiedRules ast + Left _ -> [] + Right ast -> toList $ document petSchema specifiedRules ast spec :: Spec spec = @@ -166,9 +151,8 @@ spec = { message = "Definition must be OperationDefinition or FragmentDefinition." , locations = [AST.Location 9 15] - , path = [] } - in validate queryString `shouldBe` Seq.singleton expected + in validate queryString `shouldContain` [expected] it "rejects multiple subscription root fields" $ let queryString = [r| @@ -182,11 +166,11 @@ spec = |] expected = Error { message = - "Subscription sub must select only one top level field." + "Subscription \"sub\" must select only one top level \ + \field." , locations = [AST.Location 2 15] - , path = [] } - in validate queryString `shouldBe` Seq.singleton expected + in validate queryString `shouldContain` [expected] it "rejects multiple subscription root fields coming from a fragment" $ let queryString = [r| @@ -204,11 +188,11 @@ spec = |] expected = Error { message = - "Subscription sub must select only one top level field." + "Subscription \"sub\" must select only one top level \ + \field." , locations = [AST.Location 2 15] - , path = [] } - in validate queryString `shouldBe` Seq.singleton expected + in validate queryString `shouldContain` [expected] it "rejects multiple anonymous operations" $ let queryString = [r| @@ -230,9 +214,8 @@ spec = { message = "This anonymous operation must be the only defined operation." , locations = [AST.Location 2 15] - , path = [] } - in validate queryString `shouldBe` Seq.singleton expected + in validate queryString `shouldBe` [expected] it "rejects operations with the same name" $ let queryString = [r| @@ -252,9 +235,8 @@ spec = { message = "There can be only one operation named \"dogOperation\"." , locations = [AST.Location 2 15, AST.Location 8 15] - , path = [] } - in validate queryString `shouldBe` Seq.singleton expected + in validate queryString `shouldBe` [expected] it "rejects fragments with the same name" $ let queryString = [r| @@ -278,6 +260,406 @@ spec = { message = "There can be only one fragment named \"fragmentOne\"." , locations = [AST.Location 8 15, AST.Location 12 15] - , path = [] } - in validate queryString `shouldBe` Seq.singleton expected + in validate queryString `shouldBe` [expected] + + it "rejects the fragment spread without a target" $ + let queryString = [r| + { + dog { + ...undefinedFragment + } + } + |] + expected = Error + { message = + "Fragment target \"undefinedFragment\" is undefined." + , locations = [AST.Location 4 19] + } + in validate queryString `shouldBe` [expected] + + it "rejects fragment spreads without an unknown target type" $ + let queryString = [r| + { + dog { + ...notOnExistingType + } + } + fragment notOnExistingType on NotInSchema { + name + } + |] + expected = Error + { message = + "Fragment \"notOnExistingType\" is specified on type \ + \\"NotInSchema\" which doesn't exist in the schema." + , locations = [AST.Location 4 19] + } + in validate queryString `shouldBe` [expected] + + it "rejects inline fragments without a target" $ + let queryString = [r| + { + ... on NotInSchema { + name + } + } + |] + expected = Error + { message = + "Inline fragment is specified on type \"NotInSchema\" \ + \which doesn't exist in the schema." + , locations = [AST.Location 3 17] + } + in validate queryString `shouldBe` [expected] + + it "rejects fragments on scalar types" $ + let queryString = [r| + { + dog { + ...fragOnScalar + } + } + fragment fragOnScalar on Int { + name + } + |] + expected = Error + { message = + "Fragment cannot condition on non composite type \ + \\"Int\"." + , locations = [AST.Location 7 15] + } + in validate queryString `shouldContain` [expected] + + it "rejects inline fragments on scalar types" $ + let queryString = [r| + { + ... on Boolean { + name + } + } + |] + expected = Error + { message = + "Fragment cannot condition on non composite type \ + \\"Boolean\"." + , locations = [AST.Location 3 17] + } + in validate queryString `shouldContain` [expected] + + it "rejects unused fragments" $ + let queryString = [r| + fragment nameFragment on Dog { # unused + name + } + + { + dog { + name + } + } + |] + expected = Error + { message = + "Fragment \"nameFragment\" is never used." + , locations = [AST.Location 2 15] + } + in validate queryString `shouldBe` [expected] + + it "rejects spreads that form cycles" $ + let queryString = [r| + { + dog { + ...nameFragment + } + } + fragment nameFragment on Dog { + name + ...barkVolumeFragment + } + fragment barkVolumeFragment on Dog { + barkVolume + ...nameFragment + } + |] + error1 = Error + { message = + "Cannot spread fragment \"barkVolumeFragment\" within \ + \itself (via barkVolumeFragment -> nameFragment -> \ + \barkVolumeFragment)." + , locations = [AST.Location 11 15] + } + error2 = Error + { message = + "Cannot spread fragment \"nameFragment\" within itself \ + \(via nameFragment -> barkVolumeFragment -> \ + \nameFragment)." + , locations = [AST.Location 7 15] + } + in validate queryString `shouldBe` [error1, error2] + + it "rejects duplicate field arguments" $ do + let queryString = [r| + { + dog { + isHousetrained(atOtherHomes: true, atOtherHomes: true) + } + } + |] + expected = Error + { message = + "There can be only one argument named \"atOtherHomes\"." + , locations = [AST.Location 4 34, AST.Location 4 54] + } + in validate queryString `shouldBe` [expected] + + it "rejects more than one directive per location" $ do + let queryString = [r| + query ($foo: Boolean = true, $bar: Boolean = false) { + dog @skip(if: $foo) @skip(if: $bar) { + name + } + } + |] + expected = Error + { message = + "There can be only one directive named \"skip\"." + , locations = [AST.Location 3 21, AST.Location 3 37] + } + in validate queryString `shouldBe` [expected] + + it "rejects duplicate variables" $ + let queryString = [r| + query houseTrainedQuery($atOtherHomes: Boolean, $atOtherHomes: Boolean) { + dog { + isHousetrained(atOtherHomes: $atOtherHomes) + } + } + |] + expected = Error + { message = + "There can be only one variable named \"atOtherHomes\"." + , locations = [AST.Location 2 39, AST.Location 2 63] + } + in validate queryString `shouldBe` [expected] + + it "rejects non-input types as variables" $ + let queryString = [r| + query takesDogBang($dog: Dog!) { + dog { + isHousetrained(atOtherHomes: $dog) + } + } + |] + expected = Error + { message = + "Variable \"$dog\" cannot be non-input type \"Dog\"." + , locations = [AST.Location 2 34] + } + in validate queryString `shouldBe` [expected] + + it "rejects undefined variables" $ + let queryString = [r| + query variableIsNotDefinedUsedInSingleFragment { + dog { + ...isHousetrainedFragment + } + } + + fragment isHousetrainedFragment on Dog { + isHousetrained(atOtherHomes: $atOtherHomes) + } + |] + expected = Error + { message = + "Variable \"$atOtherHomes\" is not defined by \ + \operation \ + \\"variableIsNotDefinedUsedInSingleFragment\"." + , locations = [AST.Location 9 46] + } + in validate queryString `shouldBe` [expected] + + it "rejects unused variables" $ + let queryString = [r| + query variableUnused($atOtherHomes: Boolean) { + dog { + isHousetrained + } + } + |] + expected = Error + { message = + "Variable \"$atOtherHomes\" is never used in operation \ + \\"variableUnused\"." + , locations = [AST.Location 2 36] + } + in validate queryString `shouldBe` [expected] + + it "rejects duplicate fields in input objects" $ + let queryString = [r| + { + findDog(complex: { name: "Fido", name: "Jack" }) { + name + } + } + |] + expected = Error + { message = + "There can be only one input field named \"name\"." + , locations = [AST.Location 3 36, AST.Location 3 50] + } + in validate queryString `shouldBe` [expected] + + it "rejects undefined fields" $ + let queryString = [r| + { + dog { + meowVolume + } + } + |] + expected = Error + { message = + "Cannot query field \"meowVolume\" on type \"Dog\"." + , locations = [AST.Location 4 19] + } + in validate queryString `shouldBe` [expected] + + it "rejects scalar fields with not empty selection set" $ + let queryString = [r| + { + dog { + barkVolume { + sinceWhen + } + } + } + |] + expected = Error + { message = + "Field \"barkVolume\" must not have a selection since \ + \type \"Int\" has no subfields." + , 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, dogCommand: SIT) + } + } + |] + 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, if: true) + } + } + |] + expected = Error + { message = + "Unknown argument \"unless\" on directive \"@include\"." + , locations = [AST.Location 4 63] + } + in validate queryString `shouldBe` [expected] + + it "rejects undefined directives" $ + let queryString = [r| + { + dog { + isHousetrained(atOtherHomes: true) @ignore(if: true) + } + } + |] + expected = Error + { message = "Unknown directive \"@ignore\"." + , locations = [AST.Location 4 54] + } + in validate queryString `shouldBe` [expected] + + it "rejects undefined input object fields" $ + let queryString = [r| + { + findDog(complex: { favoriteCookieFlavor: "Bacon", name: "Jack" }) { + name + } + } + |] + expected = Error + { message = + "Field \"favoriteCookieFlavor\" is not defined \ + \by type \"DogData\"." + , locations = [AST.Location 3 36] + } + in validate queryString `shouldBe` [expected] + + it "rejects directives in invalid locations" $ + let queryString = [r| + query @skip(if: $foo) { + dog { + name + } + } + |] + expected = Error + { message = "Directive \"@skip\" may not be used on QUERY." + , locations = [AST.Location 2 21] + } + in validate queryString `shouldBe` [expected] + + it "rejects missing required input fields" $ + let queryString = [r| + { + findDog(complex: { name: null }) { + name + } + } + |] + expected = Error + { message = + "Input field \"name\" of type \"DogData\" is required, \ + \but it was not provided." + , locations = [AST.Location 3 34] + } + in validate queryString `shouldBe` [expected] + + it "finds corresponding subscription fragment" $ + let queryString = [r| + subscription sub { + ...anotherSubscription + ...multipleSubscriptions + } + fragment multipleSubscriptions on Subscription { + newMessage { + body + } + disallowedSecondRootField { + sender + } + } + fragment anotherSubscription on Subscription { + newMessage { + body + sender + } + } + |] + expected = Error + { message = + "Subscription \"sub\" must select only one top level \ + \field." + , locations = [AST.Location 2 15] + } + in validate queryString `shouldBe` [expected] |