2017-02-10 22:40:08 +01:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2020-05-14 09:17:14 +02:00
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
2019-07-08 10:15:47 +02:00
|
|
|
|
2019-08-30 07:26:04 +02:00
|
|
|
-- | This module provides functions to execute a @GraphQL@ request.
|
2019-07-14 05:58:05 +02:00
|
|
|
module Language.GraphQL.Execute
|
|
|
|
( execute
|
2019-07-25 07:37:36 +02:00
|
|
|
, executeWithName
|
2019-07-14 05:58:05 +02:00
|
|
|
) where
|
2015-10-17 13:19:00 +02:00
|
|
|
|
2019-07-25 07:37:36 +02:00
|
|
|
import qualified Data.Aeson as Aeson
|
2020-05-14 09:17:14 +02:00
|
|
|
import Data.Foldable (find)
|
2020-05-21 10:20:59 +02:00
|
|
|
import qualified Data.HashMap.Strict as HashMap
|
2019-08-30 07:26:04 +02:00
|
|
|
import Data.List.NonEmpty (NonEmpty(..))
|
2019-07-25 07:37:36 +02:00
|
|
|
import Data.Text (Text)
|
|
|
|
import qualified Data.Text as Text
|
2019-12-26 13:00:47 +01:00
|
|
|
import Language.GraphQL.AST.Document
|
2019-07-07 06:31:53 +02:00
|
|
|
import qualified Language.GraphQL.AST.Core as AST.Core
|
2020-05-21 10:20:59 +02:00
|
|
|
import Language.GraphQL.Execute.Coerce
|
2019-12-07 09:46:00 +01:00
|
|
|
import qualified Language.GraphQL.Execute.Transform as Transform
|
2019-07-07 06:31:53 +02:00
|
|
|
import Language.GraphQL.Error
|
|
|
|
import qualified Language.GraphQL.Schema as Schema
|
2020-05-21 10:20:59 +02:00
|
|
|
import qualified Language.GraphQL.Type.Definition as Definition
|
2020-05-14 09:17:14 +02:00
|
|
|
import Language.GraphQL.Type.Schema
|
|
|
|
|
|
|
|
-- | Query error types.
|
|
|
|
data QueryError
|
|
|
|
= OperationNotFound Text
|
|
|
|
| OperationNameRequired
|
2020-05-21 10:20:59 +02:00
|
|
|
| CoercionError
|
2020-05-14 09:17:14 +02:00
|
|
|
|
|
|
|
queryError :: QueryError -> Text
|
|
|
|
queryError (OperationNotFound operationName) = Text.unwords
|
|
|
|
["Operation", operationName, "couldn't be found in the document."]
|
|
|
|
queryError OperationNameRequired = "Missing operation name."
|
2020-05-21 10:20:59 +02:00
|
|
|
queryError CoercionError = "Coercion error."
|
2015-10-17 13:19:00 +02:00
|
|
|
|
2019-08-30 07:26:04 +02:00
|
|
|
-- | The substitution is applied to the document, and the resolvers are applied
|
|
|
|
-- to the resulting fields.
|
2016-03-15 14:02:34 +01:00
|
|
|
--
|
2019-08-30 07:26:04 +02:00
|
|
|
-- Returns the result of the query against the schema wrapped in a /data/
|
|
|
|
-- field, or errors wrapped in an /errors/ field.
|
2020-05-21 10:20:59 +02:00
|
|
|
execute :: (Monad m, VariableValue a)
|
2020-05-14 09:17:14 +02:00
|
|
|
=> Schema m -- ^ Resolvers.
|
2020-05-21 10:20:59 +02:00
|
|
|
-> HashMap.HashMap Name a -- ^ Variable substitution function.
|
2019-12-26 13:00:47 +01:00
|
|
|
-> Document -- @GraphQL@ document.
|
2019-07-25 07:37:36 +02:00
|
|
|
-> m Aeson.Value
|
2020-05-21 10:20:59 +02:00
|
|
|
execute schema = document schema Nothing
|
2019-07-25 07:37:36 +02:00
|
|
|
|
2019-08-30 07:26:04 +02:00
|
|
|
-- | 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
|
|
|
|
-- defines multiple root operations.
|
2019-07-25 07:37:36 +02:00
|
|
|
--
|
2019-08-30 07:26:04 +02:00
|
|
|
-- Returns the result of the query against the schema wrapped in a /data/
|
|
|
|
-- field, or errors wrapped in an /errors/ field.
|
2020-05-21 10:20:59 +02:00
|
|
|
executeWithName :: (Monad m, VariableValue a)
|
2020-05-14 09:17:14 +02:00
|
|
|
=> Schema m -- ^ Resolvers
|
2019-08-30 07:26:04 +02:00
|
|
|
-> Text -- ^ Operation name.
|
2020-05-21 10:20:59 +02:00
|
|
|
-> HashMap.HashMap Name a -- ^ Variable substitution function.
|
2019-12-26 13:00:47 +01:00
|
|
|
-> Document -- ^ @GraphQL@ Document.
|
2019-07-25 07:37:36 +02:00
|
|
|
-> m Aeson.Value
|
2020-05-21 10:20:59 +02:00
|
|
|
executeWithName schema operationName = document schema (Just operationName)
|
2017-01-29 16:53:15 +01:00
|
|
|
|
2020-05-14 09:17:14 +02:00
|
|
|
getOperation
|
|
|
|
:: Maybe Text
|
2020-05-21 10:20:59 +02:00
|
|
|
-> Transform.Document
|
|
|
|
-> Either QueryError Transform.OperationDefinition
|
|
|
|
getOperation Nothing (Transform.Document (operation' :| []) _) = pure operation'
|
2020-05-14 09:17:14 +02:00
|
|
|
getOperation Nothing _ = Left OperationNameRequired
|
2020-05-21 10:20:59 +02:00
|
|
|
getOperation (Just operationName) (Transform.Document operations _)
|
|
|
|
| Just operation' <- find matchingName operations = pure operation'
|
2020-05-14 09:17:14 +02:00
|
|
|
| otherwise = Left $ OperationNotFound operationName
|
|
|
|
where
|
2020-05-21 10:20:59 +02:00
|
|
|
matchingName (Transform.OperationDefinition _ name _ _ _) =
|
|
|
|
name == Just operationName
|
|
|
|
|
|
|
|
lookupInputType
|
|
|
|
:: Type
|
|
|
|
-> HashMap.HashMap Name (Definition.TypeDefinition m)
|
|
|
|
-> Maybe Definition.InputType
|
|
|
|
lookupInputType (TypeNamed name) types =
|
|
|
|
case HashMap.lookup name types of
|
|
|
|
Just (Definition.ScalarTypeDefinition scalarType) ->
|
|
|
|
Just $ Definition.ScalarInputType scalarType
|
|
|
|
Just (Definition.EnumTypeDefinition enumType) ->
|
|
|
|
Just $ Definition.EnumInputType enumType
|
|
|
|
Just (Definition.InputObjectTypeDefinition objectType) ->
|
|
|
|
Just $ Definition.ObjectInputType objectType
|
|
|
|
_ -> Nothing
|
|
|
|
lookupInputType (TypeList list) types
|
|
|
|
= Definition.ListInputType
|
|
|
|
<$> lookupInputType list types
|
|
|
|
lookupInputType (TypeNonNull (NonNullTypeNamed nonNull)) types =
|
|
|
|
case HashMap.lookup nonNull types of
|
|
|
|
Just (Definition.ScalarTypeDefinition scalarType) ->
|
|
|
|
Just $ Definition.NonNullScalarInputType scalarType
|
|
|
|
Just (Definition.EnumTypeDefinition enumType) ->
|
|
|
|
Just $ Definition.NonNullEnumInputType enumType
|
|
|
|
Just (Definition.InputObjectTypeDefinition objectType) ->
|
|
|
|
Just $ Definition.NonNullObjectInputType objectType
|
|
|
|
_ -> Nothing
|
|
|
|
lookupInputType (TypeNonNull (NonNullTypeList nonNull)) types
|
|
|
|
= Definition.NonNullListInputType
|
|
|
|
<$> lookupInputType nonNull types
|
|
|
|
|
|
|
|
coerceVariableValues :: (Monad m, VariableValue a)
|
|
|
|
=> Schema m
|
|
|
|
-> Transform.OperationDefinition
|
|
|
|
-> HashMap.HashMap Name a
|
|
|
|
-> Either QueryError Schema.Subs
|
|
|
|
coerceVariableValues schema (Transform.OperationDefinition _ _ variables _ _) values =
|
|
|
|
let referencedTypes = collectReferencedTypes schema
|
|
|
|
in maybe (Left CoercionError) Right
|
|
|
|
$ foldr (coerceValue referencedTypes) (Just HashMap.empty) variables
|
|
|
|
where
|
|
|
|
coerceValue referencedTypes variableDefinition coercedValues = do
|
|
|
|
let VariableDefinition variableName variableTypeName _defaultValue =
|
|
|
|
variableDefinition
|
|
|
|
variableType <- lookupInputType variableTypeName referencedTypes
|
|
|
|
value <- HashMap.lookup variableName values
|
|
|
|
coercedValue <- coerceVariableValue variableType value
|
|
|
|
HashMap.insert variableName coercedValue <$> coercedValues
|
2020-05-14 09:17:14 +02:00
|
|
|
|
2020-05-21 10:20:59 +02:00
|
|
|
executeRequest :: (Monad m, VariableValue a)
|
2020-05-14 09:17:14 +02:00
|
|
|
=> Schema m
|
2019-08-30 07:26:04 +02:00
|
|
|
-> Maybe Text
|
2020-05-21 10:20:59 +02:00
|
|
|
-> HashMap.HashMap Name a
|
|
|
|
-> Transform.Document
|
|
|
|
-> Either QueryError (Transform.OperationDefinition, Schema.Subs)
|
|
|
|
executeRequest schema operationName subs document' = do
|
|
|
|
operation' <- getOperation operationName document'
|
|
|
|
coercedValues <- coerceVariableValues schema operation' subs
|
|
|
|
pure (operation', coercedValues)
|
|
|
|
|
|
|
|
document :: (Monad m, VariableValue a)
|
|
|
|
=> Schema m
|
|
|
|
-> Maybe Text
|
|
|
|
-> HashMap.HashMap Name a
|
|
|
|
-> Document
|
2019-08-30 07:26:04 +02:00
|
|
|
-> m Aeson.Value
|
2020-05-21 10:20:59 +02:00
|
|
|
document schema operationName subs document' =
|
|
|
|
case Transform.document document' of
|
|
|
|
Just transformed -> executeRequest' transformed
|
|
|
|
Nothing -> pure $ singleError
|
|
|
|
"The document doesn't contain any executable operations."
|
|
|
|
where
|
|
|
|
transformOperation fragmentTable operation' subs' =
|
|
|
|
case Transform.operation fragmentTable subs' operation' of
|
|
|
|
Just operationResult -> operation schema operationResult
|
|
|
|
Nothing -> pure $ singleError "Schema transformation error."
|
|
|
|
executeRequest' transformed@(Transform.Document _ fragmentTable) =
|
|
|
|
case executeRequest schema operationName subs transformed of
|
|
|
|
Right (operation', subs') -> transformOperation fragmentTable operation' subs'
|
|
|
|
Left error' -> pure $ singleError $ queryError error'
|
2017-01-29 16:53:15 +01:00
|
|
|
|
2020-02-01 20:46:35 +01:00
|
|
|
operation :: Monad m
|
2020-05-14 09:17:14 +02:00
|
|
|
=> Schema m
|
2019-08-30 07:26:04 +02:00
|
|
|
-> AST.Core.Operation
|
|
|
|
-> m Aeson.Value
|
2020-05-14 09:17:14 +02:00
|
|
|
operation = schemaOperation
|
2020-05-10 18:32:58 +02:00
|
|
|
where
|
2020-05-14 09:17:14 +02:00
|
|
|
resolve queryFields = runCollectErrs
|
|
|
|
. flip Schema.resolve queryFields
|
2020-05-21 10:20:59 +02:00
|
|
|
. fmap getResolver
|
|
|
|
. Definition.fields
|
2020-05-10 18:32:58 +02:00
|
|
|
lookupError = pure
|
|
|
|
$ singleError "Root operation type couldn't be found in the schema."
|
2020-05-14 09:17:14 +02:00
|
|
|
schemaOperation Schema {query} (AST.Core.Query _ fields') =
|
|
|
|
resolve fields' query
|
|
|
|
schemaOperation Schema {mutation = Just mutation} (AST.Core.Mutation _ fields') =
|
|
|
|
resolve fields' mutation
|
|
|
|
schemaOperation Schema {mutation = Nothing} (AST.Core.Mutation _ _) =
|
|
|
|
lookupError
|
2020-05-21 10:20:59 +02:00
|
|
|
getResolver (Definition.Field _ _ _ resolver) = resolver
|