Validate fragment spreads are possible

This commit is contained in:
2020-11-19 08:48:37 +01:00
parent 86a0e00f7e
commit 2dbc985dfc
3 changed files with 183 additions and 34 deletions

View File

@ -18,7 +18,7 @@ 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, shouldContain)
import Text.Megaparsec (parse)
import Text.Megaparsec (parse, errorBundlePretty)
import Text.RawString.QQ (r)
petSchema :: Schema IO
@ -27,6 +27,7 @@ petSchema = schema queryType Nothing (Just subscriptionType) mempty
queryType :: ObjectType IO
queryType = ObjectType "Query" Nothing [] $ HashMap.fromList
[ ("dog", dogResolver)
, ("cat", catResolver)
, ("findDog", findDogResolver)
]
where
@ -36,6 +37,39 @@ queryType = ObjectType "Query" Nothing [] $ HashMap.fromList
$ In.Argument Nothing (In.NonNullInputObjectType dogDataType) Nothing
findDogField = Field Nothing (Out.NamedObjectType dogType) findDogArguments
findDogResolver = ValueResolver findDogField $ pure Null
catField = Field Nothing (Out.NamedObjectType catType) mempty
catResolver = ValueResolver catField $ pure Null
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
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
$ pure $ Boolean True
nameResolver :: Resolver IO
nameResolver = ValueResolver nameField $ pure "Name"
where
nameField = Field Nothing (Out.NonNullScalarType string) mempty
nicknameResolver :: Resolver IO
nicknameResolver = ValueResolver nicknameField $ pure "Nickname"
where
nicknameField = Field Nothing (Out.NamedScalarType string) mempty
dogCommandType :: EnumType
dogCommandType = EnumType "DogCommand" Nothing $ HashMap.fromList
@ -54,10 +88,6 @@ dogType = ObjectType "Dog" Nothing [petType] $ HashMap.fromList
, ("owner", ownerResolver)
]
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"
barkVolumeField = Field Nothing (Out.NamedScalarType int) mempty
barkVolumeResolver = ValueResolver barkVolumeField $ pure $ Int 3
doesKnowCommandField = Field Nothing (Out.NonNullScalarType boolean)
@ -116,8 +146,6 @@ humanType = ObjectType "Human" Nothing [sentientType] $ HashMap.fromList
, ("pets", petsResolver)
]
where
nameField = Field Nothing (Out.NonNullScalarType string) mempty
nameResolver = ValueResolver nameField $ pure "Name"
petsField =
Field Nothing (Out.ListType $ Out.NonNullInterfaceType petType) mempty
petsResolver = ValueResolver petsField $ pure $ List []
@ -128,7 +156,7 @@ catOrDogType = UnionType "CatOrDog" Nothing [catType, dogType]
validate :: Text -> [Error]
validate queryString =
case parse AST.document "" queryString of
Left _ -> []
Left parseErrors -> error $ errorBundlePretty parseErrors
Right ast -> toList $ document petSchema specifiedRules ast
spec :: Spec
@ -741,3 +769,42 @@ spec =
, locations = [AST.Location 5 19, AST.Location 9 19]
}
in validate queryString `shouldBe` [expected]
it "rejects object inline spreads outside object scope" $
let queryString = [r|
{
dog {
... on Cat {
meowVolume
}
}
}
|]
expected = Error
{ message =
"Fragment cannot be spread here as objects of type \
\\"Dog\" can never be of type \"Cat\"."
, locations = [AST.Location 4 19]
}
in validate queryString `shouldBe` [expected]
it "rejects object named spreads outside object scope" $
let queryString = [r|
{
dog {
... catInDogFragmentInvalid
}
}
fragment catInDogFragmentInvalid on Cat {
meowVolume
}
|]
expected = Error
{ message =
"Fragment \"catInDogFragmentInvalid\" cannot be spread \
\here as objects of type \"Dog\" can never be of type \
\\"Cat\"."
, locations = [AST.Location 4 19]
}
in validate queryString `shouldBe` [expected]