diff --git a/CHANGELOG.md b/CHANGELOG.md index 6abc211..65a8f6e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,8 @@ and this project adheres to including an optional schema description and user-defined types not referenced in the schema directly (for example interface implementations). - `Language.GraphQL.Schema.description` returns the optional schema description. +- All errors that can be associated with a location in the query contain + location information. ### Fixed - Parser now accepts empty lists and objects. diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index 9e96cd2..62754a3 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ExplicitForAll #-} + -- | This module provides functions to execute a @GraphQL@ request. module Language.GraphQL.Execute ( execute @@ -14,10 +16,16 @@ import Language.GraphQL.Execute.Execution import Language.GraphQL.Execute.Internal import qualified Language.GraphQL.Execute.Transform as Transform import qualified Language.GraphQL.Execute.Subscribe as Subscribe -import Language.GraphQL.Error (ResponseEventStream, Response, runCollectErrs) +import Language.GraphQL.Error + ( Error + , ResponseEventStream + , Response(..) + , runCollectErrs + ) import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type.Out as Out import Language.GraphQL.Type.Schema +import Prelude hiding (null) -- | The substitution is applied to the document, and the resolvers are applied -- to the resulting fields. The operation name can be used if the document @@ -31,10 +39,9 @@ execute :: (MonadCatch m, VariableValue a, Serialize b) -> HashMap Full.Name a -- ^ Variable substitution function. -> Full.Document -- @GraphQL@ document. -> m (Either (ResponseEventStream m b) (Response b)) -execute schema' operationName subs document = - case Transform.document schema' operationName subs document of - Left queryError -> pure $ singleError $ show queryError - Right transformed -> executeRequest transformed +execute schema' operationName subs document + = either (pure . rightErrorResponse . singleError [] . show) executeRequest + $ Transform.document schema' operationName subs document executeRequest :: (MonadCatch m, Serialize a) => Transform.Document m @@ -45,7 +52,7 @@ executeRequest (Transform.Document types' rootObjectType operation) | (Transform.Mutation _ fields objectLocation) <- operation = Right <$> executeOperation types' rootObjectType objectLocation fields | (Transform.Subscription _ fields objectLocation) <- operation - = either singleError Left + = either rightErrorResponse Left <$> Subscribe.subscribe types' rootObjectType objectLocation fields -- This is actually executeMutation, but we don't distinguish between queries @@ -59,3 +66,6 @@ executeOperation :: (MonadCatch m, Serialize a) executeOperation types' objectType objectLocation fields = runCollectErrs types' $ executeSelectionSet Definition.Null objectType objectLocation fields + +rightErrorResponse :: Serialize b => forall a. Error -> Either a (Response b) +rightErrorResponse = Right . Response null . pure diff --git a/src/Language/GraphQL/Execute/Internal.hs b/src/Language/GraphQL/Execute/Internal.hs index 7e4e4a9..046db45 100644 --- a/src/Language/GraphQL/Execute/Internal.hs +++ b/src/Language/GraphQL/Execute/Internal.hs @@ -15,13 +15,8 @@ import Control.Monad.Trans.State (modify) import Control.Monad.Catch (MonadCatch) import Data.Sequence ((|>)) import qualified Data.Text as Text -import Language.GraphQL.Execute.Coerce -import Language.GraphQL.Error - ( CollectErrsT - , Error(..) - , Resolution(..) - , Response(..) - ) +import qualified Language.GraphQL.AST as Full +import Language.GraphQL.Error (CollectErrsT, Error(..), Resolution(..)) import Prelude hiding (null) addError :: MonadCatch m => forall a. a -> Error -> CollectErrsT m a @@ -32,6 +27,5 @@ addError returnValue error' = modify appender >> pure returnValue { errors = errors |> error' } -singleError :: Serialize b => forall a. String -> Either a (Response b) -singleError message = - Right $ Response null $ pure $ Error (Text.pack message) [] [] +singleError :: [Full.Location] -> String -> Error +singleError errorLocations message = Error (Text.pack message) errorLocations [] diff --git a/src/Language/GraphQL/Execute/Subscribe.hs b/src/Language/GraphQL/Execute/Subscribe.hs index 3b07154..5d8d294 100644 --- a/src/Language/GraphQL/Execute/Subscribe.hs +++ b/src/Language/GraphQL/Execute/Subscribe.hs @@ -9,6 +9,7 @@ module Language.GraphQL.Execute.Subscribe ) where import Conduit +import Control.Arrow (left) import Control.Monad.Catch (Exception(..), MonadCatch(..)) import Control.Monad.Trans.Reader (ReaderT(..), runReaderT) import Data.HashMap.Strict (HashMap) @@ -18,9 +19,16 @@ import Data.Sequence (Seq(..)) import qualified Language.GraphQL.AST as Full import Language.GraphQL.Execute.Coerce import Language.GraphQL.Execute.Execution +import Language.GraphQL.Execute.Internal import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap import qualified Language.GraphQL.Execute.Transform as Transform import Language.GraphQL.Error + ( Error(..) + , ResolverException + , Response + , ResponseEventStream + , runCollectErrs + ) import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type as Type import qualified Language.GraphQL.Type.Out as Out @@ -31,9 +39,10 @@ subscribe :: (MonadCatch m, Serialize a) -> Out.ObjectType m -> Full.Location -> Seq (Transform.Selection m) - -> m (Either String (ResponseEventStream m a)) + -> m (Either Error (ResponseEventStream m a)) subscribe types' objectType objectLocation fields = do - sourceStream <- createSourceEventStream types' objectType fields + sourceStream <- + createSourceEventStream types' objectType objectLocation fields let traverser = mapSourceToResponseEvent types' objectType objectLocation fields traverse traverser sourceStream @@ -53,19 +62,25 @@ mapSourceToResponseEvent types' subscriptionType objectLocation fields sourceStr createSourceEventStream :: MonadCatch m => HashMap Full.Name (Type m) -> Out.ObjectType m + -> Full.Location -> Seq (Transform.Selection m) - -> m (Either String (Out.SourceEventStream m)) -createSourceEventStream _types subscriptionType@(Out.ObjectType _ _ _ fieldTypes) fields + -> m (Either Error (Out.SourceEventStream m)) +createSourceEventStream _types subscriptionType objectLocation fields | [fieldGroup] <- OrderedMap.elems groupedFieldSet - , Transform.Field _ fieldName arguments' _ _ <- NonEmpty.head fieldGroup + , Transform.Field _ fieldName arguments' _ errorLocation <- NonEmpty.head fieldGroup + , Out.ObjectType _ _ _ fieldTypes <- subscriptionType , resolverT <- fieldTypes HashMap.! fieldName , Out.EventStreamResolver fieldDefinition _ resolver <- resolverT , Out.Field _ _fieldType argumentDefinitions <- fieldDefinition = case coerceArgumentValues argumentDefinitions arguments' of - Left _ -> pure $ Left "Argument coercion failed." - Right argumentValues -> - resolveFieldEventStream Type.Null argumentValues resolver - | otherwise = pure $ Left "Subscription contains more than one field." + Left _ -> pure + $ Left + $ Error "Argument coercion failed." [errorLocation] [] + Right argumentValues -> left (singleError [errorLocation]) + <$> resolveFieldEventStream Type.Null argumentValues resolver + | otherwise = pure + $ Left + $ Error "Subscription contains more than one field." [objectLocation] [] where groupedFieldSet = collectFields subscriptionType fields