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 ## Added
- `Validate.Validation` contains data structures and functions used by the - `Validate.Validation` contains data structures and functions used by the
validator and concretet rules. validator and concretet rules.
- `Validate.Rules`: operation validation rules.
## [0.9.0.0] - 2020-07-24 ## [0.9.0.0] - 2020-07-24
## Fixed ## Fixed

View File

@ -66,11 +66,16 @@ executableDefinition (DefinitionFragment definition') =
operationDefinition :: forall m. OperationDefinition -> ValidateT m operationDefinition :: forall m. OperationDefinition -> ValidateT m
operationDefinition operation = operationDefinition operation =
asks rules >>= foldM (ruleFilter operation) Seq.empty asks rules >>= foldM ruleFilter Seq.empty
where where
ruleFilter definition' accumulator (OperationDefinitionRule rule) = ruleFilter accumulator (OperationDefinitionRule rule) =
mapReaderT (runRule accumulator) $ rule definition' mapReaderT (runRule accumulator) $ rule operation
ruleFilter _ accumulator _ = pure accumulator ruleFilter accumulator _ = pure accumulator
fragmentDefinition :: forall m. FragmentDefinition -> ValidateT m 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 , loneAnonymousOperationRule
, singleFieldSubscriptionsRule , singleFieldSubscriptionsRule
, specifiedRules , specifiedRules
, uniqueFragmentNamesRule
, uniqueOperationNamesRule , uniqueOperationNamesRule
) where ) where
@ -34,6 +35,7 @@ specifiedRules =
, singleFieldSubscriptionsRule , singleFieldSubscriptionsRule
, loneAnonymousOperationRule , loneAnonymousOperationRule
, uniqueOperationNamesRule , uniqueOperationNamesRule
, uniqueFragmentNamesRule
] ]
-- | Definition must be OperationDefinition or FragmentDefinition. -- | Definition must be OperationDefinition or FragmentDefinition.
@ -151,32 +153,63 @@ loneAnonymousOperationRule = OperationDefinitionRule $ \case
-- referred to by its name. -- referred to by its name.
uniqueOperationNamesRule :: forall m. Rule m uniqueOperationNamesRule :: forall m. Rule m
uniqueOperationNamesRule = OperationDefinitionRule $ \case uniqueOperationNamesRule = OperationDefinitionRule $ \case
OperationDefinition _ (Just thisName) _ _ _ thisLocation -> do OperationDefinition _ (Just thisName) _ _ _ thisLocation ->
ast' <- asks ast findDuplicates (filterByName thisName) thisLocation (error' thisName)
let locations' = foldr (filterByName thisName) [] ast'
if length locations' > 1 && head locations' == thisLocation
then pure $ error' thisName locations'
else lift Nothing
_ -> lift Nothing _ -> lift Nothing
where where
error' operationName locations' = Error error' operationName = concat
{ message = concat
[ "There can be only one operation named \"" [ "There can be only one operation named \""
, Text.unpack operationName , Text.unpack operationName
, "\"." , "\"."
] ]
, locations = locations'
, path = []
}
filterByName thisName definition' accumulator filterByName thisName definition' accumulator
| (viewOperation -> Just operationDefinition) <- definition' | (viewOperation -> Just operationDefinition) <- definition'
, OperationDefinition _ (Just thatName) _ _ _ thatLocation <- operationDefinition , OperationDefinition _ (Just thatName) _ _ _ thatLocation <- operationDefinition
, thisName == thatName = thatLocation : accumulator , thisName == thatName = thatLocation : accumulator
| otherwise = 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 -> Maybe OperationDefinition
viewOperation definition viewOperation definition
| ExecutableDefinition executableDefinition <- definition | ExecutableDefinition executableDefinition <- definition
, DefinitionOperation operationDefinition <- executableDefinition = , DefinitionOperation operationDefinition <- executableDefinition =
Just operationDefinition Just operationDefinition
viewOperation _ = Nothing 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 data Rule m
= DefinitionRule (Definition -> RuleT m) = DefinitionRule (Definition -> RuleT m)
| OperationDefinitionRule (OperationDefinition -> RuleT m) | OperationDefinitionRule (OperationDefinition -> RuleT m)
| FragmentDefinitionRule (FragmentDefinition -> 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

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