Validate variable names are unique

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`.

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

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

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"

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

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' =

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)

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

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