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] ## [Unreleased]
### Changed ### Changed
- `AST.Document.Selection` wraps additional new types: `FragmentSpread` - `AST.Document.Selection` wraps additional new types: `Field`, `FragmentSpread`
and `InlineFragment`. Thus validation rules can be more concise. and `InlineFragment`. Thus validation rules can be defined more concise.
### Added ### Added
- `Validate.Validation.Rule`: `SelectionRule`, `FragmentRule` and - `Validate.Validation.Rule`: `SelectionRule`, `FieldRule`, `FragmentRule` and
`FragmentSpreadRule` constructors. `FragmentSpreadRule` constructors.
- `Validate.Rules`: - `Validate.Rules`:
- `fragmentsOnCompositeTypesRule` - `fragmentsOnCompositeTypesRule`
- `fragmentSpreadTargetDefinedRule` - `fragmentSpreadTargetDefinedRule`
- `fragmentSpreadTypeExistenceRule` - `fragmentSpreadTypeExistenceRule`
- `noUnusedFragmentsRule`
- `AST.Document.Field`.
- `AST.Document.FragmentSpread`. - `AST.Document.FragmentSpread`.
- `AST.Document.InlineFragment`. - `AST.Document.InlineFragment`.
### Fixed ### Fixed
- Collecting existing types from the schema considers subscriptions. - Collecting existing types from the schema considers subscriptions.
### Removed
- `AST.Document.Alias`. Use `AST.Document.Name` instead.
## [0.10.0.0] - 2020-08-29 ## [0.10.0.0] - 2020-08-29
### Changed ### Changed
- `Test.Hspec.GraphQL.*`: replace `IO` in the resolver with any `MonadCatch`. - `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>. -- <https://facebook.github.io/graphql/ Facebook's GraphQL Specification>.
-- for more information. -- for more information.
module Language.GraphQL.AST.Document module Language.GraphQL.AST.Document
( Alias ( Argument(..)
, Argument(..)
, ArgumentsDefinition(..) , ArgumentsDefinition(..)
, ConstValue(..) , ConstValue(..)
, Definition(..) , Definition(..)
@ -15,6 +14,7 @@ module Language.GraphQL.AST.Document
, Document , Document
, EnumValueDefinition(..) , EnumValueDefinition(..)
, ExecutableDefinition(..) , ExecutableDefinition(..)
, Field(..)
, FieldDefinition(..) , FieldDefinition(..)
, FragmentDefinition(..) , FragmentDefinition(..)
, FragmentSpread(..) , FragmentSpread(..)
@ -118,9 +118,14 @@ type SelectionSet = NonEmpty Selection
-- | Field selection. -- | Field selection.
type SelectionSetOpt = [Selection] type SelectionSetOpt = [Selection]
-- | Selection is a single entry in a selection set. It can be a single field, -- | Selection is a single entry in a selection set. It can be a single 'Field',
-- fragment spread or inline fragment. -- '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 -- The only required property of a field is its name. Optionally it can also
-- have an alias, arguments, directives and a list of subfields. -- have an alias, arguments, directives and a list of subfields.
-- --
@ -134,10 +139,8 @@ type SelectionSetOpt = [Selection]
-- } -- }
-- } -- }
-- @ -- @
data Selection data Field =
= Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt Location Field (Maybe Name) Name [Argument] [Directive] SelectionSetOpt Location
| FragmentSpreadSelection FragmentSpread
| InlineFragmentSelection InlineFragment
deriving (Eq, Show) deriving (Eq, Show)
-- Inline fragments don't have any name and the type condition ("on UserType") -- 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. -- Here "id" is an argument for the field "user" and its value is 4.
data Argument = Argument Name Value deriving (Eq,Show) 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 -- ** Fragments
-- | Fragment definition. -- | Fragment definition.

View File

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

View File

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

View File

@ -288,39 +288,42 @@ operation operationDefinition replacement
selection selection
:: Full.Selection :: Full.Selection
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m)) -> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
selection (Full.Field alias name arguments' directives' selections _) = selection (Full.FieldSelection fieldSelection) =
maybe (Left mempty) (Right . SelectionField) <$> do maybe (Left mempty) (Right . SelectionField) <$> field fieldSelection
fieldArguments <- foldM go HashMap.empty arguments' selection (Full.FragmentSpreadSelection fragmentSelection)
fieldSelections <- appendSelection selections = maybe (Left mempty) (Right . SelectionFragment)
fieldDirectives <- Definition.selection <$> directives directives' <$> fragmentSpread fragmentSelection
let field' = Field alias name fieldArguments fieldSelections
pure $ field' <$ fieldDirectives
where
go arguments (Full.Argument name' value') =
inputField arguments name' value'
selection (Full.FragmentSpreadSelection fragmentSelection) =
fragmentSpread fragmentSelection
selection (Full.InlineFragmentSelection fragmentSelection) = selection (Full.InlineFragmentSelection fragmentSelection) =
inlineFragment 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'
let field' = Field alias name fieldArguments fieldSelections
pure $ field' <$ fieldDirectives
where
go arguments (Full.Argument name' value') =
inputField arguments name' value'
fragmentSpread fragmentSpread
:: Full.FragmentSpread :: Full.FragmentSpread
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m)) -> State (Replacement m) (Maybe (Fragment m))
fragmentSpread (Full.FragmentSpread name directives' _) = fragmentSpread (Full.FragmentSpread name directives' _) = do
maybe (Left mempty) (Right . SelectionFragment) <$> do spreadDirectives <- Definition.selection <$> directives directives'
spreadDirectives <- Definition.selection <$> directives directives' fragments' <- gets fragments
fragments' <- gets fragments
fragmentDefinitions' <- gets fragmentDefinitions fragmentDefinitions' <- gets fragmentDefinitions
case HashMap.lookup name fragments' of case HashMap.lookup name fragments' of
Just definition -> lift $ pure $ definition <$ spreadDirectives Just definition -> lift $ pure $ definition <$ spreadDirectives
Nothing Nothing
| Just definition <- HashMap.lookup name fragmentDefinitions' -> do | Just definition <- HashMap.lookup name fragmentDefinitions' -> do
fragDef <- fragmentDefinition definition fragDef <- fragmentDefinition definition
case fragDef of case fragDef of
Just fragment -> lift $ pure $ fragment <$ spreadDirectives Just fragment -> lift $ pure $ fragment <$ spreadDirectives
_ -> lift $ pure Nothing _ -> lift $ pure Nothing
| otherwise -> lift $ pure Nothing | otherwise -> lift $ pure Nothing
inlineFragment inlineFragment
:: Full.InlineFragment :: Full.InlineFragment

View File

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

View File

@ -14,6 +14,7 @@ module Language.GraphQL.Validate.Rules
, fragmentSpreadTargetDefinedRule , fragmentSpreadTargetDefinedRule
, fragmentSpreadTypeExistenceRule , fragmentSpreadTypeExistenceRule
, loneAnonymousOperationRule , loneAnonymousOperationRule
, noUnusedFragmentsRule
, singleFieldSubscriptionsRule , singleFieldSubscriptionsRule
, specifiedRules , specifiedRules
, uniqueFragmentNamesRule , uniqueFragmentNamesRule
@ -45,9 +46,10 @@ specifiedRules =
, uniqueOperationNamesRule , uniqueOperationNamesRule
-- Fragments. -- Fragments.
, uniqueFragmentNamesRule , uniqueFragmentNamesRule
, fragmentSpreadTargetDefinedRule
, fragmentSpreadTypeExistenceRule , fragmentSpreadTypeExistenceRule
, fragmentsOnCompositeTypesRule , fragmentsOnCompositeTypesRule
, noUnusedFragmentsRule
, fragmentSpreadTargetDefinedRule
] ]
-- | Definition must be OperationDefinition or FragmentDefinition. -- | Definition must be OperationDefinition or FragmentDefinition.
@ -92,15 +94,16 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
"Anonymous Subscription must select only one top level field." "Anonymous Subscription must select only one top level field."
collectFields selectionSet = foldM forEach HashSet.empty selectionSet collectFields selectionSet = foldM forEach HashSet.empty selectionSet
forEach accumulator = \case forEach accumulator = \case
Field alias name _ directives _ _ FieldSelection fieldSelection -> forField accumulator fieldSelection
| any skip directives -> pure accumulator
| Just aliasedName <- alias -> pure
$ HashSet.insert aliasedName accumulator
| otherwise -> pure $ HashSet.insert name accumulator
FragmentSpreadSelection fragmentSelection -> FragmentSpreadSelection fragmentSelection ->
forSpread accumulator fragmentSelection forSpread accumulator fragmentSelection
InlineFragmentSelection fragmentSelection -> InlineFragmentSelection fragmentSelection ->
forInline accumulator 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 _) forSpread accumulator (FragmentSpread fragmentName directives _)
| any skip directives = pure accumulator | any skip directives = pure accumulator
| otherwise = do | otherwise = do
@ -129,7 +132,7 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
Just compositeType Just compositeType
| Just objectType <- Schema.subscription schema' | Just objectType <- Schema.subscription schema'
, True <- doesFragmentTypeApply compositeType objectType -> , True <- doesFragmentTypeApply compositeType objectType ->
HashSet.union accumulator<$> collectFields selectionSet HashSet.union accumulator <$> collectFields selectionSet
| otherwise -> pure accumulator | otherwise -> pure accumulator
collectFromSpread fragmentName accumulator = do collectFromSpread fragmentName accumulator = do
modify $ HashSet.insert fragmentName modify $ HashSet.insert fragmentName
@ -338,3 +341,44 @@ fragmentsOnCompositeTypesRule = FragmentRule definitionRule inlineRule
, Text.unpack typeCondition, , 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) | SelectionRule (Selection -> RuleT m)
| FragmentRule (FragmentDefinition -> RuleT m) (InlineFragment -> RuleT m) | FragmentRule (FragmentDefinition -> RuleT m) (InlineFragment -> RuleT m)
| FragmentSpreadRule (FragmentSpread -> RuleT m) | FragmentSpreadRule (FragmentSpread -> RuleT m)
| FieldRule (Field -> RuleT m)
-- | Monad transformer used by the rules. -- | Monad transformer used by the rules.
type RuleT m = ReaderT (Validation m) Maybe Error type RuleT m = ReaderT (Validation m) Maybe Error

View File

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

View File

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