From 21a7d9cce421352e837945a2334e7ccf10160d8c Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sat, 19 Sep 2020 18:18:26 +0200 Subject: [PATCH] Validate variable names are unique --- CHANGELOG.md | 12 ++++++++++-- src/Language/GraphQL/AST/Document.hs | 3 ++- src/Language/GraphQL/AST/Encoder.hs | 2 +- src/Language/GraphQL/AST/Parser.hs | 13 +++++++------ src/Language/GraphQL/Execute/Transform.hs | 2 +- src/Language/GraphQL/Validate.hs | 15 +++++++++------ src/Language/GraphQL/Validate/Rules.hs | 13 +++++++++++++ src/Language/GraphQL/Validate/Validation.hs | 1 + tests/Language/GraphQL/ValidateSpec.hs | 15 +++++++++++++++ 9 files changed, 59 insertions(+), 17 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f7b2e94..fb41f88 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -24,8 +24,15 @@ and this project adheres to - `Validate.Validation.Path` was moved to `Error`. ### Added -- `Validate.Validation.Rule`: `SelectionRule`, `FieldRule`, `FragmentRule`, - `FragmentSpreadRule`, `ArgumentsRule`, `DirectivesRule` constructors. +- `Validate.Validation.Rule` constructors: + - `SelectionRule` + - `FieldRule` + - `FragmentRule` + - `FragmentSpreadRule` + - `ArgumentsRule` + - `DirectivesRule` + - `VariablesRule` + - `Validate.Rules`: - `fragmentsOnCompositeTypesRule` - `fragmentSpreadTargetDefinedRule` @@ -34,6 +41,7 @@ and this project adheres to - `noFragmentCyclesRule` - `uniqueArgumentNamesRule` - `uniqueDirectiveNamesRule` + - `uniqueVariableNamesRule` - `AST.Document.Field`. - `AST.Document.FragmentSpread`. - `AST.Document.InlineFragment`. diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index 5d21ca0..b03b905 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -253,7 +253,8 @@ data ObjectField a = ObjectField Name a -- -- Variables are usually passed along with the query, but not in the query -- itself. They make queries reusable. -data VariableDefinition = VariableDefinition Name Type (Maybe ConstValue) +data VariableDefinition = + VariableDefinition Name Type (Maybe ConstValue) Location deriving (Eq, Show) -- ** Type References diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs index fcd415e..e88dcd9 100644 --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -95,7 +95,7 @@ variableDefinitions formatter = parensCommas formatter $ variableDefinition formatter variableDefinition :: Formatter -> VariableDefinition -> Lazy.Text -variableDefinition formatter (VariableDefinition var ty defaultValue') +variableDefinition formatter (VariableDefinition var ty defaultValue' _) = variable var <> eitherFormat formatter ": " ":" <> type' ty diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs index 62a247d..18ffd2a 100644 --- a/src/Language/GraphQL/AST/Parser.hs +++ b/src/Language/GraphQL/AST/Parser.hs @@ -492,12 +492,13 @@ variableDefinitions = listOptIn parens variableDefinition "VariableDefinitions" variableDefinition :: Parser VariableDefinition -variableDefinition = VariableDefinition - <$> variable - <* colon - <*> type' - <*> defaultValue - "VariableDefinition" +variableDefinition = label "VariableDefinition" $ do + location <- getLocation + variableName <- variable + colon + variableType <- type' + variableValue <- defaultValue + pure $ VariableDefinition variableName variableType variableValue location variable :: Parser Name variable = dollar *> name "Variable" diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs index d150446..6f123e6 100644 --- a/src/Language/GraphQL/Execute/Transform.hs +++ b/src/Language/GraphQL/Execute/Transform.hs @@ -180,7 +180,7 @@ coerceVariableValues types operationDefinition variableValues = $ foldr forEach (Just HashMap.empty) variableDefinitions where forEach variableDefinition coercedValues = do - let Full.VariableDefinition variableName variableTypeName defaultValue = + let Full.VariableDefinition variableName variableTypeName defaultValue _ = variableDefinition let defaultValue' = constValue <$> defaultValue variableType <- lookupInputType variableTypeName types diff --git a/src/Language/GraphQL/Validate.hs b/src/Language/GraphQL/Validate.hs index ff2734d..702935b 100644 --- a/src/Language/GraphQL/Validate.hs +++ b/src/Language/GraphQL/Validate.hs @@ -125,12 +125,15 @@ inputValueDefinition rule (InputValueDefinition _ _ _ _ directives') = directives rule directives' operationDefinition :: Rule m -> OperationDefinition -> Seq (RuleT m) -operationDefinition (OperationDefinitionRule rule) operationDefinition' = - pure $ rule operationDefinition' -operationDefinition rule (SelectionSet selections _) = - selectionSet rule selections -operationDefinition rule (OperationDefinition _ _ _ directives' selections _) = - selectionSet rule selections >< directives rule directives' +operationDefinition rule operation + | OperationDefinitionRule operationRule <- rule = + pure $ operationRule operation + | VariablesRule variablesRule <- rule + , OperationDefinition _ _ variables _ _ _ <- operation = + pure $ variablesRule variables + | SelectionSet selections _ <- operation = selectionSet rule selections + | OperationDefinition _ _ _ directives' selections _ <- operation = + selectionSet rule selections >< directives rule directives' fragmentDefinition :: Rule m -> FragmentDefinition -> Seq (RuleT m) fragmentDefinition (FragmentDefinitionRule rule) fragmentDefinition' = diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs index f9498b9..3af6145 100644 --- a/src/Language/GraphQL/Validate/Rules.hs +++ b/src/Language/GraphQL/Validate/Rules.hs @@ -22,6 +22,7 @@ module Language.GraphQL.Validate.Rules , uniqueDirectiveNamesRule , uniqueFragmentNamesRule , uniqueOperationNamesRule + , uniqueVariableNamesRule ) where import Control.Monad (foldM) @@ -64,6 +65,8 @@ specifiedRules = , noFragmentCyclesRule -- Directives. , uniqueDirectiveNamesRule + -- Variables. + , uniqueVariableNamesRule ] -- | Definition must be OperationDefinition or FragmentDefinition. @@ -492,3 +495,13 @@ filterDuplicates extract nodeType = lift , Text.unpack $ fst $ extract directive , "\"." ] + +-- | If any operation defines more than one variable with the same name, it is +-- ambiguous and invalid. It is invalid even if the type of the duplicate +-- variable is the same. +uniqueVariableNamesRule :: forall m. Rule m +uniqueVariableNamesRule = VariablesRule + $ filterDuplicates extract "variable" + where + extract (VariableDefinition variableName _ _ location) = + (variableName, location) diff --git a/src/Language/GraphQL/Validate/Validation.hs b/src/Language/GraphQL/Validate/Validation.hs index f2bccd3..385c4ae 100644 --- a/src/Language/GraphQL/Validate/Validation.hs +++ b/src/Language/GraphQL/Validate/Validation.hs @@ -43,6 +43,7 @@ data Rule m | FieldRule (Field -> RuleT m) | ArgumentsRule (Field -> RuleT m) (Directive -> RuleT m) | DirectivesRule ([Directive] -> RuleT m) + | VariablesRule ([VariableDefinition] -> RuleT m) -- | Monad transformer used by the rules. type RuleT m = ReaderT (Validation m) Seq Error diff --git a/tests/Language/GraphQL/ValidateSpec.hs b/tests/Language/GraphQL/ValidateSpec.hs index 507ca7b..1822f57 100644 --- a/tests/Language/GraphQL/ValidateSpec.hs +++ b/tests/Language/GraphQL/ValidateSpec.hs @@ -441,3 +441,18 @@ spec = , locations = [AST.Location 3 23, AST.Location 3 39] } in validate queryString `shouldBe` Seq.singleton expected + + it "rejects duplicate variables" $ + let queryString = [r| + query houseTrainedQuery($atOtherHomes: Boolean, $atOtherHomes: Boolean) { + dog { + isHousetrained(atOtherHomes: $atOtherHomes) + } + } + |] + expected = Error + { message = + "There can be only one variable named \"atOtherHomes\"." + , locations = [AST.Location 2 39, AST.Location 2 63] + } + in validate queryString `shouldBe` Seq.singleton expected