From 0d23df3da29cfe0b78af922cea71db5fa1d5c98c Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 9 May 2021 12:34:39 +0200 Subject: [PATCH] Provide an internal function to add errors The old function, addErrMsg, takes only a string with an error description, but more information is required for the execution errors: locations and path. addErrMsg should be deprecated after the switching to the new addError. --- graphql.cabal | 1 + src/Language/GraphQL/Execute/Execution.hs | 3 ++- src/Language/GraphQL/Execute/Internal.hs | 25 +++++++++++++++++++ tests/Language/GraphQL/ExecuteSpec.hs | 30 ++++++++++++++++++++++- 4 files changed, 57 insertions(+), 2 deletions(-) create mode 100644 src/Language/GraphQL/Execute/Internal.hs diff --git a/graphql.cabal b/graphql.cabal index b2316de..0d9b231 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -47,6 +47,7 @@ library Test.Hspec.GraphQL other-modules: Language.GraphQL.Execute.Execution + Language.GraphQL.Execute.Internal Language.GraphQL.Execute.Subscribe Language.GraphQL.Execute.Transform Language.GraphQL.Type.Definition diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs index 0ea361d..38355ce 100644 --- a/src/Language/GraphQL/Execute/Execution.hs +++ b/src/Language/GraphQL/Execute/Execution.hs @@ -21,6 +21,7 @@ import qualified Data.Text as Text import Language.GraphQL.AST (Name) import Language.GraphQL.Error import Language.GraphQL.Execute.Coerce +import Language.GraphQL.Execute.Internal import Language.GraphQL.Execute.OrderedMap (OrderedMap) import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap import qualified Language.GraphQL.Execute.Transform as Transform @@ -123,7 +124,7 @@ completeValue outputType@(Out.EnumBaseType enumType) _ (Type.Enum enum) = let Type.EnumType _ _ enumMembers = enumType in if HashMap.member enum enumMembers then coerceResult outputType $ Enum enum - else addErrMsg "Enum value completion failed." + else addError $ Error "Enum value completion failed." [] [] completeValue (Out.ObjectBaseType objectType) fields result = executeSelectionSet result objectType $ mergeSelectionSets fields completeValue (Out.InterfaceBaseType interfaceType) fields result diff --git a/src/Language/GraphQL/Execute/Internal.hs b/src/Language/GraphQL/Execute/Internal.hs new file mode 100644 index 0000000..3b75da1 --- /dev/null +++ b/src/Language/GraphQL/Execute/Internal.hs @@ -0,0 +1,25 @@ +{- This Source Code Form is subject to the terms of the Mozilla Public License, + 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 DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} + +module Language.GraphQL.Execute.Internal + ( addError + ) where + +import Control.Monad.Trans.State (modify) +import Control.Monad.Catch (MonadCatch) +import Data.Sequence ((|>)) +import Language.GraphQL.Error +import Language.GraphQL.Execute.Coerce +import Prelude hiding (null) + +addError :: (Serialize a, MonadCatch m) => Error -> CollectErrsT m a +addError error' = modify appender >> pure null + where + appender :: Resolution m -> Resolution m + appender resolution@Resolution{ errors } = resolution + { errors = errors |> error' + } diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs index f6e3e6f..3288371 100644 --- a/tests/Language/GraphQL/ExecuteSpec.hs +++ b/tests/Language/GraphQL/ExecuteSpec.hs @@ -30,7 +30,7 @@ philosopherSchema = schema queryType Nothing (Just subscriptionType) mempty queryType :: Out.ObjectType (Either SomeException) queryType = Out.ObjectType "Query" Nothing [] - $ HashMap.singleton "philosopher" + $ HashMap.singleton "philosopher" $ ValueResolver philosopherField $ pure $ Type.Object mempty where @@ -44,6 +44,7 @@ philosopherType = Out.ObjectType "Philosopher" Nothing [] resolvers = [ ("firstName", ValueResolver firstNameField firstNameResolver) , ("lastName", ValueResolver lastNameField lastNameResolver) + , ("school", ValueResolver schoolField schoolResolver) ] firstNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty @@ -51,6 +52,9 @@ philosopherType = Out.ObjectType "Philosopher" Nothing [] lastNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty lastNameResolver = pure $ Type.String "Nietzsche" + schoolField + = Out.Field Nothing (Out.NonNullEnumType schoolType) HashMap.empty + schoolResolver = pure $ Type.Enum "EXISTENTIALISM" subscriptionType :: Out.ObjectType (Either SomeException) subscriptionType = Out.ObjectType "Subscription" Nothing [] @@ -70,6 +74,13 @@ quoteType = Out.ObjectType "Quote" Nothing [] quoteField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty +schoolType :: EnumType +schoolType = EnumType "School" Nothing $ HashMap.fromList + [ ("NOMINALISM", EnumValue Nothing) + , ("REALISM", EnumValue Nothing) + , ("IDEALISM", EnumValue Nothing) + ] + type EitherStreamOrValue = Either (ResponseEventStream (Either SomeException) Aeson.Value) (Response Aeson.Value) @@ -118,6 +129,23 @@ spec = Right (Right actual) = either (pure . parseError) execute' $ parse document "" "{ philosopher { firstName } philosopher { lastName } }" in actual `shouldBe` expected + + it "errors on invalid output enum values" $ + let data'' = Aeson.object + [ "philosopher" .= Aeson.object + [ "school" .= Aeson.Null + ] + ] + executionErrors = pure $ Error + { message = "Enum value completion failed." + , locations = [] + , path = [] + } + expected = Response data'' executionErrors + Right (Right actual) = either (pure . parseError) execute' + $ parse document "" "{ philosopher { school } }" + in actual `shouldBe` expected + context "Subscription" $ it "subscribes" $ let data'' = Aeson.object