From 812f6967d40cfd1d1c0af5512496ff7b7cb0f6ae Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Tue, 22 Jun 2021 09:13:27 +0200 Subject: [PATCH] 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). --- src/Language/GraphQL/Execute/Execution.hs | 41 +++++++++++++++++------ src/Language/GraphQL/Execute/Subscribe.hs | 4 +-- src/Language/GraphQL/Execute/Transform.hs | 11 ++++-- tests/Language/GraphQL/ExecuteSpec.hs | 14 ++++++++ 4 files changed, 54 insertions(+), 16 deletions(-) diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs index a217d9c..31cc579 100644 --- a/src/Language/GraphQL/Execute/Execution.hs +++ b/src/Language/GraphQL/Execute/Execution.hs @@ -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) = diff --git a/src/Language/GraphQL/Execute/Subscribe.hs b/src/Language/GraphQL/Execute/Subscribe.hs index 648e741..fada378 100644 --- a/src/Language/GraphQL/Execute/Subscribe.hs +++ b/src/Language/GraphQL/Execute/Subscribe.hs @@ -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 diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs index 5e2054b..5f3b771 100644 --- a/src/Language/GraphQL/Execute/Transform.hs +++ b/src/Language/GraphQL/Execute/Transform.hs @@ -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 diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs index a31b0a2..5e86848 100644 --- a/tests/Language/GraphQL/ExecuteSpec.hs +++ b/tests/Language/GraphQL/ExecuteSpec.hs @@ -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