Validate fragment name uniqueness

This commit is contained in:
Eugen Wissner 2020-08-28 08:32:21 +02:00
parent eebad8a27f
commit 7e78f98f09
5 changed files with 86 additions and 20 deletions

View File

@ -17,6 +17,7 @@ and this project adheres to
## Added
- `Validate.Validation` contains data structures and functions used by the
validator and concretet rules.
- `Validate.Rules`: operation validation rules.
## [0.9.0.0] - 2020-07-24
## Fixed

View File

@ -66,11 +66,16 @@ executableDefinition (DefinitionFragment definition') =
operationDefinition :: forall m. OperationDefinition -> ValidateT m
operationDefinition operation =
asks rules >>= foldM (ruleFilter operation) Seq.empty
asks rules >>= foldM ruleFilter Seq.empty
where
ruleFilter definition' accumulator (OperationDefinitionRule rule) =
mapReaderT (runRule accumulator) $ rule definition'
ruleFilter _ accumulator _ = pure accumulator
ruleFilter accumulator (OperationDefinitionRule rule) =
mapReaderT (runRule accumulator) $ rule operation
ruleFilter accumulator _ = pure accumulator
fragmentDefinition :: forall m. FragmentDefinition -> ValidateT m
fragmentDefinition _fragment = pure Seq.empty
fragmentDefinition fragment =
asks rules >>= foldM ruleFilter Seq.empty
where
ruleFilter accumulator (FragmentDefinitionRule rule) =
mapReaderT (runRule accumulator) $ rule fragment
ruleFilter accumulator _ = pure accumulator

View File

@ -13,6 +13,7 @@ module Language.GraphQL.Validate.Rules
, loneAnonymousOperationRule
, singleFieldSubscriptionsRule
, specifiedRules
, uniqueFragmentNamesRule
, uniqueOperationNamesRule
) where
@ -34,6 +35,7 @@ specifiedRules =
, singleFieldSubscriptionsRule
, loneAnonymousOperationRule
, uniqueOperationNamesRule
, uniqueFragmentNamesRule
]
-- | Definition must be OperationDefinition or FragmentDefinition.
@ -151,32 +153,63 @@ loneAnonymousOperationRule = OperationDefinitionRule $ \case
-- referred to by its name.
uniqueOperationNamesRule :: forall m. Rule m
uniqueOperationNamesRule = OperationDefinitionRule $ \case
OperationDefinition _ (Just thisName) _ _ _ thisLocation -> do
ast' <- asks ast
let locations' = foldr (filterByName thisName) [] ast'
if length locations' > 1 && head locations' == thisLocation
then pure $ error' thisName locations'
else lift Nothing
OperationDefinition _ (Just thisName) _ _ _ thisLocation ->
findDuplicates (filterByName thisName) thisLocation (error' thisName)
_ -> lift Nothing
where
error' operationName locations' = Error
{ message = concat
error' operationName = concat
[ "There can be only one operation named \""
, Text.unpack operationName
, "\"."
]
, locations = locations'
, path = []
}
filterByName thisName definition' accumulator
| (viewOperation -> Just operationDefinition) <- definition'
, OperationDefinition _ (Just thatName) _ _ _ thatLocation <- operationDefinition
, thisName == thatName = thatLocation : accumulator
| otherwise = accumulator
findDuplicates :: (Definition -> [Location] -> [Location])
-> Location
-> String
-> RuleT m
findDuplicates filterByName thisLocation errorMessage = do
ast' <- asks ast
let locations' = foldr filterByName [] ast'
if length locations' > 1 && head locations' == thisLocation
then pure $ error' locations'
else lift Nothing
where
error' locations' = Error
{ message = errorMessage
, locations = locations'
, path = []
}
viewOperation :: Definition -> Maybe OperationDefinition
viewOperation definition
| ExecutableDefinition executableDefinition <- definition
, DefinitionOperation operationDefinition <- executableDefinition =
Just operationDefinition
viewOperation _ = Nothing
-- | Fragment definitions are referenced in fragment spreads by name. To avoid
-- ambiguity, each fragments name must be unique within a document.
--
-- Inline fragments are not considered fragment definitions, and are unaffected
-- by this validation rule.
uniqueFragmentNamesRule :: forall m. Rule m
uniqueFragmentNamesRule = FragmentDefinitionRule $ \case
FragmentDefinition thisName _ _ _ thisLocation ->
findDuplicates (filterByName thisName) thisLocation (error' thisName)
where
error' fragmentName = concat
[ "There can be only one fragment named \""
, Text.unpack fragmentName
, "\"."
]
filterByName thisName definition accumulator
| ExecutableDefinition executableDefinition <- definition
, DefinitionFragment fragmentDefinition <- executableDefinition
, FragmentDefinition thatName _ _ _ thatLocation <- fragmentDefinition
, thisName == thatName = thatLocation : accumulator
| otherwise = accumulator

View File

@ -48,6 +48,7 @@ data Validation m = Validation
data Rule m
= DefinitionRule (Definition -> RuleT m)
| OperationDefinitionRule (OperationDefinition -> RuleT m)
| FragmentDefinitionRule (FragmentDefinition -> RuleT m)
-- | Monad transformer used by the rules.
type RuleT m = ReaderT (Validation m) Maybe Error

View File

@ -255,3 +255,29 @@ spec =
, path = []
}
in validate queryString `shouldBe` Seq.singleton expected
it "rejects fragments with the same name" $
let queryString = [r|
{
dog {
...fragmentOne
}
}
fragment fragmentOne on Dog {
name
}
fragment fragmentOne on Dog {
owner {
name
}
}
|]
expected = Error
{ 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