Validate variable names are unique

7 files changed, 34 insertions, 15 deletions

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