Validate all fragments are used

This commit is contained in:
Eugen Wissner 2020-09-09 17:04:31 +02:00
parent f6ff0ab9c7
commit c2c57b6363
10 changed files with 141 additions and 79 deletions

View File

@ -8,22 +8,27 @@ and this project adheres to
## [Unreleased]
### Changed
- `AST.Document.Selection` wraps additional new types: `FragmentSpread`
and `InlineFragment`. Thus validation rules can be more concise.
- `AST.Document.Selection` wraps additional new types: `Field`, `FragmentSpread`
and `InlineFragment`. Thus validation rules can be defined more concise.
### Added
- `Validate.Validation.Rule`: `SelectionRule`, `FragmentRule` and
- `Validate.Validation.Rule`: `SelectionRule`, `FieldRule`, `FragmentRule` and
`FragmentSpreadRule` constructors.
- `Validate.Rules`:
- `fragmentsOnCompositeTypesRule`
- `fragmentSpreadTargetDefinedRule`
- `fragmentSpreadTypeExistenceRule`
- `noUnusedFragmentsRule`
- `AST.Document.Field`.
- `AST.Document.FragmentSpread`.
- `AST.Document.InlineFragment`.
### Fixed
- Collecting existing types from the schema considers subscriptions.
### Removed
- `AST.Document.Alias`. Use `AST.Document.Name` instead.
## [0.10.0.0] - 2020-08-29
### Changed
- `Test.Hspec.GraphQL.*`: replace `IO` in the resolver with any `MonadCatch`.

View File

@ -5,8 +5,7 @@
-- <https://facebook.github.io/graphql/ Facebook's GraphQL Specification>.
-- for more information.
module Language.GraphQL.AST.Document
( Alias
, Argument(..)
( Argument(..)
, ArgumentsDefinition(..)
, ConstValue(..)
, Definition(..)
@ -15,6 +14,7 @@ module Language.GraphQL.AST.Document
, Document
, EnumValueDefinition(..)
, ExecutableDefinition(..)
, Field(..)
, FieldDefinition(..)
, FragmentDefinition(..)
, FragmentSpread(..)
@ -118,9 +118,14 @@ type SelectionSet = NonEmpty Selection
-- | Field selection.
type SelectionSetOpt = [Selection]
-- | Selection is a single entry in a selection set. It can be a single field,
-- fragment spread or inline fragment.
--
-- | Selection is a single entry in a selection set. It can be a single 'Field',
-- 'FragmentSpread' or an 'InlineFragment'.
data Selection
= FieldSelection Field
| FragmentSpreadSelection FragmentSpread
| InlineFragmentSelection InlineFragment
deriving (Eq, Show)
-- The only required property of a field is its name. Optionally it can also
-- have an alias, arguments, directives and a list of subfields.
--
@ -134,10 +139,8 @@ type SelectionSetOpt = [Selection]
-- }
-- }
-- @
data Selection
= Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt Location
| FragmentSpreadSelection FragmentSpread
| InlineFragmentSelection InlineFragment
data Field =
Field (Maybe Name) Name [Argument] [Directive] SelectionSetOpt Location
deriving (Eq, Show)
-- Inline fragments don't have any name and the type condition ("on UserType")
@ -189,22 +192,6 @@ data FragmentSpread = FragmentSpread Name [Directive] Location
-- Here "id" is an argument for the field "user" and its value is 4.
data Argument = Argument Name Value deriving (Eq,Show)
-- ** Field Alias
-- | Alternative field name.
--
-- @
-- {
-- smallPic: profilePic(size: 64)
-- bigPic: profilePic(size: 1024)
-- }
-- @
--
-- Here "smallPic" and "bigPic" are aliases for the same field, "profilePic",
-- used to distinquish between profile pictures with different arguments
-- (sizes).
type Alias = Name
-- ** Fragments
-- | Fragment definition.

View File

@ -126,8 +126,8 @@ 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 _) =
field incrementIndent alias name args directives' selections
encodeSelection (FieldSelection fieldSelection) =
field incrementIndent fieldSelection
encodeSelection (InlineFragmentSelection fragmentSelection) =
inlineFragment incrementIndent fragmentSelection
encodeSelection (FragmentSpreadSelection fragmentSelection) =
@ -142,15 +142,9 @@ selection formatter = Lazy.Text.append indent' . encodeSelection
colon :: Formatter -> Lazy.Text
colon formatter = eitherFormat formatter ": " ":"
-- | Converts Field into a string
field :: Formatter ->
Maybe Name ->
Name ->
[Argument] ->
[Directive] ->
[Selection] ->
Lazy.Text
field formatter alias name args dirs set
-- | Converts Field into a string.
field :: Formatter -> Field -> Lazy.Text
field formatter (Field alias name args dirs set _)
= optempty prependAlias (fold alias)
<> Lazy.Text.fromStrict name
<> optempty (arguments formatter) args

