Fix variable location in objects and lists
All checks were successful
Build / audit (push) Successful in 15m35s
Build / test (push) Successful in 8m6s
Build / doc (push) Successful in 6m59s

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 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/. -} obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
-- | This module contains default rules defined in the GraphQL specification. -- | 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 qualified Data.Sequence as Seq
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import GHC.Records (HasField(..))
import qualified Language.GraphQL.AST.Document as Full import qualified Language.GraphQL.AST.Document as Full
import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.Internal as Type import qualified Language.GraphQL.Type.Internal as Type
@ -668,25 +671,16 @@ variableUsageDifference difference errorMessage = OperationDefinitionRule $ \cas
= filterSelections' selections = filterSelections' selections
>>= lift . mapReaderT (<> mapDirectives directives') . pure >>= lift . mapReaderT (<> mapDirectives directives') . pure
findDirectiveVariables (Full.Directive _ arguments _) = mapArguments arguments findDirectiveVariables (Full.Directive _ arguments _) = mapArguments arguments
mapArguments = Seq.fromList . (>>= findArgumentVariables) mapArguments = Seq.fromList . (>>= findArgumentVariables)
mapDirectives = foldMap findDirectiveVariables mapDirectives = foldMap findDirectiveVariables
findArgumentVariables (Full.Argument _ Full.Node{node = value, ..} _) = findArgumentVariables (Full.Argument _ value _) = findNodeVariables value
findValueVariables location value findNodeVariables Full.Node{ node = value, ..} = findValueVariables location value
findValueVariables location (Full.Variable value') = [(value', [location])] findValueVariables location (Full.Variable value') = [(value', [location])]
findValueVariables location (Full.List values) = findValueVariables _ (Full.List values) = values >>= findNodeVariables
values findValueVariables _ (Full.Object fields) = fields
>>= (\(Full.Node{node = value}) -> findValueVariables location value) >>= findNodeVariables . getField @"value"
findValueVariables _ (Full.Object fields) =
fields
>>= ( \( Full.ObjectField
{ location = location
, value = Full.Node{node = value}
}
) -> findValueVariables location value
)
findValueVariables _ _ = [] findValueVariables _ _ = []
makeError operationName (variableName, locations') = Error makeError operationName (variableName, locations') = Error
{ message = errorMessage operationName variableName { 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.In as In
import qualified Language.GraphQL.Type.Out as Out import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Validate 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) import Text.Megaparsec (parse, errorBundlePretty)
petSchema :: Schema IO petSchema :: Schema IO
@ -29,6 +29,7 @@ queryType = ObjectType "Query" Nothing [] $ HashMap.fromList
[ ("dog", dogResolver) [ ("dog", dogResolver)
, ("cat", catResolver) , ("cat", catResolver)
, ("findDog", findDogResolver) , ("findDog", findDogResolver)
, ("findCats", findCatsResolver)
] ]
where where
dogField = Field Nothing (Out.NamedObjectType dogType) mempty dogField = Field Nothing (Out.NamedObjectType dogType) mempty
@ -39,6 +40,11 @@ queryType = ObjectType "Query" Nothing [] $ HashMap.fromList
findDogResolver = ValueResolver findDogField $ pure Null findDogResolver = ValueResolver findDogField $ pure Null
catField = Field Nothing (Out.NamedObjectType catType) mempty catField = Field Nothing (Out.NamedObjectType catType) mempty
catResolver = ValueResolver catField $ pure Null 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
catCommandType = EnumType "CatCommand" Nothing $ HashMap.fromList catCommandType = EnumType "CatCommand" Nothing $ HashMap.fromList
@ -560,7 +566,7 @@ spec =
} }
in validate queryString `shouldBe` [expected] 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| let queryString = [gql|
query { query {
findDog (complex: { name: $name }) { findDog (complex: { name: $name }) {
@ -574,6 +580,20 @@ spec =
} }
in validate queryString `shouldBe` [expected] 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 context "noUnusedVariablesRule" $ do
it "rejects unused variables" $ it "rejects unused variables" $
let queryString = [gql| let queryString = [gql|