forked from OSS/graphql
Reject variables as default values
This commit is contained in:
parent
c3ecfece03
commit
26cc53ce06
@ -7,14 +7,17 @@ and this project adheres to
|
||||
[Haskell Package Versioning Policy](https://pvp.haskell.org/).
|
||||
|
||||
## [Unreleased]
|
||||
### Fixed
|
||||
- The parser rejects variables when parsing defaultValue (DefaultValue). The
|
||||
specification defines default values as `Value` with `const` parameter and
|
||||
constant cannot be variables. `AST.Document.ConstValue` was added,
|
||||
`AST.Document.ObjectField` was modified.
|
||||
|
||||
### Changed
|
||||
- `Resolver` is now `Resolver Name FieldResolver` where `FieldResolver` can
|
||||
contain a JSON value or another resolver, which is invoked during the
|
||||
execution. `FieldResolver` is executed in `ActionT` and the current `Field` is
|
||||
passed in the reader and not as an explicit argument.
|
||||
- `Execute.Transform.OperationDefinition` is almost the same as
|
||||
`AST.Document.OperationDefinition`. It is used to unify operations in the
|
||||
shorthand form and other operations.
|
||||
- `Execute.Transform.operation` has the prior responsibility of
|
||||
`Execute.Transform.document`, but transforms only the chosen operation and not
|
||||
the whole document. `Execute.Transform.document` translates
|
||||
|
@ -8,6 +8,7 @@ module Language.GraphQL.AST.Document
|
||||
( Alias
|
||||
, Argument(..)
|
||||
, ArgumentsDefinition(..)
|
||||
, ConstValue(..)
|
||||
, Definition(..)
|
||||
, Description(..)
|
||||
, Directive(..)
|
||||
@ -197,7 +198,7 @@ type TypeCondition = Name
|
||||
|
||||
-- ** Input Values
|
||||
|
||||
-- | Input value.
|
||||
-- | Input value (literal or variable).
|
||||
data Value
|
||||
= Variable Name
|
||||
| Int Int32
|
||||
@ -207,18 +208,46 @@ data Value
|
||||
| Null
|
||||
| Enum Name
|
||||
| List [Value]
|
||||
| Object [ObjectField]
|
||||
| Object [ObjectField Value]
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Constant input value.
|
||||
data ConstValue
|
||||
= ConstInt Int32
|
||||
| ConstFloat Double
|
||||
| ConstString Text
|
||||
| ConstBoolean Bool
|
||||
| ConstNull
|
||||
| ConstEnum Name
|
||||
| ConstList [ConstValue]
|
||||
| ConstObject [ObjectField ConstValue]
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Key-value pair.
|
||||
--
|
||||
-- A list of 'ObjectField's represents a GraphQL object type.
|
||||
data ObjectField = ObjectField Name Value deriving (Eq, Show)
|
||||
-- A list of 'ObjectField's represents a GraphQL object type.
|
||||
data ObjectField a = ObjectField Name a
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- ** Variables
|
||||
|
||||
-- | Variable definition.
|
||||
data VariableDefinition = VariableDefinition Name Type (Maybe Value)
|
||||
--
|
||||
-- Each operation can include a list of variables:
|
||||
--
|
||||
-- @
|
||||
-- query (protagonist: String = "Zarathustra") {
|
||||
-- getAuthor(protagonist: $protagonist)
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- This query defines an optional variable @protagonist@ of type @String@,
|
||||
-- its default value is "Zarathustra". If no default value is defined and no
|
||||
-- value is provided, a variable can still be @null@ if its type is nullable.
|
||||
--
|
||||
-- Variables are usually passed along with the query, but not in the query
|
||||
-- itself. They make queries reusable.
|
||||
data VariableDefinition = VariableDefinition Name Type (Maybe ConstValue)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- ** Type References
|
||||
@ -445,7 +474,7 @@ instance Monoid ArgumentsDefinition where
|
||||
--
|
||||
-- The input type "Point2D" contains two value definitions: "x" and "y".
|
||||
data InputValueDefinition
|
||||
= InputValueDefinition Description Name Type (Maybe Value) [Directive]
|
||||
= InputValueDefinition Description Name Type (Maybe ConstValue) [Directive]
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- ** Unions
|
||||
|
@ -24,7 +24,6 @@ import Data.Text.Lazy.Builder (Builder)
|
||||
import qualified Data.Text.Lazy.Builder as Builder
|
||||
import Data.Text.Lazy.Builder.Int (decimal, hexadecimal)
|
||||
import Data.Text.Lazy.Builder.RealFloat (realFloat)
|
||||
import qualified Language.GraphQL.AST as Full
|
||||
import Language.GraphQL.AST.Document
|
||||
|
||||
-- | Instructs the encoder whether the GraphQL document should be minified or
|
||||
@ -53,32 +52,32 @@ document formatter defs
|
||||
executableDefinition (ExecutableDefinition x) acc = definition formatter x : acc
|
||||
executableDefinition _ acc = acc
|
||||
|
||||
-- | Converts a t'Full.ExecutableDefinition' into a string.
|
||||
-- | Converts a t'ExecutableDefinition' into a string.
|
||||
definition :: Formatter -> ExecutableDefinition -> Lazy.Text
|
||||
definition formatter x
|
||||
| Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
|
||||
| Minified <- formatter = encodeDefinition x
|
||||
where
|
||||
encodeDefinition (Full.DefinitionOperation operation)
|
||||
encodeDefinition (DefinitionOperation operation)
|
||||
= operationDefinition formatter operation
|
||||
encodeDefinition (Full.DefinitionFragment fragment)
|
||||
encodeDefinition (DefinitionFragment fragment)
|
||||
= fragmentDefinition formatter fragment
|
||||
|
||||
-- | Converts a 'Full.OperationDefinition into a string.
|
||||
operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text
|
||||
operationDefinition formatter (Full.SelectionSet sels)
|
||||
-- | Converts a 'OperationDefinition into a string.
|
||||
operationDefinition :: Formatter -> OperationDefinition -> Lazy.Text
|
||||
operationDefinition formatter (SelectionSet sels)
|
||||
= selectionSet formatter sels
|
||||
operationDefinition formatter (Full.OperationDefinition Full.Query name vars dirs sels)
|
||||
operationDefinition formatter (OperationDefinition Query name vars dirs sels)
|
||||
= "query " <> node formatter name vars dirs sels
|
||||
operationDefinition formatter (Full.OperationDefinition Full.Mutation name vars dirs sels)
|
||||
operationDefinition formatter (OperationDefinition Mutation name vars dirs sels)
|
||||
= "mutation " <> node formatter name vars dirs sels
|
||||
|
||||
-- | Converts a Full.Query or Full.Mutation into a string.
|
||||
-- | Converts a Query or Mutation into a string.
|
||||
node :: Formatter ->
|
||||
Maybe Full.Name ->
|
||||
[Full.VariableDefinition] ->
|
||||
[Full.Directive] ->
|
||||
Full.SelectionSet ->
|
||||
Maybe Name ->
|
||||
[VariableDefinition] ->
|
||||
[Directive] ->
|
||||
SelectionSet ->
|
||||
Lazy.Text
|
||||
node formatter name vars dirs sels
|
||||
= Lazy.Text.fromStrict (fold name)
|
||||
@ -87,31 +86,31 @@ node formatter name vars dirs sels
|
||||
<> eitherFormat formatter " " mempty
|
||||
<> selectionSet formatter sels
|
||||
|
||||
variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Lazy.Text
|
||||
variableDefinitions :: Formatter -> [VariableDefinition] -> Lazy.Text
|
||||
variableDefinitions formatter
|
||||
= parensCommas formatter $ variableDefinition formatter
|
||||
|
||||
variableDefinition :: Formatter -> Full.VariableDefinition -> Lazy.Text
|
||||
variableDefinition formatter (Full.VariableDefinition var ty dv)
|
||||
variableDefinition :: Formatter -> VariableDefinition -> Lazy.Text
|
||||
variableDefinition formatter (VariableDefinition var ty defaultValue')
|
||||
= variable var
|
||||
<> eitherFormat formatter ": " ":"
|
||||
<> type' ty
|
||||
<> maybe mempty (defaultValue formatter) dv
|
||||
<> maybe mempty (defaultValue formatter) defaultValue'
|
||||
|
||||
defaultValue :: Formatter -> Full.Value -> Lazy.Text
|
||||
defaultValue :: Formatter -> ConstValue -> Lazy.Text
|
||||
defaultValue formatter val
|
||||
= eitherFormat formatter " = " "="
|
||||
<> value formatter val
|
||||
<> value formatter (fromConstValue val)
|
||||
|
||||
variable :: Full.Name -> Lazy.Text
|
||||
variable :: Name -> Lazy.Text
|
||||
variable var = "$" <> Lazy.Text.fromStrict var
|
||||
|
||||
selectionSet :: Formatter -> Full.SelectionSet -> Lazy.Text
|
||||
selectionSet :: Formatter -> SelectionSet -> Lazy.Text
|
||||
selectionSet formatter
|
||||
= bracesList formatter (selection formatter)
|
||||
. NonEmpty.toList
|
||||
|
||||
selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
|
||||
selectionSetOpt :: Formatter -> SelectionSetOpt -> Lazy.Text
|
||||
selectionSetOpt formatter = bracesList formatter $ selection formatter
|
||||
|
||||
indentSymbol :: Lazy.Text
|
||||
@ -120,14 +119,14 @@ indentSymbol = " "
|
||||
indent :: (Integral a) => a -> Lazy.Text
|
||||
indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol
|
||||
|
||||
selection :: Formatter -> Full.Selection -> Lazy.Text
|
||||
selection :: Formatter -> Selection -> Lazy.Text
|
||||
selection formatter = Lazy.Text.append indent' . encodeSelection
|
||||
where
|
||||
encodeSelection (Full.Field alias name args directives' selections) =
|
||||
encodeSelection (Field alias name args directives' selections) =
|
||||
field incrementIndent alias name args directives' selections
|
||||
encodeSelection (Full.InlineFragment typeCondition directives' selections) =
|
||||
encodeSelection (InlineFragment typeCondition directives' selections) =
|
||||
inlineFragment incrementIndent typeCondition directives' selections
|
||||
encodeSelection (Full.FragmentSpread name directives') =
|
||||
encodeSelection (FragmentSpread name directives') =
|
||||
fragmentSpread incrementIndent name directives'
|
||||
incrementIndent
|
||||
| Pretty indentation <- formatter = Pretty $ indentation + 1
|
||||
@ -139,13 +138,13 @@ selection formatter = Lazy.Text.append indent' . encodeSelection
|
||||
colon :: Formatter -> Lazy.Text
|
||||
colon formatter = eitherFormat formatter ": " ":"
|
||||
|
||||
-- | Converts Full.Field into a string
|
||||
-- | Converts Field into a string
|
||||
field :: Formatter ->
|
||||
Maybe Full.Name ->
|
||||
Full.Name ->
|
||||
[Full.Argument] ->
|
||||
[Full.Directive] ->
|
||||
[Full.Selection] ->
|
||||
Maybe Name ->
|
||||
Name ->
|
||||
[Argument] ->
|
||||
[Directive] ->
|
||||
[Selection] ->
|
||||
Lazy.Text
|
||||
field formatter alias name args dirs set
|
||||
= optempty prependAlias (fold alias)
|
||||
@ -158,27 +157,27 @@ field formatter alias name args dirs set
|
||||
selectionSetOpt' = (eitherFormat formatter " " "" <>)
|
||||
. selectionSetOpt formatter
|
||||
|
||||
arguments :: Formatter -> [Full.Argument] -> Lazy.Text
|
||||
arguments :: Formatter -> [Argument] -> Lazy.Text
|
||||
arguments formatter = parensCommas formatter $ argument formatter
|
||||
|
||||
argument :: Formatter -> Full.Argument -> Lazy.Text
|
||||
argument formatter (Full.Argument name value')
|
||||
argument :: Formatter -> Argument -> Lazy.Text
|
||||
argument formatter (Argument name value')
|
||||
= Lazy.Text.fromStrict name
|
||||
<> colon formatter
|
||||
<> value formatter value'
|
||||
|
||||
-- * Fragments
|
||||
|
||||
fragmentSpread :: Formatter -> Full.Name -> [Full.Directive] -> Lazy.Text
|
||||
fragmentSpread :: Formatter -> Name -> [Directive] -> Lazy.Text
|
||||
fragmentSpread formatter name directives'
|
||||
= "..." <> Lazy.Text.fromStrict name
|
||||
<> optempty (directives formatter) directives'
|
||||
|
||||
inlineFragment ::
|
||||
Formatter ->
|
||||
Maybe Full.TypeCondition ->
|
||||
[Full.Directive] ->
|
||||
Full.SelectionSet ->
|
||||
Maybe TypeCondition ->
|
||||
[Directive] ->
|
||||
SelectionSet ->
|
||||
Lazy.Text
|
||||
inlineFragment formatter tc dirs sels = "... on "
|
||||
<> Lazy.Text.fromStrict (fold tc)
|
||||
@ -186,8 +185,8 @@ inlineFragment formatter tc dirs sels = "... on "
|
||||
<> eitherFormat formatter " " mempty
|
||||
<> selectionSet formatter sels
|
||||
|
||||
fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Lazy.Text
|
||||
fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
|
||||
fragmentDefinition :: Formatter -> FragmentDefinition -> Lazy.Text
|
||||
fragmentDefinition formatter (FragmentDefinition name tc dirs sels)
|
||||
= "fragment " <> Lazy.Text.fromStrict name
|
||||
<> " on " <> Lazy.Text.fromStrict tc
|
||||
<> optempty (directives formatter) dirs
|
||||
@ -196,26 +195,39 @@ fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
|
||||
|
||||
-- * Miscellaneous
|
||||
|
||||
-- | Converts a 'Full.Directive' into a string.
|
||||
directive :: Formatter -> Full.Directive -> Lazy.Text
|
||||
directive formatter (Full.Directive name args)
|
||||
-- | Converts a 'Directive' into a string.
|
||||
directive :: Formatter -> Directive -> Lazy.Text
|
||||
directive formatter (Directive name args)
|
||||
= "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args
|
||||
|
||||
directives :: Formatter -> [Full.Directive] -> Lazy.Text
|
||||
directives :: Formatter -> [Directive] -> Lazy.Text
|
||||
directives Minified = spaces (directive Minified)
|
||||
directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter)
|
||||
|
||||
-- | Converts a 'Full.Value' into a string.
|
||||
value :: Formatter -> Full.Value -> Lazy.Text
|
||||
value _ (Full.Variable x) = variable x
|
||||
value _ (Full.Int x) = Builder.toLazyText $ decimal x
|
||||
value _ (Full.Float x) = Builder.toLazyText $ realFloat x
|
||||
value _ (Full.Boolean x) = booleanValue x
|
||||
value _ Full.Null = "null"
|
||||
value formatter (Full.String string) = stringValue formatter string
|
||||
value _ (Full.Enum x) = Lazy.Text.fromStrict x
|
||||
value formatter (Full.List x) = listValue formatter x
|
||||
value formatter (Full.Object x) = objectValue formatter x
|
||||
-- | Converts a 'Value' into a string.
|
||||
value :: Formatter -> Value -> Lazy.Text
|
||||
value _ (Variable x) = variable x
|
||||
value _ (Int x) = Builder.toLazyText $ decimal x
|
||||
value _ (Float x) = Builder.toLazyText $ realFloat x
|
||||
value _ (Boolean x) = booleanValue x
|
||||
value _ Null = "null"
|
||||
value formatter (String string) = stringValue formatter string
|
||||
value _ (Enum x) = Lazy.Text.fromStrict x
|
||||
value formatter (List x) = listValue formatter x
|
||||
value formatter (Object x) = objectValue formatter x
|
||||
|
||||
fromConstValue :: ConstValue -> Value
|
||||
fromConstValue (ConstInt x) = Int x
|
||||
fromConstValue (ConstFloat x) = Float x
|
||||
fromConstValue (ConstBoolean x) = Boolean x
|
||||
fromConstValue ConstNull = Null
|
||||
fromConstValue (ConstString string) = String string
|
||||
fromConstValue (ConstEnum x) = Enum x
|
||||
fromConstValue (ConstList x) = List $ fromConstValue <$> x
|
||||
fromConstValue (ConstObject x) = Object $ fromConstObjectField <$> x
|
||||
where
|
||||
fromConstObjectField (ObjectField key value') =
|
||||
ObjectField key $ fromConstValue value'
|
||||
|
||||
booleanValue :: Bool -> Lazy.Text
|
||||
booleanValue True = "true"
|
||||
@ -271,10 +283,10 @@ escape char'
|
||||
where
|
||||
unicode prefix = mappend (Builder.fromString prefix) . (hexadecimal . ord)
|
||||
|
||||
listValue :: Formatter -> [Full.Value] -> Lazy.Text
|
||||
listValue :: Formatter -> [Value] -> Lazy.Text
|
||||
listValue formatter = bracketsCommas formatter $ value formatter
|
||||
|
||||
objectValue :: Formatter -> [Full.ObjectField] -> Lazy.Text
|
||||
objectValue :: Formatter -> [ObjectField Value] -> Lazy.Text
|
||||
objectValue formatter = intercalate $ objectField formatter
|
||||
where
|
||||
intercalate f
|
||||
@ -282,22 +294,22 @@ objectValue formatter = intercalate $ objectField formatter
|
||||
. Lazy.Text.intercalate (eitherFormat formatter ", " ",")
|
||||
. fmap f
|
||||
|
||||
objectField :: Formatter -> Full.ObjectField -> Lazy.Text
|
||||
objectField formatter (Full.ObjectField name value') =
|
||||
objectField :: Formatter -> ObjectField Value -> Lazy.Text
|
||||
objectField formatter (ObjectField name value') =
|
||||
Lazy.Text.fromStrict name <> colon formatter <> value formatter value'
|
||||
|
||||
-- | Converts a 'Full.Type' a type into a string.
|
||||
type' :: Full.Type -> Lazy.Text
|
||||
type' (Full.TypeNamed x) = Lazy.Text.fromStrict x
|
||||
type' (Full.TypeList x) = listType x
|
||||
type' (Full.TypeNonNull x) = nonNullType x
|
||||
-- | Converts a 'Type' a type into a string.
|
||||
type' :: Type -> Lazy.Text
|
||||
type' (TypeNamed x) = Lazy.Text.fromStrict x
|
||||
type' (TypeList x) = listType x
|
||||
type' (TypeNonNull x) = nonNullType x
|
||||
|
||||
listType :: Full.Type -> Lazy.Text
|
||||
listType :: Type -> Lazy.Text
|
||||
listType x = brackets (type' x)
|
||||
|
||||
nonNullType :: Full.NonNullType -> Lazy.Text
|
||||
nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
|
||||
nonNullType (Full.NonNullTypeList x) = listType x <> "!"
|
||||
nonNullType :: NonNullType -> Lazy.Text
|
||||
nonNullType (NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
|
||||
nonNullType (NonNullTypeList x) = listType x <> "!"
|
||||
|
||||
-- * Internal
|
||||
|
||||
|
@ -403,32 +403,38 @@ typeCondition = symbol "on" *> name
|
||||
|
||||
value :: Parser Value
|
||||
value = Variable <$> variable
|
||||
<|> Float <$> try float
|
||||
<|> Int <$> integer
|
||||
<|> Boolean <$> booleanValue
|
||||
<|> Null <$ symbol "null"
|
||||
<|> String <$> blockString
|
||||
<|> String <$> string
|
||||
<|> Enum <$> try enumValue
|
||||
<|> List <$> listValue
|
||||
<|> Object <$> objectValue
|
||||
<|> Float <$> try float
|
||||
<|> Int <$> integer
|
||||
<|> Boolean <$> booleanValue
|
||||
<|> Null <$ symbol "null"
|
||||
<|> String <$> blockString
|
||||
<|> String <$> string
|
||||
<|> Enum <$> try enumValue
|
||||
<|> List <$> brackets (some value)
|
||||
<|> Object <$> braces (some $ objectField value)
|
||||
<?> "value error!"
|
||||
where
|
||||
booleanValue :: Parser Bool
|
||||
booleanValue = True <$ symbol "true"
|
||||
<|> False <$ symbol "false"
|
||||
|
||||
listValue :: Parser [Value]
|
||||
listValue = brackets $ some value
|
||||
constValue :: Parser ConstValue
|
||||
constValue = ConstFloat <$> try float
|
||||
<|> ConstInt <$> integer
|
||||
<|> ConstBoolean <$> booleanValue
|
||||
<|> ConstNull <$ symbol "null"
|
||||
<|> ConstString <$> blockString
|
||||
<|> ConstString <$> string
|
||||
<|> ConstEnum <$> try enumValue
|
||||
<|> ConstList <$> brackets (some constValue)
|
||||
<|> ConstObject <$> braces (some $ objectField constValue)
|
||||
<?> "value error!"
|
||||
|
||||
objectValue :: Parser [ObjectField]
|
||||
objectValue = braces $ some objectField
|
||||
booleanValue :: Parser Bool
|
||||
booleanValue = True <$ symbol "true"
|
||||
<|> False <$ symbol "false"
|
||||
|
||||
enumValue :: Parser Name
|
||||
enumValue = but (symbol "true") *> but (symbol "false") *> but (symbol "null") *> name
|
||||
|
||||
objectField :: Parser ObjectField
|
||||
objectField = ObjectField <$> name <* colon <*> value
|
||||
objectField :: Parser a -> Parser (ObjectField a)
|
||||
objectField valueParser = ObjectField <$> name <* colon <*> valueParser
|
||||
|
||||
-- * Variables
|
||||
|
||||
@ -446,8 +452,8 @@ variableDefinition = VariableDefinition
|
||||
variable :: Parser Name
|
||||
variable = dollar *> name
|
||||
|
||||
defaultValue :: Parser (Maybe Value)
|
||||
defaultValue = optional (equals *> value) <?> "DefaultValue"
|
||||
defaultValue :: Parser (Maybe ConstValue)
|
||||
defaultValue = optional (equals *> constValue) <?> "DefaultValue"
|
||||
|
||||
-- * Input Types
|
||||
|
||||
|
@ -8,11 +8,8 @@ module Language.GraphQL.Execute
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Foldable (find)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Language.GraphQL.AST.Document
|
||||
import qualified Language.GraphQL.AST.Core as AST.Core
|
||||
import Language.GraphQL.Execute.Coerce
|
||||
@ -22,18 +19,6 @@ import qualified Language.GraphQL.Schema as Schema
|
||||
import qualified Language.GraphQL.Type.Definition as Definition
|
||||
import Language.GraphQL.Type.Schema
|
||||
|
||||
-- | Query error types.
|
||||
data QueryError
|
||||
= OperationNotFound Text
|
||||
| OperationNameRequired
|
||||
| CoercionError
|
||||
|
||||
queryError :: QueryError -> Text
|
||||
queryError (OperationNotFound operationName) = Text.unwords
|
||||
["Operation", operationName, "couldn't be found in the document."]
|
||||
queryError OperationNameRequired = "Missing operation name."
|
||||
queryError CoercionError = "Coercion error."
|
||||
|
||||
-- | The substitution is applied to the document, and the resolvers are applied
|
||||
-- to the resulting fields.
|
||||
--
|
||||
@ -60,77 +45,6 @@ executeWithName :: (Monad m, VariableValue a)
|
||||
-> m Aeson.Value
|
||||
executeWithName schema operationName = document schema (Just operationName)
|
||||
|
||||
getOperation
|
||||
:: Maybe Text
|
||||
-> Transform.Document
|
||||
-> Either QueryError Transform.OperationDefinition
|
||||
getOperation Nothing (Transform.Document (operation' :| []) _) = pure operation'
|
||||
getOperation Nothing _ = Left OperationNameRequired
|
||||
getOperation (Just operationName) (Transform.Document operations _)
|
||||
| Just operation' <- find matchingName operations = pure operation'
|
||||
| otherwise = Left $ OperationNotFound operationName
|
||||
where
|
||||
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
|
||||
|
||||
executeRequest :: (Monad m, VariableValue a)
|
||||
=> Schema m
|
||||
-> Maybe Text
|
||||
-> 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
|
||||
@ -138,19 +52,9 @@ document :: (Monad m, VariableValue a)
|
||||
-> Document
|
||||
-> m Aeson.Value
|
||||
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'
|
||||
case Transform.document schema operationName subs document' of
|
||||
Left queryError -> pure $ singleError $ Transform.queryError queryError
|
||||
Right (Transform.Document op _) -> operation schema op
|
||||
|
||||
operation :: Monad m
|
||||
=> Schema m
|
||||
|
@ -3,12 +3,19 @@
|
||||
-- | Types and functions used for input and result coercion.
|
||||
module Language.GraphQL.Execute.Coerce
|
||||
( VariableValue(..)
|
||||
, coerceInputLiterals
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text.Lazy as Text.Lazy
|
||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
|
||||
import Data.Scientific (toBoundedInteger, toRealFloat)
|
||||
import Language.GraphQL.AST.Core
|
||||
import Language.GraphQL.Schema
|
||||
import Language.GraphQL.Type.Definition
|
||||
|
||||
-- | Since variables are passed separately from the query, in an independent
|
||||
@ -82,3 +89,68 @@ instance VariableValue Aeson.Value where
|
||||
coerced <- coerceVariableValue listType variableValue
|
||||
pure $ coerced : list
|
||||
coerceVariableValue _ _ = Nothing
|
||||
|
||||
-- | Coerces operation arguments according to the input coercion rules for the
|
||||
-- corresponding types.
|
||||
coerceInputLiterals
|
||||
:: HashMap Name InputType
|
||||
-> HashMap Name Value
|
||||
-> Maybe Subs
|
||||
coerceInputLiterals variableTypes variableValues =
|
||||
foldWithKey operator variableTypes
|
||||
where
|
||||
operator variableName variableType resultMap =
|
||||
HashMap.insert variableName
|
||||
<$> (lookupVariable variableName >>= coerceInputLiteral variableType)
|
||||
<*> resultMap
|
||||
coerceInputLiteral (ScalarInputType type') value
|
||||
| (String stringValue) <- value
|
||||
, (ScalarType "String" _) <- type' = Just $ String stringValue
|
||||
| (Boolean booleanValue) <- value
|
||||
, (ScalarType "Boolean" _) <- type' = Just $ Boolean booleanValue
|
||||
| (Int intValue) <- value
|
||||
, (ScalarType "Int" _) <- type' = Just $ Int intValue
|
||||
| (Float floatValue) <- value
|
||||
, (ScalarType "Float" _) <- type' = Just $ Float floatValue
|
||||
| (Int intValue) <- value
|
||||
, (ScalarType "Float" _) <- type' =
|
||||
Just $ Float $ fromIntegral intValue
|
||||
| (String stringValue) <- value
|
||||
, (ScalarType "ID" _) <- type' = Just $ String stringValue
|
||||
| (Int intValue) <- value
|
||||
, (ScalarType "ID" _) <- type' = Just $ decimal intValue
|
||||
coerceInputLiteral (EnumInputType type') (Enum enumValue)
|
||||
| member enumValue type' = Just $ Enum enumValue
|
||||
coerceInputLiteral (ObjectInputType type') (Object _) =
|
||||
let (InputObjectType _ _ inputFields) = type'
|
||||
in Object <$> foldWithKey matchFieldValues inputFields
|
||||
coerceInputLiteral _ _ = Nothing
|
||||
member value (EnumType _ _ members) = Set.member value members
|
||||
matchFieldValues fieldName (InputField _ type' defaultValue) resultMap =
|
||||
case lookupVariable fieldName of
|
||||
Just Null
|
||||
| isNonNullInputType type' -> Nothing
|
||||
| otherwise ->
|
||||
HashMap.insert fieldName Null <$> resultMap
|
||||
Just variableValue -> HashMap.insert fieldName
|
||||
<$> coerceInputLiteral type' variableValue
|
||||
<*> resultMap
|
||||
Nothing
|
||||
| Just value <- defaultValue ->
|
||||
HashMap.insert fieldName value <$> resultMap
|
||||
| Nothing <- defaultValue
|
||||
, isNonNullInputType type' -> Nothing
|
||||
| otherwise -> resultMap
|
||||
lookupVariable = flip HashMap.lookup variableValues
|
||||
foldWithKey f = HashMap.foldrWithKey f (Just HashMap.empty)
|
||||
decimal = String
|
||||
. Text.Lazy.toStrict
|
||||
. Text.Builder.toLazyText
|
||||
. Text.Builder.decimal
|
||||
|
||||
isNonNullInputType :: InputType -> Bool
|
||||
isNonNullInputType (NonNullScalarInputType _) = True
|
||||
isNonNullInputType (NonNullEnumInputType _) = True
|
||||
isNonNullInputType (NonNullObjectInputType _) = True
|
||||
isNonNullInputType (NonNullListInputType _) = True
|
||||
isNonNullInputType _ = False
|
||||
|
@ -1,5 +1,6 @@
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
-- | After the document is parsed, before getting executed the AST is
|
||||
@ -7,24 +8,30 @@
|
||||
-- this transformation.
|
||||
module Language.GraphQL.Execute.Transform
|
||||
( Document(..)
|
||||
, OperationDefinition(..)
|
||||
, QueryError(..)
|
||||
, document
|
||||
, operation
|
||||
, queryError
|
||||
) where
|
||||
|
||||
import Control.Monad (foldM, unless)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT)
|
||||
import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
|
||||
import Data.Foldable (find)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Sequence (Seq, (<|), (><))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Language.GraphQL.AST as Full
|
||||
import qualified Language.GraphQL.AST.Core as Core
|
||||
import Language.GraphQL.Execute.Coerce
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import qualified Language.GraphQL.Type.Definition as Definition
|
||||
import qualified Language.GraphQL.Type.Directive as Directive
|
||||
import Language.GraphQL.Type.Schema
|
||||
|
||||
-- | Associates a fragment name with a list of 'Core.Field's.
|
||||
data Replacement = Replacement
|
||||
@ -39,7 +46,7 @@ liftJust = lift . lift . Just
|
||||
|
||||
-- | GraphQL document is a non-empty list of operations.
|
||||
data Document = Document
|
||||
(NonEmpty OperationDefinition)
|
||||
Core.Operation
|
||||
(HashMap Full.Name Full.FragmentDefinition)
|
||||
|
||||
data OperationDefinition = OperationDefinition
|
||||
@ -49,12 +56,102 @@ data OperationDefinition = OperationDefinition
|
||||
[Full.Directive]
|
||||
Full.SelectionSet
|
||||
|
||||
-- | Query error types.
|
||||
data QueryError
|
||||
= OperationNotFound Text
|
||||
| OperationNameRequired
|
||||
| CoercionError
|
||||
| TransformationError
|
||||
| EmptyDocument
|
||||
|
||||
queryError :: QueryError -> Text
|
||||
queryError (OperationNotFound operationName) = Text.unwords
|
||||
["Operation", operationName, "couldn't be found in the document."]
|
||||
queryError OperationNameRequired = "Missing operation name."
|
||||
queryError CoercionError = "Coercion error."
|
||||
queryError TransformationError = "Schema transformation error."
|
||||
queryError EmptyDocument =
|
||||
"The document doesn't contain any executable operations."
|
||||
|
||||
getOperation
|
||||
:: Maybe Full.Name
|
||||
-> NonEmpty OperationDefinition
|
||||
-> Either QueryError OperationDefinition
|
||||
getOperation Nothing (operation' :| []) = pure operation'
|
||||
getOperation Nothing _ = Left OperationNameRequired
|
||||
getOperation (Just operationName) operations
|
||||
| Just operation' <- find matchingName operations = pure operation'
|
||||
| otherwise = Left $ OperationNotFound operationName
|
||||
where
|
||||
matchingName (OperationDefinition _ name _ _ _) =
|
||||
name == Just operationName
|
||||
|
||||
lookupInputType
|
||||
:: Full.Type
|
||||
-> HashMap.HashMap Full.Name (Definition.TypeDefinition m)
|
||||
-> Maybe Definition.InputType
|
||||
lookupInputType (Full.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 (Full.TypeList list) types
|
||||
= Definition.ListInputType
|
||||
<$> lookupInputType list types
|
||||
lookupInputType (Full.TypeNonNull (Full.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 (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types
|
||||
= Definition.NonNullListInputType
|
||||
<$> lookupInputType nonNull types
|
||||
|
||||
coerceVariableValues :: (Monad m, VariableValue a)
|
||||
=> Schema m
|
||||
-> OperationDefinition
|
||||
-> HashMap.HashMap Full.Name a
|
||||
-> Either QueryError Schema.Subs
|
||||
coerceVariableValues schema (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 Full.VariableDefinition variableName variableTypeName _defaultValue =
|
||||
variableDefinition
|
||||
variableType <- lookupInputType variableTypeName referencedTypes
|
||||
value' <- HashMap.lookup variableName values
|
||||
coercedValue <- coerceVariableValue variableType value'
|
||||
HashMap.insert variableName coercedValue <$> coercedValues
|
||||
|
||||
-- | Rewrites the original syntax tree into an intermediate representation used
|
||||
-- for query execution.
|
||||
document :: Full.Document -> Maybe Document
|
||||
document ast =
|
||||
document :: (Monad m, VariableValue a)
|
||||
=> Schema m
|
||||
-> Maybe Full.Name
|
||||
-> HashMap Full.Name a
|
||||
-> Full.Document
|
||||
-> Either QueryError Document
|
||||
document schema operationName subs ast = do
|
||||
let (operations, fragmentTable) = foldr defragment ([], HashMap.empty) ast
|
||||
in Document <$> NonEmpty.nonEmpty operations <*> pure fragmentTable
|
||||
nonEmptyOperations <- maybe (Left EmptyDocument) Right
|
||||
$ NonEmpty.nonEmpty operations
|
||||
chosenOperation <- getOperation operationName nonEmptyOperations
|
||||
coercedValues <- coerceVariableValues schema chosenOperation subs
|
||||
|
||||
maybe (Left TransformationError) Right
|
||||
$ Document
|
||||
<$> operation fragmentTable coercedValues chosenOperation
|
||||
<*> pure fragmentTable
|
||||
where
|
||||
defragment definition (operations, fragments')
|
||||
| (Full.ExecutableDefinition executable) <- definition
|
||||
@ -186,5 +283,5 @@ value (Full.List l) =
|
||||
value (Full.Object o) =
|
||||
Core.Object . HashMap.fromList <$> traverse objectField o
|
||||
|
||||
objectField :: Full.ObjectField -> TransformT (Core.Name, Core.Value)
|
||||
objectField :: Full.ObjectField Full.Value -> TransformT (Core.Name, Core.Value)
|
||||
objectField (Full.ObjectField name value') = (name,) <$> value value'
|
||||
|
@ -193,18 +193,22 @@ pattern ListInputTypeDefinition listType <-
|
||||
, ScalarInputTypeDefinition
|
||||
#-}
|
||||
|
||||
-- | Matches either 'ScalarOutputType' or 'NonNullScalarOutputType'.
|
||||
pattern ScalarOutputTypeDefinition :: forall m. ScalarType -> OutputType m
|
||||
pattern ScalarOutputTypeDefinition scalarType <-
|
||||
(isScalarOutputType -> Just scalarType)
|
||||
|
||||
-- | Matches either 'EnumOutputType' or 'NonNullEnumOutputType'.
|
||||
pattern EnumOutputTypeDefinition :: forall m. EnumType -> OutputType m
|
||||
pattern EnumOutputTypeDefinition enumType <-
|
||||
(isEnumOutputType -> Just enumType)
|
||||
|
||||
-- | Matches either 'ObjectOutputType' or 'NonNullObjectOutputType'.
|
||||
pattern ObjectOutputTypeDefinition :: forall m. ObjectType m -> OutputType m
|
||||
pattern ObjectOutputTypeDefinition objectType <-
|
||||
(isObjectOutputType -> Just objectType)
|
||||
|
||||
-- | Matches either 'ListOutputType' or 'NonNullListOutputType'.
|
||||
pattern ListOutputTypeDefinition :: forall m. OutputType m -> OutputType m
|
||||
pattern ListOutputTypeDefinition listType <-
|
||||
(isListOutputType -> Just listType)
|
||||
|
@ -8,7 +8,7 @@ import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Language.GraphQL.AST.Document
|
||||
import Language.GraphQL.AST.Parser
|
||||
import Test.Hspec (Spec, describe, it)
|
||||
import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn)
|
||||
import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
|
||||
import Text.Megaparsec (parse)
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
@ -141,4 +141,11 @@ spec = describe "Parser" $ do
|
||||
extend type Story {
|
||||
isHiddenLocally: Boolean
|
||||
}
|
||||
|]
|
||||
|]
|
||||
|
||||
it "rejects variables in DefaultValue" $
|
||||
parse document "" `shouldFailOn` [r|
|
||||
query ($book: String = "Zarathustra", $author: String = $book) {
|
||||
title
|
||||
}
|
||||
|]
|
||||
|
@ -6,15 +6,30 @@ module Language.GraphQL.Execute.CoerceSpec
|
||||
import Data.Aeson as Aeson ((.=))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Data.Aeson.Types as Aeson
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Maybe (isNothing)
|
||||
import Data.Scientific (scientific)
|
||||
import qualified Data.Set as Set
|
||||
import Language.GraphQL.AST.Core
|
||||
import Language.GraphQL.Execute.Coerce
|
||||
import Language.GraphQL.Schema
|
||||
import Language.GraphQL.Type.Definition
|
||||
import Prelude hiding (id)
|
||||
import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
|
||||
|
||||
direction :: EnumType
|
||||
direction = EnumType "Direction" Nothing
|
||||
$ Set.fromList ["NORTH", "EAST", "SOUTH", "WEST"]
|
||||
|
||||
coerceInputLiteral :: InputType -> Value -> Maybe Subs
|
||||
coerceInputLiteral input value = coerceInputLiterals
|
||||
(HashMap.singleton "variableName" input)
|
||||
(HashMap.singleton "variableName" value)
|
||||
|
||||
lookupActual :: Maybe (HashMap Name Value) -> Maybe Value
|
||||
lookupActual = (HashMap.lookup "variableName" =<<)
|
||||
|
||||
singletonInputObject :: InputType
|
||||
singletonInputObject = ObjectInputType type'
|
||||
where
|
||||
@ -23,7 +38,7 @@ singletonInputObject = ObjectInputType type'
|
||||
field = InputField Nothing (ScalarInputType string) Nothing
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
spec = do
|
||||
describe "ToGraphQL Aeson" $ do
|
||||
it "coerces strings" $
|
||||
let expected = Just (String "asdf")
|
||||
@ -86,3 +101,18 @@ spec =
|
||||
actual = coerceVariableValue listType list
|
||||
expected = Just $ List [String "asdf", String "qwer"]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
describe "coerceInputLiterals" $ do
|
||||
it "coerces enums" $
|
||||
let expected = Just (Enum "NORTH")
|
||||
actual = coerceInputLiteral
|
||||
(EnumInputType direction) (Enum "NORTH")
|
||||
in lookupActual actual `shouldBe` expected
|
||||
it "fails with non-existing enum value" $
|
||||
let actual = coerceInputLiteral
|
||||
(EnumInputType direction) (Enum "NORTH_EAST")
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "coerces integers to IDs" $
|
||||
let expected = Just (String "1234")
|
||||
actual = coerceInputLiteral (ScalarInputType id) (Int 1234)
|
||||
in lookupActual actual `shouldBe` expected
|
||||
|
Loading…
Reference in New Issue
Block a user