Deprecate internal error generation functions

The functions generating errors in the executor should be changed anyway
when we provide better error messages from the executor, with the error
location and response path. So public definitions of these functions are
deprecated now and they are replaced by more generic functions in the
executor code.
This commit is contained in:
Eugen Wissner 2021-05-10 09:43:39 +02:00
parent 0d23df3da2
commit 1af95345d2
7 changed files with 57 additions and 30 deletions

View File

@ -23,6 +23,8 @@ and this project adheres to
### Changed ### Changed
- `AST.Document.Value.List` and `AST.Document.ConstValue.ConstList` contain - `AST.Document.Value.List` and `AST.Document.ConstValue.ConstList` contain
location information for each list item. location information for each list item.
- `Error`: `singleError`, `addErr` and `addErrMsg` are deprecated. They are
internal functions used by the executor for error handling.
## [0.11.1.0] - 2021-02-07 ## [0.11.1.0] - 2021-02-07
### Added ### Added

View File

@ -69,21 +69,25 @@ parseError ParseErrorBundle{..} =
type CollectErrsT m = StateT (Resolution m) m type CollectErrsT m = StateT (Resolution m) m
-- | Adds an error to the list of errors. -- | Adds an error to the list of errors.
{-# DEPRECATED #-}
addErr :: Monad m => Error -> CollectErrsT m () addErr :: Monad m => Error -> CollectErrsT m ()
addErr v = modify appender addErr v = modify appender
where where
appender :: Monad m => Resolution m -> Resolution m appender :: Monad m => Resolution m -> Resolution m
appender resolution@Resolution{..} = resolution{ errors = errors |> v } appender resolution@Resolution{..} = resolution{ errors = errors |> v }
{-# DEPRECATED #-}
makeErrorMessage :: Text -> Error makeErrorMessage :: Text -> Error
makeErrorMessage s = Error s [] [] makeErrorMessage s = Error s [] []
-- | Constructs a response object containing only the error with the given -- | Constructs a response object containing only the error with the given
-- message. -- message.
{-# DEPRECATED #-}
singleError :: Serialize a => Text -> Response a singleError :: Serialize a => Text -> Response a
singleError message = Response null $ Seq.singleton $ makeErrorMessage message singleError message = Response null $ Seq.singleton $ Error message [] []
-- | Convenience function for just wrapping an error message. -- | Convenience function for just wrapping an error message.
{-# DEPRECATED #-}
addErrMsg :: (Monad m, Serialize a) => Text -> CollectErrsT m a addErrMsg :: (Monad m, Serialize a) => Text -> CollectErrsT m a
addErrMsg errorMessage = (addErr . makeErrorMessage) errorMessage >> pure null addErrMsg errorMessage = (addErr . makeErrorMessage) errorMessage >> pure null

View File

@ -11,9 +11,10 @@ import Data.Text (Text)
import Language.GraphQL.AST.Document (Document, Name) import Language.GraphQL.AST.Document (Document, Name)
import Language.GraphQL.Execute.Coerce import Language.GraphQL.Execute.Coerce
import Language.GraphQL.Execute.Execution import Language.GraphQL.Execute.Execution
import Language.GraphQL.Execute.Internal
import qualified Language.GraphQL.Execute.Transform as Transform import qualified Language.GraphQL.Execute.Transform as Transform
import qualified Language.GraphQL.Execute.Subscribe as Subscribe import qualified Language.GraphQL.Execute.Subscribe as Subscribe
import Language.GraphQL.Error import Language.GraphQL.Error (ResponseEventStream, Response, runCollectErrs)
import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.Out as Out import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema import Language.GraphQL.Type.Schema
@ -32,10 +33,7 @@ execute :: (MonadCatch m, VariableValue a, Serialize b)
-> m (Either (ResponseEventStream m b) (Response b)) -> m (Either (ResponseEventStream m b) (Response b))
execute schema' operationName subs document = execute schema' operationName subs document =
case Transform.document schema' operationName subs document of case Transform.document schema' operationName subs document of
Left queryError -> pure Left queryError -> pure $ singleError $ Transform.queryError queryError
$ Right
$ singleError
$ Transform.queryError queryError
Right transformed -> executeRequest transformed Right transformed -> executeRequest transformed
executeRequest :: (MonadCatch m, Serialize a) executeRequest :: (MonadCatch m, Serialize a)
@ -47,7 +45,7 @@ executeRequest (Transform.Document types' rootObjectType operation)
| (Transform.Mutation _ fields) <- operation = | (Transform.Mutation _ fields) <- operation =
Right <$> executeOperation types' rootObjectType fields Right <$> executeOperation types' rootObjectType fields
| (Transform.Subscription _ fields) <- operation | (Transform.Subscription _ fields) <- operation
= either (Right . singleError) Left = either singleError Left
<$> Subscribe.subscribe types' rootObjectType fields <$> Subscribe.subscribe types' rootObjectType fields
-- This is actually executeMutation, but we don't distinguish between queries -- This is actually executeMutation, but we don't distinguish between queries

View File

@ -43,7 +43,7 @@ resolveFieldValue result args resolver =
=> ResolverException => ResolverException
-> CollectErrsT m Type.Value -> CollectErrsT m Type.Value
handleFieldError e = handleFieldError e =
addErr (Error (Text.pack $ displayException e) [] []) >> pure Type.Null addError Type.Null $ Error (Text.pack $ displayException e) [] []
context = Type.Context context = Type.Context
{ Type.arguments = Type.Arguments args { Type.arguments = Type.Arguments args
, Type.values = result , Type.values = result
@ -98,7 +98,7 @@ executeField fieldResolver prev fields
let Out.Field _ fieldType argumentDefinitions = fieldDefinition let Out.Field _ fieldType argumentDefinitions = fieldDefinition
let (Transform.Field _ _ arguments' _ :| []) = fields let (Transform.Field _ _ arguments' _ :| []) = fields
case coerceArgumentValues argumentDefinitions arguments' of case coerceArgumentValues argumentDefinitions arguments' of
Nothing -> addErrMsg "Argument coercing failed." Nothing -> addError null $ Error "Argument coercing failed." [] []
Just argumentValues -> do Just argumentValues -> do
answer <- resolveFieldValue prev argumentValues resolver answer <- resolveFieldValue prev argumentValues resolver
completeValue fieldType fields answer completeValue fieldType fields answer
@ -124,7 +124,7 @@ completeValue outputType@(Out.EnumBaseType enumType) _ (Type.Enum enum) =
let Type.EnumType _ _ enumMembers = enumType let Type.EnumType _ _ enumMembers = enumType
in if HashMap.member enum enumMembers in if HashMap.member enum enumMembers
then coerceResult outputType $ Enum enum then coerceResult outputType $ Enum enum
else addError $ Error "Enum value completion failed." [] [] else addError null $ Error "Enum value completion failed." [] []
completeValue (Out.ObjectBaseType objectType) fields result = completeValue (Out.ObjectBaseType objectType) fields result =
executeSelectionSet result objectType $ mergeSelectionSets fields executeSelectionSet result objectType $ mergeSelectionSets fields
completeValue (Out.InterfaceBaseType interfaceType) fields result completeValue (Out.InterfaceBaseType interfaceType) fields result
@ -134,7 +134,8 @@ completeValue (Out.InterfaceBaseType interfaceType) fields result
case concreteType of case concreteType of
Just objectType -> executeSelectionSet result objectType Just objectType -> executeSelectionSet result objectType
$ mergeSelectionSets fields $ mergeSelectionSets fields
Nothing -> addErrMsg "Interface value completion failed." Nothing -> addError null
$ Error "Interface value completion failed." [] []
completeValue (Out.UnionBaseType unionType) fields result completeValue (Out.UnionBaseType unionType) fields result
| Type.Object objectMap <- result = do | Type.Object objectMap <- result = do
let abstractType = Internal.AbstractUnionType unionType let abstractType = Internal.AbstractUnionType unionType
@ -142,8 +143,9 @@ completeValue (Out.UnionBaseType unionType) fields result
case concreteType of case concreteType of
Just objectType -> executeSelectionSet result objectType Just objectType -> executeSelectionSet result objectType
$ mergeSelectionSets fields $ mergeSelectionSets fields
Nothing -> addErrMsg "Union value completion failed." Nothing -> addError null
completeValue _ _ _ = addErrMsg "Value completion failed." $ Error "Union value completion failed." [] []
completeValue _ _ _ = addError null $ Error "Value completion failed." [] []
mergeSelectionSets :: MonadCatch m mergeSelectionSets :: MonadCatch m
=> NonEmpty (Transform.Field m) => NonEmpty (Transform.Field m)
@ -159,7 +161,7 @@ coerceResult :: (MonadCatch m, Serialize a)
-> CollectErrsT m a -> CollectErrsT m a
coerceResult outputType result coerceResult outputType result
| Just serialized <- serialize outputType result = pure serialized | Just serialized <- serialize outputType result = pure serialized
| otherwise = addErrMsg "Result coercion failed." | otherwise = addError null $ Error "Result coercion failed." [] []
-- | Takes an 'Out.ObjectType' and a list of 'Transform.Selection's and applies -- | Takes an 'Out.ObjectType' and a list of 'Transform.Selection's and applies
-- each field to each 'Transform.Selection'. Resolves into a value containing -- each field to each 'Transform.Selection'. Resolves into a value containing

View File

@ -3,23 +3,34 @@
obtain one at https://mozilla.org/MPL/2.0/. -} obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
module Language.GraphQL.Execute.Internal module Language.GraphQL.Execute.Internal
( addError ( addError
, singleError
) where ) where
import Control.Monad.Trans.State (modify) import Control.Monad.Trans.State (modify)
import Control.Monad.Catch (MonadCatch) import Control.Monad.Catch (MonadCatch)
import Data.Sequence ((|>)) import Data.Sequence ((|>))
import Language.GraphQL.Error import Data.Text (Text)
import Language.GraphQL.Execute.Coerce import Language.GraphQL.Execute.Coerce
import Language.GraphQL.Error
( CollectErrsT
, Error(..)
, Resolution(..)
, Response(..)
)
import Prelude hiding (null) import Prelude hiding (null)
addError :: (Serialize a, MonadCatch m) => Error -> CollectErrsT m a addError :: MonadCatch m => forall a. a -> Error -> CollectErrsT m a
addError error' = modify appender >> pure null addError returnValue error' = modify appender >> pure returnValue
where where
appender :: Resolution m -> Resolution m appender :: Resolution m -> Resolution m
appender resolution@Resolution{ errors } = resolution appender resolution@Resolution{ errors } = resolution
{ errors = errors |> error' { errors = errors |> error'
} }
singleError :: Serialize b => forall a. Text -> Either a (Response b)
singleError message = Right $ Response null $ pure $ Error message [] []

View File

@ -28,8 +28,6 @@ import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.Out as Out import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema import Language.GraphQL.Type.Schema
-- This is actually executeMutation, but we don't distinguish between queries
-- and mutations yet.
subscribe :: (MonadCatch m, Serialize a) subscribe :: (MonadCatch m, Serialize a)
=> HashMap Name (Type m) => HashMap Name (Type m)
-> Out.ObjectType m -> Out.ObjectType m

View File

@ -8,17 +8,29 @@ module Language.GraphQL.ErrorSpec
) where ) where
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import qualified Data.Sequence as Seq import Data.List.NonEmpty (NonEmpty (..))
import Language.GraphQL.Error import Language.GraphQL.Error
import Test.Hspec ( Spec import Test.Hspec
( Spec
, describe , describe
, it , it
, shouldBe , shouldBe
) )
import Text.Megaparsec (PosState(..))
import Text.Megaparsec.Error (ParseError(..), ParseErrorBundle(..))
import Text.Megaparsec.Pos (SourcePos(..), mkPos)
spec :: Spec spec :: Spec
spec = describe "singleError" $ spec = describe "parseError" $
it "constructs an error with the given message" $ it "generates response with a single error" $ do
let errors'' = Seq.singleton $ Error "Message." [] [] let parseErrors = TrivialError 0 Nothing mempty :| []
expected = Response Aeson.Null errors'' posState = PosState
in singleError "Message." `shouldBe` expected { pstateInput = ""
, pstateOffset = 0
, pstateSourcePos = SourcePos "" (mkPos 1) (mkPos 1)
, pstateTabWidth = mkPos 1
, pstateLinePrefix = ""
}
Response Aeson.Null actual <-
parseError (ParseErrorBundle parseErrors posState)
length actual `shouldBe` 1