summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Language/GraphQL/Execute/Execution.hs41
-rw-r--r--src/Language/GraphQL/Execute/Subscribe.hs4
-rw-r--r--src/Language/GraphQL/Execute/Transform.hs11
-rw-r--r--tests/Language/GraphQL/ExecuteSpec.hs14
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