OSS/graphql
1
1
Fork 1
Code Issues 5 Pull Requests Actions Releases 22 Wiki Activity

Validate fragment spread type existence

Browse Source
This commit is contained in:
Eugen Wissner 2020-09-05 10:00:58 +02:00
parent 14ed209828
commit d327d9d1ce
9 changed files with 66 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGELOG.md
View File

@ -8,7 +8,7 @@ and this project adheres to
## [Unreleased]
### Changed
- Added location information to `AST.Document.Selection.FragmentSpread`.
- Added location information to `AST.Document.Selection`.
### Added
- `Validate.Validation.Rule`: `SelectionRule` constructor.

4
src/Language/GraphQL/AST/Document.hs
View File

@ -162,9 +162,9 @@ type SelectionSetOpt = [Selection]
-- }
-- @
data Selection
= Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt
= Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt Location
| FragmentSpread Name [Directive] Location
| InlineFragment (Maybe TypeCondition) [Directive] SelectionSet
| InlineFragment (Maybe TypeCondition) [Directive] SelectionSet Location
deriving (Eq, Show)
-- ** Arguments

4
src/Language/GraphQL/AST/Encoder.hs
View File

@ -126,9 +126,9 @@ indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol
selection :: Formatter -> Selection -> Lazy.Text
selection formatter = Lazy.Text.append indent' . encodeSelection
where
encodeSelection (Field alias name args directives' selections) =
encodeSelection (Field alias name args directives' selections _) =
field incrementIndent alias name args directives' selections
encodeSelection (InlineFragment typeCondition directives' selections) =
encodeSelection (InlineFragment typeCondition directives' selections _) =
inlineFragment incrementIndent typeCondition directives' selections
encodeSelection (FragmentSpread name directives' _) =
fragmentSpread incrementIndent name directives'

28
src/Language/GraphQL/AST/Parser.hs
View File

@ -382,13 +382,14 @@ selection = field
<?> "Selection"
field :: Parser Selection
field = Field
<$> optional alias
<*> name
<*> arguments
<*> directives
<*> selectionSetOpt
<?> "Field"
field = label "Field" $ do
location <- getLocation
alias' <- optional alias
name' <- name
arguments' <- arguments
directives' <- directives
selectionSetOpt' <- selectionSetOpt
pure $ Field alias' name' arguments' directives' selectionSetOpt' location
alias :: Parser Alias
alias = try (name <* colon) <?> "Alias"
@ -408,12 +409,13 @@ fragmentSpread = label "FragmentSpread" $ do
pure $ FragmentSpread fragmentName' directives' location
inlineFragment :: Parser Selection
inlineFragment = InlineFragment
<$ spread
<*> optional typeCondition
<*> directives
<*> selectionSet
<?> "InlineFragment"
inlineFragment = label "InlineFragment" $ do
location <- getLocation
_ <- spread
typeCondition' <- optional typeCondition
directives' <- directives
selectionSet' <- selectionSet
pure $ InlineFragment typeCondition' directives' selectionSet' location
fragmentDefinition :: Parser FragmentDefinition
fragmentDefinition = label "FragmentDefinition" $ do

4
src/Language/GraphQL/Execute/Transform.hs
View File

@ -288,7 +288,7 @@ operation operationDefinition replacement
selection
:: Full.Selection
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
selection (Full.Field alias name arguments' directives' selections) =
selection (Full.Field alias name arguments' directives' selections _) =
maybe (Left mempty) (Right . SelectionField) <$> do
fieldArguments <- foldM go HashMap.empty arguments'
fieldSelections <- appendSelection selections
@ -314,7 +314,7 @@ selection (Full.FragmentSpread name directives' _) =
Just fragment -> lift $ pure $ fragment <$ spreadDirectives
_ -> lift $ pure Nothing
| otherwise -> lift $ pure Nothing
selection (Full.InlineFragment type' directives' selections) = do
selection (Full.InlineFragment type' directives' selections _) = do
fragmentDirectives <- Definition.selection <$> directives directives'
case fragmentDirectives of
Nothing -> pure $ Left mempty

11
src/Language/GraphQL/Validate.hs
View File

@ -76,14 +76,17 @@ operationDefinition operation =
getSelectionSet (OperationDefinition _ _ _ _ selectionSet _) = selectionSet
selection :: forall m. Selection -> ValidateT m
selection selection'@FragmentSpread{} =
asks rules >>= foldM ruleFilter Seq.empty
selection selection'
| FragmentSpread{} <- selection' =
asks rules >>= foldM ruleFilter Seq.empty
| Field _ _ _ _ selectionSet _ <- selection' =
visitChildSelections ruleFilter selectionSet
| InlineFragment _ _ selectionSet _ <- selection' =
visitChildSelections ruleFilter selectionSet
where
ruleFilter accumulator (SelectionRule rule) =
mapReaderT (runRule accumulator) $ rule selection'
ruleFilter accumulator _ = pure accumulator
selection (Field _ _ _ _ selectionSet) = traverseSelectionSet selectionSet
selection (InlineFragment _ _ selectionSet) = traverseSelectionSet selectionSet
traverseSelectionSet :: Traversable t => forall m. t Selection -> ValidateT m
traverseSelectionSet = fmap fold . traverse selection

22
src/Language/GraphQL/Validate/Rules.hs
View File

@ -89,7 +89,7 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
errorMessage =
"Anonymous Subscription must select only one top level field."
collectFields selectionSet = foldM forEach HashSet.empty selectionSet
forEach accumulator (Field alias name _ directives _)
forEach accumulator (Field alias name _ directives _ _)
| any skip directives = pure accumulator
| Just aliasedName <- alias = pure
$ HashSet.insert aliasedName accumulator
@ -101,7 +101,7 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
if inVisitetFragments
then pure accumulator
else collectFromSpread fragmentName accumulator
forEach accumulator (InlineFragment typeCondition' directives selectionSet)
forEach accumulator (InlineFragment typeCondition' directives selectionSet _)
| any skip directives = pure accumulator
| Just typeCondition <- typeCondition' =
collectFromFragment typeCondition selectionSet accumulator
@ -269,7 +269,16 @@ fragmentSpreadTypeExistenceRule = SelectionRule $ \case
types' <- asks types
case HashMap.lookup typeCondition types' of
Nothing -> pure $ Error
{ message = error' fragmentName typeCondition
{ message = spreadError fragmentName typeCondition
, locations = [location]
, path = []
}
Just _ -> lift Nothing
InlineFragment (Just typeCondition) _ _ location -> do
types' <- asks types
case HashMap.lookup typeCondition types' of
Nothing -> pure $ Error
{ message = inlineError typeCondition
, locations = [location]
, path = []
}
@ -280,10 +289,15 @@ fragmentSpreadTypeExistenceRule = SelectionRule $ \case
let FragmentDefinition _ typeCondition _ _ _ = fragmentDefinition
in pure typeCondition
extractTypeCondition _ = lift Nothing
error' fragmentName typeCondition = concat
spreadError fragmentName typeCondition = concat
[ "Fragment \""
, Text.unpack fragmentName
, "\" is specified on type \""
, Text.unpack typeCondition
, "\" which doesn't exist in the schema."
]
inlineError typeCondition = concat
[ "Inline fragment is specified on type \""
, Text.unpack typeCondition
, "\" which doesn't exist in the schema."
]

2
tests/Language/GraphQL/AST/EncoderSpec.hs
View File

@ -122,7 +122,7 @@ spec = do
describe "definition" $
it "indents block strings in arguments" $
let arguments = [Argument "message" (String "line1\nline2")]
field = Field Nothing "field" arguments [] []
field = Field Nothing "field" arguments [] [] $ Location 0 0
operation = DefinitionOperation
$ SelectionSet (pure field)
$ Location 0 0

19
tests/Language/GraphQL/ValidateSpec.hs
View File

@ -300,7 +300,7 @@ spec =
}
in validate queryString `shouldBe` Seq.singleton expected
it "rejects the fragment spread without a target" $
it "rejects fragment spreads without an unknown target type" $
let queryString = [r|
{
dog {
@ -319,3 +319,20 @@ spec =
, path = []
}
in validate queryString `shouldBe` Seq.singleton 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]
, path = []
}
in validate queryString `shouldBe` Seq.singleton expected