From 1f7bd92d1105f44d5214c1210d4cefeb8bc1bd8e Mon Sep 17 00:00:00 2001 From: Dmitrii Skurikhin Date: Tue, 4 Jan 2022 14:40:41 +0300 Subject: [PATCH] fix index position in error path --- CHANGELOG.md | 4 ++ graphql.cabal | 5 +- src/Language/GraphQL/Execute.hs | 12 ++--- tests/Language/GraphQL/ExecuteSpec.hs | 16 ++++++ tests/Schemas/HeroSchema.hs | 70 +++++++++++++++++++++++++++ 5 files changed, 100 insertions(+), 7 deletions(-) create mode 100644 tests/Schemas/HeroSchema.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index bfd8aa2..554fadf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,10 @@ The format is based on and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [1.0.3] - 2021-01-04 +### Fixed +- Index position in error path. (Index and Segment paths of a field have been swapped) + ## [1.0.2.0] - 2021-12-26 ### Added - `Serialize` instance for `Type.Definition.Value`. diff --git a/graphql.cabal b/graphql.cabal index daf020f..c81c01a 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -99,6 +99,7 @@ test-suite graphql-test Language.GraphQL.ExecuteSpec Language.GraphQL.Type.OutSpec Language.GraphQL.Validate.RulesSpec + Schemas.HeroSchema hs-source-dirs: tests ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall @@ -113,5 +114,7 @@ test-suite graphql-test hspec-megaparsec ^>= 2.2.0, megaparsec, text, - unordered-containers + unordered-containers, + containers, + vector default-language: Haskell2010 diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index 476cc50..3faee5b 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -375,6 +375,7 @@ executeField objectValue fields (viewResolver -> resolverPair) errorPath = , Handler (resolverHandler fieldLocation) ] where + fieldErrorPath = fieldsSegment fields : errorPath inputCoercionHandler :: (MonadCatch m, Serialize a) => Full.Location -> InputCoercionException @@ -402,17 +403,16 @@ executeField objectValue fields (viewResolver -> resolverPair) errorPath = then throwM e else returnError newError exceptionHandler errorLocation e = - let newPath = fieldsSegment fields : errorPath - newError = constructError e errorLocation newPath + let newError = constructError e errorLocation fieldErrorPath in if Out.isNonNullType fieldType - then throwM $ FieldException errorLocation newPath e + then throwM $ FieldException errorLocation fieldErrorPath e else returnError newError returnError newError = tell (Seq.singleton newError) >> pure null go fieldName inputArguments = do argumentValues <- coerceArgumentValues argumentTypes inputArguments resolvedValue <- resolveFieldValue resolveFunction objectValue fieldName argumentValues - completeValue fieldType fields errorPath resolvedValue + completeValue fieldType fields fieldErrorPath resolvedValue (resolverField, resolveFunction) = resolverPair Out.Field _ fieldType argumentTypes = resolverField @@ -445,6 +445,7 @@ resolveAbstractType abstractType values' _ -> pure Nothing | otherwise = pure Nothing +-- https://spec.graphql.org/October2021/#sec-Value-Completion completeValue :: (MonadCatch m, Serialize a) => Out.Type m -> NonEmpty (Transform.Field m) @@ -476,8 +477,7 @@ completeValue outputType@(Out.EnumBaseType enumType) _ _ (Type.Enum enum) = $ ValueCompletionException (show outputType) $ Type.Enum enum completeValue (Out.ObjectBaseType objectType) fields errorPath result - = executeSelectionSet (mergeSelectionSets fields) objectType result - $ fieldsSegment fields : errorPath + = executeSelectionSet (mergeSelectionSets fields) objectType result errorPath completeValue outputType@(Out.InterfaceBaseType interfaceType) fields errorPath result | Type.Object objectMap <- result = do let abstractType = Type.Internal.AbstractInterfaceType interfaceType diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs index 5eafb2e..f4e599a 100644 --- a/tests/Language/GraphQL/ExecuteSpec.hs +++ b/tests/Language/GraphQL/ExecuteSpec.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} + module Language.GraphQL.ExecuteSpec ( spec ) where @@ -26,6 +27,9 @@ import qualified Language.GraphQL.Type.Out as Out import Prelude hiding (id) import Test.Hspec (Spec, context, describe, it, shouldBe) import Text.Megaparsec (parse) +import Schemas.HeroSchema (heroSchema) +import Data.Maybe (fromJust) +import qualified Data.Sequence as Seq data PhilosopherException = PhilosopherException deriving Show @@ -335,6 +339,18 @@ spec = $ parse document "" "{ philosopher(id: \"1\") { firstLanguage } }" in actual `shouldBe` expected + context "Error path" $ do + let executeHero :: Document -> Either SomeException EitherStreamOrValue + executeHero = execute heroSchema Nothing (HashMap.empty :: HashMap Name Value) + + it "at the beggining of the list" $ + let Right (Right actual) = either (pure . parseError) executeHero + $ parse document "" "{ hero(id: \"1\") { friends { name } } }" + Response _ errors' = actual + Error _ _ path' = fromJust $ Seq.lookup 0 errors' + expected = [Segment "hero", Segment "friends", Index 0, Segment "name"] + in path' `shouldBe` expected + context "Subscription" $ it "subscribes" $ let data'' = Object diff --git a/tests/Schemas/HeroSchema.hs b/tests/Schemas/HeroSchema.hs new file mode 100644 index 0000000..71b7a10 --- /dev/null +++ b/tests/Schemas/HeroSchema.hs @@ -0,0 +1,70 @@ +{- 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 OverloadedStrings #-} + +module Schemas.HeroSchema (heroSchema) where + +import Control.Exception (Exception(..), SomeException) +import Control.Monad.Catch (throwM) +import Language.GraphQL.Error (ResolverException (..)) +import qualified Language.GraphQL.Type.In as In +import qualified Language.GraphQL.Type as Type +import Language.GraphQL.Type.Schema (schemaWithTypes) +import qualified Data.HashMap.Strict as HashMap +import Data.Typeable (cast) +import qualified Language.GraphQL.Type.Out as Out + +data HeroException = HeroException + deriving Show + +instance Exception HeroException where + toException = toException. ResolverException + fromException e = do + ResolverException resolverException <- fromException e + cast resolverException + +heroSchema :: Type.Schema (Either SomeException) +heroSchema = + schemaWithTypes Nothing queryType Nothing Nothing [] mempty + +type ObjectType = Out.ObjectType (Either SomeException) + +queryType :: ObjectType +queryType = Out.ObjectType "Query" Nothing [] + $ HashMap.fromList + [ ("hero", Out.ValueResolver heroField heroResolver) + ] + where + heroField = Out.Field Nothing (Out.NamedObjectType heroType) + $ HashMap.singleton "id" + $ In.Argument Nothing (In.NamedScalarType Type.id) Nothing + heroResolver = pure $ Type.Object mempty + +stringField :: Out.Field (Either SomeException) +stringField = Out.Field Nothing (Out.NonNullScalarType Type.string) HashMap.empty + +heroType :: ObjectType +heroType = Out.ObjectType "Hero" Nothing [] $ HashMap.fromList resolvers + where + resolvers = + [ ("id", Out.ValueResolver stringField (pure $ Type.String "4111")) + , ("name", Out.ValueResolver stringField (pure $ Type.String "R2D2")) + , ("friends", Out.ValueResolver friendsField (pure $ Type.List [luke])) + ] + friendsField = Out.Field Nothing (Out.ListType $ Out.NonNullObjectType lukeType) HashMap.empty + -- This list values are ignored because of current realisation (types and resolvers are the same entity) + -- The values from lukeType will be used + luke = Type.Object $ HashMap.fromList + [ ("id", "dfdfdf") + , ("name", "dfdfdff") + ] + +lukeType :: ObjectType +lukeType = Out.ObjectType "Luke" Nothing [] $ HashMap.fromList resolvers + where + resolvers = + [ ("id", Out.ValueResolver stringField (pure $ Type.String "1000")) + , ("name", Out.ValueResolver stringField (throwM HeroException)) + ]