Fix variable location in objects and lists

This commit is contained in:
Eugen Wissner 2024-01-05 20:46:02 +01:00
parent b1b6bfcdb9
commit 809f446ff1
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
2 changed files with 30 additions and 16 deletions

View File

@ -2,11 +2,13 @@
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
-- | This module contains default rules defined in the GraphQL specification.
@ -61,6 +63,7 @@ import Data.Sequence (Seq(..), (|>))
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Records (HasField(..))
import qualified Language.GraphQL.AST.Document as Full
import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.Internal as Type
@ -668,25 +671,16 @@ variableUsageDifference difference errorMessage = OperationDefinitionRule $ \cas
= filterSelections' selections
>>= lift . mapReaderT (<> mapDirectives directives') . pure
findDirectiveVariables (Full.Directive _ arguments _) = mapArguments arguments
mapArguments = Seq.fromList . (>>= findArgumentVariables)
mapDirectives = foldMap findDirectiveVariables
findArgumentVariables (Full.Argument _ Full.Node{node = value, ..} _) =
findValueVariables location value
findArgumentVariables (Full.Argument _ value _) = findNodeVariables value
findNodeVariables Full.Node{ node = value, ..} = findValueVariables location value
findValueVariables location (Full.Variable value') = [(value', [location])]
findValueVariables location (Full.List values) =
values
>>= (\(Full.Node{node = value}) -> findValueVariables location value)
findValueVariables _ (Full.Object fields) =
fields
>>= ( \( Full.ObjectField
{ location = location
, value = Full.Node{node = value}
}
) -> findValueVariables location value
)
findValueVariables _ (Full.List values) = values >>= findNodeVariables
findValueVariables _ (Full.Object fields) = fields
>>= findNodeVariables . getField @"value"
findValueVariables _ _ = []
makeError operationName (variableName, locations') = Error
{ message = errorMessage operationName variableName

View File

@ -18,7 +18,7 @@ import Language.GraphQL.Type
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Validate
import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain, xit)
import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain)
import Text.Megaparsec (parse, errorBundlePretty)
petSchema :: Schema IO
@ -29,6 +29,7 @@ queryType = ObjectType "Query" Nothing [] $ HashMap.fromList
[ ("dog", dogResolver)
, ("cat", catResolver)
, ("findDog", findDogResolver)
, ("findCats", findCatsResolver)
]
where
dogField = Field Nothing (Out.NamedObjectType dogType) mempty
@ -39,6 +40,11 @@ queryType = ObjectType "Query" Nothing [] $ HashMap.fromList
findDogResolver = ValueResolver findDogField $ pure Null
catField = Field Nothing (Out.NamedObjectType catType) mempty
catResolver = ValueResolver catField $ pure Null
findCatsArguments = HashMap.singleton "commands"
$ In.Argument Nothing (In.NonNullListType $ In.NonNullEnumType catCommandType)
$ Just $ List []
findCatsField = Field Nothing (Out.NonNullListType $ Out.NonNullObjectType catType) findCatsArguments
findCatsResolver = ValueResolver findCatsField $ pure $ List []
catCommandType :: EnumType
catCommandType = EnumType "CatCommand" Nothing $ HashMap.fromList
@ -560,7 +566,7 @@ spec =
}
in validate queryString `shouldBe` [expected]
xit "gets location of the variable inside an input object" $
it "gets variable location inside an input object" $
let queryString = [gql|
query {
findDog (complex: { name: $name }) {
@ -574,6 +580,20 @@ spec =
}
in validate queryString `shouldBe` [expected]
it "gets variable location inside an array" $
let queryString = [gql|
query {
findCats (commands: [JUMP, $command]) {
name
}
}
|]
expected = Error
{ message = "Variable \"$command\" is not defined."
, locations = [AST.Location 2 30]
}
in validate queryString `shouldBe` [expected]
context "noUnusedVariablesRule" $ do
it "rejects unused variables" $
let queryString = [gql|