Provide locations for argument errors

The executor still doesn't give an error per argument, but a single
error per field with locations for all arguments.
If a non-null argument isn't specified, only the error location of the
field is given. If some arguments cannot be coerced, only the locations
of these arguments are given, non-null arguments are ignored. This
should still be improved, so the executor returns all errors at once.
The transformation tree is changed, so that argument map contains
locations of the arguments (but not the locations of the argument values
yet).
This commit is contained in:
Eugen Wissner 2021-06-22 09:13:27 +02:00
parent 6fe9eb72e4
commit 812f6967d4
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
4 changed files with 54 additions and 16 deletions

View File

@ -1,4 +1,5 @@
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
@ -19,7 +20,7 @@ import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq(..))
import qualified Data.Text as Text
import Language.GraphQL.AST (Name)
import qualified Language.GraphQL.AST as Full
import Language.GraphQL.Error
import Language.GraphQL.Execute.Coerce
import Language.GraphQL.Execute.Internal
@ -66,7 +67,7 @@ collectFields objectType = foldl forEach OrderedMap.empty
in groupedFields <> fragmentGroupedFieldSet
| otherwise = groupedFields
aliasOrName :: forall m. Transform.Field m -> Name
aliasOrName :: forall m. Transform.Field m -> Full.Name
aliasOrName (Transform.Field alias name _ _ _) = fromMaybe name alias
resolveAbstractType :: Monad m
@ -97,10 +98,14 @@ executeField fieldResolver prev fields
where
executeField' fieldDefinition resolver = do
let Out.Field _ fieldType argumentDefinitions = fieldDefinition
let Transform.Field _ _ arguments' _ _ = NonEmpty.head fields
let Transform.Field _ _ arguments' _ location' = NonEmpty.head fields
case coerceArgumentValues argumentDefinitions arguments' of
Nothing -> addError null $ Error "Argument coercing failed." [] []
Just argumentValues -> do
Left [] ->
let errorMessage = "Not all required arguments are specified."
in addError null $ Error errorMessage [location'] []
Left errorLocations -> addError null
$ Error "Argument coercing failed." errorLocations []
Right argumentValues -> do
answer <- resolveFieldValue prev argumentValues resolver
completeValue fieldType fields answer
@ -189,14 +194,28 @@ executeSelectionSet result objectType@(Out.ObjectType _ _ _ resolvers) selection
executeField resolver result fields >>= lift . pure
coerceArgumentValues
:: HashMap Name In.Argument
-> HashMap Name Transform.Input
-> Maybe Type.Subs
coerceArgumentValues argumentDefinitions argumentValues =
:: HashMap Full.Name In.Argument
-> HashMap Full.Name (Full.Node Transform.Input)
-> Either [Full.Location] Type.Subs
coerceArgumentValues argumentDefinitions argumentNodes =
HashMap.foldrWithKey forEach (pure mempty) argumentDefinitions
where
forEach variableName (In.Argument _ variableType defaultValue) =
matchFieldValues coerceArgumentValue argumentValues variableName variableType defaultValue
forEach argumentName (In.Argument _ variableType defaultValue) = \case
Right resultMap
| Just matchedValues
<- matchFieldValues' argumentName variableType defaultValue $ Just resultMap
-> Right matchedValues
| otherwise -> Left $ generateError argumentName []
Left errorLocations
| Just _
<- matchFieldValues' argumentName variableType defaultValue $ pure mempty
-> Left errorLocations
| otherwise -> Left $ generateError argumentName errorLocations
generateError argumentName errorLocations =
case HashMap.lookup argumentName argumentNodes of
Just (Full.Node _ errorLocation) -> [errorLocation]
Nothing -> errorLocations
matchFieldValues' = matchFieldValues coerceArgumentValue (Full.node <$> argumentNodes)
coerceArgumentValue inputType (Transform.Int integer) =
coerceInputLiteral inputType (Type.Int integer)
coerceArgumentValue inputType (Transform.Boolean boolean) =

View File

@ -57,8 +57,8 @@ createSourceEventStream _types subscriptionType@(Out.ObjectType _ _ _ fieldTypes
, Out.EventStreamResolver fieldDefinition _ resolver <- resolverT
, Out.Field _ _fieldType argumentDefinitions <- fieldDefinition =
case coerceArgumentValues argumentDefinitions arguments' of
Nothing -> pure $ Left "Argument coercion failed."
Just argumentValues ->
Left _ -> pure $ Left "Argument coercion failed."
Right argumentValues ->
resolveFieldEventStream Type.Null argumentValues resolver
| otherwise = pure $ Left "Subscription contains more than one field."
where

View File

@ -83,7 +83,7 @@ data Operation m
data Field m = Field
(Maybe Full.Name)
Full.Name
(HashMap Full.Name Input)
(HashMap Full.Name (Full.Node Input))
(Seq (Selection m))
Full.Location
@ -278,8 +278,13 @@ field (Full.Field alias name arguments' directives' selections location) = do
let field' = Field alias name fieldArguments fieldSelections location
pure $ field' <$ fieldDirectives
where
go arguments (Full.Argument name' (Full.Node value' _) _) =
inputField arguments name' value'
go arguments (Full.Argument name' (Full.Node value' _) location') = do
objectFieldValue <- input value'
case objectFieldValue of
Just fieldValue ->
let argumentNode = Full.Node fieldValue location'
in pure $ HashMap.insert name' argumentNode arguments
Nothing -> pure arguments
fragmentSpread
:: Full.FragmentSpread

View File

@ -254,6 +254,20 @@ spec =
$ parse document "" "{ philosopher { majorWork { title } } }"
in actual `shouldBe` expected
it "gives location information for invalid scalar arguments" $
let data'' = Aeson.object
[ "philosopher" .= Aeson.Null
]
executionErrors = pure $ Error
{ message = "Argument coercing failed."
, locations = [Location 1 15]
, path = []
}
expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ philosopher(id: true) { lastName } }"
in actual `shouldBe` expected
context "Subscription" $
it "subscribes" $
let data'' = Aeson.object