View File

@ -376,12 +376,12 @@ selectionSetOpt :: Parser SelectionSetOpt
selectionSetOpt = listOptIn braces selection <?> "SelectionSet"
selection :: Parser Selection
selection = field
selection = FieldSelection <$> field
<|> FragmentSpreadSelection <$> try fragmentSpread
<|> InlineFragmentSelection <$> inlineFragment
<?> "Selection"
field :: Parser Selection
field :: Parser Field
field = label "Field" $ do
location <- getLocation
alias' <- optional alias
@ -391,7 +391,7 @@ field = label "Field" $ do
selectionSetOpt' <- selectionSetOpt
pure $ Field alias' name' arguments' directives' selectionSetOpt' location
alias :: Parser Alias
alias :: Parser Name
alias = try (name <* colon) <?> "Alias"
arguments :: Parser [Argument]

View File

@ -288,8 +288,16 @@ operation operationDefinition replacement
selection
:: Full.Selection
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
selection (Full.Field alias name arguments' directives' selections _) =
maybe (Left mempty) (Right . SelectionField) <$> do
selection (Full.FieldSelection fieldSelection) =
maybe (Left mempty) (Right . SelectionField) <$> field fieldSelection
selection (Full.FragmentSpreadSelection fragmentSelection)
= maybe (Left mempty) (Right . SelectionFragment)
<$> fragmentSpread fragmentSelection
selection (Full.InlineFragmentSelection fragmentSelection) =
inlineFragment fragmentSelection
field :: Full.Field -> State (Replacement m) (Maybe (Field m))
field (Full.Field alias name arguments' directives' selections _) = do
fieldArguments <- foldM go HashMap.empty arguments'
fieldSelections <- appendSelection selections
fieldDirectives <- Definition.selection <$> directives directives'
@ -298,16 +306,11 @@ selection (Full.Field alias name arguments' directives' selections _) =
where
go arguments (Full.Argument name' value') =
inputField arguments name' value'
selection (Full.FragmentSpreadSelection fragmentSelection) =
fragmentSpread fragmentSelection
selection (Full.InlineFragmentSelection fragmentSelection) =
inlineFragment fragmentSelection
fragmentSpread
:: Full.FragmentSpread
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
fragmentSpread (Full.FragmentSpread name directives' _) =
maybe (Left mempty) (Right . SelectionFragment) <$> do
-> State (Replacement m) (Maybe (Fragment m))
fragmentSpread (Full.FragmentSpread name directives' _) = do
spreadDirectives <- Definition.selection <$> directives directives'
fragments' <- gets fragments

View File

@ -85,8 +85,8 @@ selection :: forall m. Selection -> ValidateT m
selection selection'
| FragmentSpreadSelection fragmentSelection <- selection' =
visitChildSelections ruleFilter $ fragmentSpread fragmentSelection
| Field _ _ _ _ selectionSet _ <- selection' =
visitChildSelections ruleFilter $ traverseSelectionSet selectionSet
| FieldSelection fieldSelection <- selection' =
visitChildSelections ruleFilter $ field fieldSelection
| InlineFragmentSelection fragmentSelection <- selection' =
visitChildSelections ruleFilter $ inlineFragment fragmentSelection
where
@ -94,6 +94,14 @@ selection selection'
mapReaderT (runRule accumulator) $ rule selection'
ruleFilter accumulator _ = pure accumulator
field :: forall m. Field -> ValidateT m
field field'@(Field _ _ _ _ selections _) =
visitChildSelections ruleFilter $ traverseSelectionSet selections
where
ruleFilter accumulator (FieldRule rule) =
mapReaderT (runRule accumulator) $ rule field'
ruleFilter accumulator _ = pure accumulator
inlineFragment :: forall m. InlineFragment -> ValidateT m
inlineFragment fragment@(InlineFragment _ _ selections _) =
visitChildSelections ruleFilter $ traverseSelectionSet selections

View File

@ -14,6 +14,7 @@ module Language.GraphQL.Validate.Rules
, fragmentSpreadTargetDefinedRule
, fragmentSpreadTypeExistenceRule
, loneAnonymousOperationRule
, noUnusedFragmentsRule
, singleFieldSubscriptionsRule
, specifiedRules
, uniqueFragmentNamesRule
@ -45,9 +46,10 @@ specifiedRules =
, uniqueOperationNamesRule
-- Fragments.
, uniqueFragmentNamesRule
, fragmentSpreadTargetDefinedRule
, fragmentSpreadTypeExistenceRule
, fragmentsOnCompositeTypesRule
, noUnusedFragmentsRule
, fragmentSpreadTargetDefinedRule
]
-- | Definition must be OperationDefinition or FragmentDefinition.
@ -92,15 +94,16 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
"Anonymous Subscription must select only one top level field."
collectFields selectionSet = foldM forEach HashSet.empty selectionSet
forEach accumulator = \case
Field alias name _ directives _ _
| any skip directives -> pure accumulator
| Just aliasedName <- alias -> pure
$ HashSet.insert aliasedName accumulator
| otherwise -> pure $ HashSet.insert name accumulator
FieldSelection fieldSelection -> forField accumulator fieldSelection
FragmentSpreadSelection fragmentSelection ->
forSpread accumulator fragmentSelection
InlineFragmentSelection fragmentSelection ->
forInline accumulator fragmentSelection
forField accumulator (Field alias name _ directives _ _)
| any skip directives = pure accumulator
| Just aliasedName <- alias = pure
$ HashSet.insert aliasedName accumulator
| otherwise = pure $ HashSet.insert name accumulator
forSpread accumulator (FragmentSpread fragmentName directives _)
| any skip directives = pure accumulator
| otherwise = do
@ -338,3 +341,44 @@ fragmentsOnCompositeTypesRule = FragmentRule definitionRule inlineRule
, Text.unpack typeCondition,
"\"."
]
-- | Defined fragments must be used within a document.
noUnusedFragmentsRule :: forall m. Rule m
noUnusedFragmentsRule = FragmentDefinitionRule $ \fragment ->
asks ast >>= findSpreadByName fragment
where
findSpreadByName (FragmentDefinition fragName _ _ _ location) definitions
| foldr (go fragName) False definitions = lift Nothing
| otherwise = pure $ Error
{ message = errorMessage fragName
, locations = [location]
, path = []
}
errorMessage fragName = concat
[ "Fragment \""
, Text.unpack fragName
, "\" is never used."
]
go fragName (viewOperation -> Just operation) accumulator
| SelectionSet selections _ <- operation =
evaluateSelections fragName accumulator selections
| OperationDefinition _ _ _ _ selections _ <- operation =
evaluateSelections fragName accumulator selections
go fragName (viewFragment -> Just fragment) accumulator
| FragmentDefinition _ _ _ selections _ <- fragment =
evaluateSelections fragName accumulator selections
go _ _ _ = False
evaluateSelection fragName selection accumulator
| FragmentSpreadSelection spreadSelection <- selection
, FragmentSpread spreadName _ _ <- spreadSelection
, spreadName == fragName = True
| FieldSelection fieldSelection <- selection
, Field _ _ _ _ selections _ <- fieldSelection =
evaluateSelections fragName accumulator selections
| InlineFragmentSelection inlineSelection <- selection
, InlineFragment _ _ selections _ <- inlineSelection =
evaluateSelections fragName accumulator selections
| otherwise = accumulator || False
evaluateSelections :: Foldable t => Name -> Bool -> t Selection -> Bool
evaluateSelections fragName accumulator selections =
foldr (evaluateSelection fragName) accumulator selections

View File

@ -52,6 +52,7 @@ data Rule m
| SelectionRule (Selection -> RuleT m)
| FragmentRule (FragmentDefinition -> RuleT m) (InlineFragment -> RuleT m)
| FragmentSpreadRule (FragmentSpread -> RuleT m)
| FieldRule (Field -> RuleT m)
-- | Monad transformer used by the rules.
type RuleT m = ReaderT (Validation m) Maybe Error

View File

@ -124,7 +124,7 @@ spec = do
let arguments = [Argument "message" (String "line1\nline2")]
field = Field Nothing "field" arguments [] [] $ Location 0 0
operation = DefinitionOperation
$ SelectionSet (pure field)
$ SelectionSet (pure $ FieldSelection field)
$ Location 0 0
in definition pretty operation `shouldBe` [r|{
field(message: """

View File

@ -373,3 +373,23 @@ spec =
, path = []
}
in validate queryString `shouldBe` Seq.singleton 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]
, path = []
}
in validate queryString `shouldBe` Seq.singleton expected