Reject variables as default values

This commit is contained in:
Eugen Wissner 2020-05-22 10:11:48 +02:00
parent c3ecfece03
commit 26cc53ce06
10 changed files with 374 additions and 210 deletions

View File

@ -7,14 +7,17 @@ and this project adheres to
[Haskell Package Versioning Policy](https://pvp.haskell.org/). [Haskell Package Versioning Policy](https://pvp.haskell.org/).
## [Unreleased] ## [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 ### Changed
- `Resolver` is now `Resolver Name FieldResolver` where `FieldResolver` can - `Resolver` is now `Resolver Name FieldResolver` where `FieldResolver` can
contain a JSON value or another resolver, which is invoked during the contain a JSON value or another resolver, which is invoked during the
execution. `FieldResolver` is executed in `ActionT` and the current `Field` is execution. `FieldResolver` is executed in `ActionT` and the current `Field` is
passed in the reader and not as an explicit argument. 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.operation` has the prior responsibility of
`Execute.Transform.document`, but transforms only the chosen operation and not `Execute.Transform.document`, but transforms only the chosen operation and not
the whole document. `Execute.Transform.document` translates the whole document. `Execute.Transform.document` translates

View File

@ -8,6 +8,7 @@ module Language.GraphQL.AST.Document
( Alias ( Alias
, Argument(..) , Argument(..)
, ArgumentsDefinition(..) , ArgumentsDefinition(..)
, ConstValue(..)
, Definition(..) , Definition(..)
, Description(..) , Description(..)
, Directive(..) , Directive(..)
@ -197,7 +198,7 @@ type TypeCondition = Name
-- ** Input Values -- ** Input Values
-- | Input value. -- | Input value (literal or variable).
data Value data Value
= Variable Name = Variable Name
| Int Int32 | Int Int32
@ -207,18 +208,46 @@ data Value
| Null | Null
| Enum Name | Enum Name
| List [Value] | 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) deriving (Eq, Show)
-- | Key-value pair. -- | Key-value pair.
-- --
-- A list of 'ObjectField's represents a GraphQL object type. -- A list of 'ObjectField's represents a GraphQL object type.
data ObjectField = ObjectField Name Value deriving (Eq, Show) data ObjectField a = ObjectField Name a
deriving (Eq, Show)
-- ** Variables -- ** Variables
-- | Variable definition. -- | 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) deriving (Eq, Show)
-- ** Type References -- ** Type References
@ -445,7 +474,7 @@ instance Monoid ArgumentsDefinition where
-- --
-- The input type "Point2D" contains two value definitions: "x" and "y". -- The input type "Point2D" contains two value definitions: "x" and "y".
data InputValueDefinition data InputValueDefinition
= InputValueDefinition Description Name Type (Maybe Value) [Directive] = InputValueDefinition Description Name Type (Maybe ConstValue) [Directive]
deriving (Eq, Show) deriving (Eq, Show)
-- ** Unions -- ** Unions

View File

@ -24,7 +24,6 @@ import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as Builder import qualified Data.Text.Lazy.Builder as Builder
import Data.Text.Lazy.Builder.Int (decimal, hexadecimal) import Data.Text.Lazy.Builder.Int (decimal, hexadecimal)
import Data.Text.Lazy.Builder.RealFloat (realFloat) import Data.Text.Lazy.Builder.RealFloat (realFloat)
import qualified Language.GraphQL.AST as Full
import Language.GraphQL.AST.Document import Language.GraphQL.AST.Document
-- | Instructs the encoder whether the GraphQL document should be minified or -- | 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 (ExecutableDefinition x) acc = definition formatter x : acc
executableDefinition _ acc = 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 -> ExecutableDefinition -> Lazy.Text
definition formatter x definition formatter x
| Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n' | Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
| Minified <- formatter = encodeDefinition x | Minified <- formatter = encodeDefinition x
where where
encodeDefinition (Full.DefinitionOperation operation) encodeDefinition (DefinitionOperation operation)
= operationDefinition formatter operation = operationDefinition formatter operation
encodeDefinition (Full.DefinitionFragment fragment) encodeDefinition (DefinitionFragment fragment)
= fragmentDefinition formatter fragment = fragmentDefinition formatter fragment
-- | Converts a 'Full.OperationDefinition into a string. -- | Converts a 'OperationDefinition into a string.
operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text operationDefinition :: Formatter -> OperationDefinition -> Lazy.Text
operationDefinition formatter (Full.SelectionSet sels) operationDefinition formatter (SelectionSet sels)
= selectionSet formatter 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 = "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 = "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 -> node :: Formatter ->
Maybe Full.Name -> Maybe Name ->
[Full.VariableDefinition] -> [VariableDefinition] ->
[Full.Directive] -> [Directive] ->
Full.SelectionSet -> SelectionSet ->
Lazy.Text Lazy.Text
node formatter name vars dirs sels node formatter name vars dirs sels
= Lazy.Text.fromStrict (fold name) = Lazy.Text.fromStrict (fold name)
@ -87,31 +86,31 @@ node formatter name vars dirs sels
<> eitherFormat formatter " " mempty <> eitherFormat formatter " " mempty
<> selectionSet formatter sels <> selectionSet formatter sels
variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Lazy.Text variableDefinitions :: Formatter -> [VariableDefinition] -> Lazy.Text
variableDefinitions formatter variableDefinitions formatter
= parensCommas formatter $ variableDefinition formatter = parensCommas formatter $ variableDefinition formatter
variableDefinition :: Formatter -> Full.VariableDefinition -> Lazy.Text variableDefinition :: Formatter -> VariableDefinition -> Lazy.Text
variableDefinition formatter (Full.VariableDefinition var ty dv) variableDefinition formatter (VariableDefinition var ty defaultValue')
= variable var = variable var
<> eitherFormat formatter ": " ":" <> eitherFormat formatter ": " ":"
<> type' ty <> 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 defaultValue formatter val
= eitherFormat formatter " = " "=" = eitherFormat formatter " = " "="
<> value formatter val <> value formatter (fromConstValue val)
variable :: Full.Name -> Lazy.Text variable :: Name -> Lazy.Text
variable var = "$" <> Lazy.Text.fromStrict var variable var = "$" <> Lazy.Text.fromStrict var
selectionSet :: Formatter -> Full.SelectionSet -> Lazy.Text selectionSet :: Formatter -> SelectionSet -> Lazy.Text
selectionSet formatter selectionSet formatter
= bracesList formatter (selection formatter) = bracesList formatter (selection formatter)
. NonEmpty.toList . NonEmpty.toList
selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text selectionSetOpt :: Formatter -> SelectionSetOpt -> Lazy.Text
selectionSetOpt formatter = bracesList formatter $ selection formatter selectionSetOpt formatter = bracesList formatter $ selection formatter
indentSymbol :: Lazy.Text indentSymbol :: Lazy.Text
@ -120,14 +119,14 @@ indentSymbol = " "
indent :: (Integral a) => a -> Lazy.Text indent :: (Integral a) => a -> Lazy.Text
indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol 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 selection formatter = Lazy.Text.append indent' . encodeSelection
where where
encodeSelection (Full.Field alias name args directives' selections) = encodeSelection (Field alias name args directives' selections) =
field incrementIndent 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 inlineFragment incrementIndent typeCondition directives' selections
encodeSelection (Full.FragmentSpread name directives') = encodeSelection (FragmentSpread name directives') =
fragmentSpread incrementIndent name directives' fragmentSpread incrementIndent name directives'
incrementIndent incrementIndent
| Pretty indentation <- formatter = Pretty $ indentation + 1 | Pretty indentation <- formatter = Pretty $ indentation + 1
@ -139,13 +138,13 @@ selection formatter = Lazy.Text.append indent' . encodeSelection
colon :: Formatter -> Lazy.Text colon :: Formatter -> Lazy.Text
colon formatter = eitherFormat formatter ": " ":" colon formatter = eitherFormat formatter ": " ":"
-- | Converts Full.Field into a string -- | Converts Field into a string
field :: Formatter -> field :: Formatter ->
Maybe Full.Name -> Maybe Name ->
Full.Name -> Name ->
[Full.Argument] -> [Argument] ->
[Full.Directive] -> [Directive] ->
[Full.Selection] -> [Selection] ->
Lazy.Text Lazy.Text
field formatter alias name args dirs set field formatter alias name args dirs set
= optempty prependAlias (fold alias) = optempty prependAlias (fold alias)
@ -158,27 +157,27 @@ field formatter alias name args dirs set
selectionSetOpt' = (eitherFormat formatter " " "" <>) selectionSetOpt' = (eitherFormat formatter " " "" <>)
. selectionSetOpt formatter . selectionSetOpt formatter
arguments :: Formatter -> [Full.Argument] -> Lazy.Text arguments :: Formatter -> [Argument] -> Lazy.Text
arguments formatter = parensCommas formatter $ argument formatter arguments formatter = parensCommas formatter $ argument formatter
argument :: Formatter -> Full.Argument -> Lazy.Text argument :: Formatter -> Argument -> Lazy.Text
argument formatter (Full.Argument name value') argument formatter (Argument name value')
= Lazy.Text.fromStrict name = Lazy.Text.fromStrict name
<> colon formatter <> colon formatter
<> value formatter value' <> value formatter value'
-- * Fragments -- * Fragments
fragmentSpread :: Formatter -> Full.Name -> [Full.Directive] -> Lazy.Text fragmentSpread :: Formatter -> Name -> [Directive] -> Lazy.Text
fragmentSpread formatter name directives' fragmentSpread formatter name directives'
= "..." <> Lazy.Text.fromStrict name = "..." <> Lazy.Text.fromStrict name
<> optempty (directives formatter) directives' <> optempty (directives formatter) directives'
inlineFragment :: inlineFragment ::
Formatter -> Formatter ->
Maybe Full.TypeCondition -> Maybe TypeCondition ->
[Full.Directive] -> [Directive] ->
Full.SelectionSet -> SelectionSet ->
Lazy.Text Lazy.Text
inlineFragment formatter tc dirs sels = "... on " inlineFragment formatter tc dirs sels = "... on "
<> Lazy.Text.fromStrict (fold tc) <> Lazy.Text.fromStrict (fold tc)
@ -186,8 +185,8 @@ inlineFragment formatter tc dirs sels = "... on "
<> eitherFormat formatter " " mempty <> eitherFormat formatter " " mempty
<> selectionSet formatter sels <> selectionSet formatter sels
fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Lazy.Text fragmentDefinition :: Formatter -> FragmentDefinition -> Lazy.Text
fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels) fragmentDefinition formatter (FragmentDefinition name tc dirs sels)
= "fragment " <> Lazy.Text.fromStrict name = "fragment " <> Lazy.Text.fromStrict name
<> " on " <> Lazy.Text.fromStrict tc <> " on " <> Lazy.Text.fromStrict tc
<> optempty (directives formatter) dirs <> optempty (directives formatter) dirs
@ -196,26 +195,39 @@ fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
-- * Miscellaneous -- * Miscellaneous
-- | Converts a 'Full.Directive' into a string. -- | Converts a 'Directive' into a string.
directive :: Formatter -> Full.Directive -> Lazy.Text directive :: Formatter -> Directive -> Lazy.Text
directive formatter (Full.Directive name args) directive formatter (Directive name args)
= "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) 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 Minified = spaces (directive Minified)
directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter) directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter)
-- | Converts a 'Full.Value' into a string. -- | Converts a 'Value' into a string.
value :: Formatter -> Full.Value -> Lazy.Text value :: Formatter -> Value -> Lazy.Text
value _ (Full.Variable x) = variable x value _ (Variable x) = variable x
value _ (Full.Int x) = Builder.toLazyText $ decimal x value _ (Int x) = Builder.toLazyText $ decimal x
value _ (Full.Float x) = Builder.toLazyText $ realFloat x value _ (Float x) = Builder.toLazyText $ realFloat x
value _ (Full.Boolean x) = booleanValue x value _ (Boolean x) = booleanValue x
value _ Full.Null = "null" value _ Null = "null"
value formatter (Full.String string) = stringValue formatter string value formatter (String string) = stringValue formatter string
value _ (Full.Enum x) = Lazy.Text.fromStrict x value _ (Enum x) = Lazy.Text.fromStrict x
value formatter (Full.List x) = listValue formatter x value formatter (List x) = listValue formatter x
value formatter (Full.Object x) = objectValue 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 :: Bool -> Lazy.Text
booleanValue True = "true" booleanValue True = "true"
@ -271,10 +283,10 @@ escape char'
where where
unicode prefix = mappend (Builder.fromString prefix) . (hexadecimal . ord) 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 listValue formatter = bracketsCommas formatter $ value formatter
objectValue :: Formatter -> [Full.ObjectField] -> Lazy.Text objectValue :: Formatter -> [ObjectField Value] -> Lazy.Text
objectValue formatter = intercalate $ objectField formatter objectValue formatter = intercalate $ objectField formatter
where where
intercalate f intercalate f
@ -282,22 +294,22 @@ objectValue formatter = intercalate $ objectField formatter
. Lazy.Text.intercalate (eitherFormat formatter ", " ",") . Lazy.Text.intercalate (eitherFormat formatter ", " ",")
. fmap f . fmap f
objectField :: Formatter -> Full.ObjectField -> Lazy.Text objectField :: Formatter -> ObjectField Value -> Lazy.Text
objectField formatter (Full.ObjectField name value') = objectField formatter (ObjectField name value') =
Lazy.Text.fromStrict name <> colon formatter <> value formatter value' Lazy.Text.fromStrict name <> colon formatter <> value formatter value'
-- | Converts a 'Full.Type' a type into a string. -- | Converts a 'Type' a type into a string.
type' :: Full.Type -> Lazy.Text type' :: Type -> Lazy.Text
type' (Full.TypeNamed x) = Lazy.Text.fromStrict x type' (TypeNamed x) = Lazy.Text.fromStrict x
type' (Full.TypeList x) = listType x type' (TypeList x) = listType x
type' (Full.TypeNonNull x) = nonNullType x type' (TypeNonNull x) = nonNullType x
listType :: Full.Type -> Lazy.Text listType :: Type -> Lazy.Text
listType x = brackets (type' x) listType x = brackets (type' x)
nonNullType :: Full.NonNullType -> Lazy.Text nonNullType :: NonNullType -> Lazy.Text
nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!" nonNullType (NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
nonNullType (Full.NonNullTypeList x) = listType x <> "!" nonNullType (NonNullTypeList x) = listType x <> "!"
-- * Internal -- * Internal

View File

@ -410,25 +410,31 @@ value = Variable <$> variable
<|> String <$> blockString <|> String <$> blockString
<|> String <$> string <|> String <$> string
<|> Enum <$> try enumValue <|> Enum <$> try enumValue
<|> List <$> listValue <|> List <$> brackets (some value)
<|> Object <$> objectValue <|> Object <$> braces (some $ objectField value)
<?> "value error!" <?> "value error!"
where
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!"
booleanValue :: Parser Bool booleanValue :: Parser Bool
booleanValue = True <$ symbol "true" booleanValue = True <$ symbol "true"
<|> False <$ symbol "false" <|> False <$ symbol "false"
listValue :: Parser [Value]
listValue = brackets $ some value
objectValue :: Parser [ObjectField]
objectValue = braces $ some objectField
enumValue :: Parser Name enumValue :: Parser Name
enumValue = but (symbol "true") *> but (symbol "false") *> but (symbol "null") *> name enumValue = but (symbol "true") *> but (symbol "false") *> but (symbol "null") *> name
objectField :: Parser ObjectField objectField :: Parser a -> Parser (ObjectField a)
objectField = ObjectField <$> name <* colon <*> value objectField valueParser = ObjectField <$> name <* colon <*> valueParser
-- * Variables -- * Variables
@ -446,8 +452,8 @@ variableDefinition = VariableDefinition
variable :: Parser Name variable :: Parser Name
variable = dollar *> name variable = dollar *> name
defaultValue :: Parser (Maybe Value) defaultValue :: Parser (Maybe ConstValue)
defaultValue = optional (equals *> value) <?> "DefaultValue" defaultValue = optional (equals *> constValue) <?> "DefaultValue"
-- * Input Types -- * Input Types

View File

@ -8,11 +8,8 @@ module Language.GraphQL.Execute
) where ) where
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import Data.Foldable (find)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text
import Language.GraphQL.AST.Document import Language.GraphQL.AST.Document
import qualified Language.GraphQL.AST.Core as AST.Core import qualified Language.GraphQL.AST.Core as AST.Core
import Language.GraphQL.Execute.Coerce 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 qualified Language.GraphQL.Type.Definition as Definition
import Language.GraphQL.Type.Schema 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 -- | The substitution is applied to the document, and the resolvers are applied
-- to the resulting fields. -- to the resulting fields.
-- --
@ -60,77 +45,6 @@ executeWithName :: (Monad m, VariableValue a)
-> m Aeson.Value -> m Aeson.Value
executeWithName schema operationName = document schema (Just operationName) 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) document :: (Monad m, VariableValue a)
=> Schema m => Schema m
-> Maybe Text -> Maybe Text
@ -138,19 +52,9 @@ document :: (Monad m, VariableValue a)
-> Document -> Document
-> m Aeson.Value -> m Aeson.Value
document schema operationName subs document' = document schema operationName subs document' =
case Transform.document document' of case Transform.document schema operationName subs document' of
Just transformed -> executeRequest' transformed Left queryError -> pure $ singleError $ Transform.queryError queryError
Nothing -> pure $ singleError Right (Transform.Document op _) -> operation schema op
"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'
operation :: Monad m operation :: Monad m
=> Schema m => Schema m

View File

@ -3,12 +3,19 @@
-- | Types and functions used for input and result coercion. -- | Types and functions used for input and result coercion.
module Language.GraphQL.Execute.Coerce module Language.GraphQL.Execute.Coerce
( VariableValue(..) ( VariableValue(..)
, coerceInputLiterals
) where ) where
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as 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 Data.Scientific (toBoundedInteger, toRealFloat)
import Language.GraphQL.AST.Core import Language.GraphQL.AST.Core
import Language.GraphQL.Schema
import Language.GraphQL.Type.Definition import Language.GraphQL.Type.Definition
-- | Since variables are passed separately from the query, in an independent -- | Since variables are passed separately from the query, in an independent
@ -82,3 +89,68 @@ instance VariableValue Aeson.Value where
coerced <- coerceVariableValue listType variableValue coerced <- coerceVariableValue listType variableValue
pure $ coerced : list pure $ coerced : list
coerceVariableValue _ _ = Nothing 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

View File

@ -1,5 +1,6 @@
{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
-- | After the document is parsed, before getting executed the AST is -- | After the document is parsed, before getting executed the AST is
@ -7,24 +8,30 @@
-- this transformation. -- this transformation.
module Language.GraphQL.Execute.Transform module Language.GraphQL.Execute.Transform
( Document(..) ( Document(..)
, OperationDefinition(..) , QueryError(..)
, document , document
, operation , queryError
) where ) where
import Control.Monad (foldM, unless) import Control.Monad (foldM, unless)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT) import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT)
import Control.Monad.Trans.State (StateT, evalStateT, gets, modify) import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
import Data.Foldable (find)
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as 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 qualified Data.List.NonEmpty as NonEmpty
import Data.Sequence (Seq, (<|), (><)) 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 as Full
import qualified Language.GraphQL.AST.Core as Core import qualified Language.GraphQL.AST.Core as Core
import Language.GraphQL.Execute.Coerce
import qualified Language.GraphQL.Schema as Schema import qualified Language.GraphQL.Schema as Schema
import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.Directive as Directive import qualified Language.GraphQL.Type.Directive as Directive
import Language.GraphQL.Type.Schema
-- | Associates a fragment name with a list of 'Core.Field's. -- | Associates a fragment name with a list of 'Core.Field's.
data Replacement = Replacement data Replacement = Replacement
@ -39,7 +46,7 @@ liftJust = lift . lift . Just
-- | GraphQL document is a non-empty list of operations. -- | GraphQL document is a non-empty list of operations.
data Document = Document data Document = Document
(NonEmpty OperationDefinition) Core.Operation
(HashMap Full.Name Full.FragmentDefinition) (HashMap Full.Name Full.FragmentDefinition)
data OperationDefinition = OperationDefinition data OperationDefinition = OperationDefinition
@ -49,12 +56,102 @@ data OperationDefinition = OperationDefinition
[Full.Directive] [Full.Directive]
Full.SelectionSet 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 -- | Rewrites the original syntax tree into an intermediate representation used
-- for query execution. -- for query execution.
document :: Full.Document -> Maybe Document document :: (Monad m, VariableValue a)
document ast = => 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 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 where
defragment definition (operations, fragments') defragment definition (operations, fragments')
| (Full.ExecutableDefinition executable) <- definition | (Full.ExecutableDefinition executable) <- definition
@ -186,5 +283,5 @@ value (Full.List l) =
value (Full.Object o) = value (Full.Object o) =
Core.Object . HashMap.fromList <$> traverse objectField 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' objectField (Full.ObjectField name value') = (name,) <$> value value'

View File

@ -193,18 +193,22 @@ pattern ListInputTypeDefinition listType <-
, ScalarInputTypeDefinition , ScalarInputTypeDefinition
#-} #-}
-- | Matches either 'ScalarOutputType' or 'NonNullScalarOutputType'.
pattern ScalarOutputTypeDefinition :: forall m. ScalarType -> OutputType m pattern ScalarOutputTypeDefinition :: forall m. ScalarType -> OutputType m
pattern ScalarOutputTypeDefinition scalarType <- pattern ScalarOutputTypeDefinition scalarType <-
(isScalarOutputType -> Just scalarType) (isScalarOutputType -> Just scalarType)
-- | Matches either 'EnumOutputType' or 'NonNullEnumOutputType'.
pattern EnumOutputTypeDefinition :: forall m. EnumType -> OutputType m pattern EnumOutputTypeDefinition :: forall m. EnumType -> OutputType m
pattern EnumOutputTypeDefinition enumType <- pattern EnumOutputTypeDefinition enumType <-
(isEnumOutputType -> Just enumType) (isEnumOutputType -> Just enumType)
-- | Matches either 'ObjectOutputType' or 'NonNullObjectOutputType'.
pattern ObjectOutputTypeDefinition :: forall m. ObjectType m -> OutputType m pattern ObjectOutputTypeDefinition :: forall m. ObjectType m -> OutputType m
pattern ObjectOutputTypeDefinition objectType <- pattern ObjectOutputTypeDefinition objectType <-
(isObjectOutputType -> Just objectType) (isObjectOutputType -> Just objectType)
-- | Matches either 'ListOutputType' or 'NonNullListOutputType'.
pattern ListOutputTypeDefinition :: forall m. OutputType m -> OutputType m pattern ListOutputTypeDefinition :: forall m. OutputType m -> OutputType m
pattern ListOutputTypeDefinition listType <- pattern ListOutputTypeDefinition listType <-
(isListOutputType -> Just listType) (isListOutputType -> Just listType)

View File

@ -8,7 +8,7 @@ import Data.List.NonEmpty (NonEmpty(..))
import Language.GraphQL.AST.Document import Language.GraphQL.AST.Document
import Language.GraphQL.AST.Parser import Language.GraphQL.AST.Parser
import Test.Hspec (Spec, describe, it) 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.Megaparsec (parse)
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
@ -142,3 +142,10 @@ spec = describe "Parser" $ do
isHiddenLocally: Boolean isHiddenLocally: Boolean
} }
|] |]
it "rejects variables in DefaultValue" $
parse document "" `shouldFailOn` [r|
query ($book: String = "Zarathustra", $author: String = $book) {
title
}
|]

View File

@ -6,15 +6,30 @@ module Language.GraphQL.Execute.CoerceSpec
import Data.Aeson as Aeson ((.=)) import Data.Aeson as Aeson ((.=))
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson import qualified Data.Aeson.Types as Aeson
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (isNothing) import Data.Maybe (isNothing)
import Data.Scientific (scientific) import Data.Scientific (scientific)
import qualified Data.Set as Set
import Language.GraphQL.AST.Core import Language.GraphQL.AST.Core
import Language.GraphQL.Execute.Coerce import Language.GraphQL.Execute.Coerce
import Language.GraphQL.Schema
import Language.GraphQL.Type.Definition import Language.GraphQL.Type.Definition
import Prelude hiding (id) import Prelude hiding (id)
import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) 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 :: InputType
singletonInputObject = ObjectInputType type' singletonInputObject = ObjectInputType type'
where where
@ -23,7 +38,7 @@ singletonInputObject = ObjectInputType type'
field = InputField Nothing (ScalarInputType string) Nothing field = InputField Nothing (ScalarInputType string) Nothing
spec :: Spec spec :: Spec
spec = spec = do
describe "ToGraphQL Aeson" $ do describe "ToGraphQL Aeson" $ do
it "coerces strings" $ it "coerces strings" $
let expected = Just (String "asdf") let expected = Just (String "asdf")
@ -86,3 +101,18 @@ spec =
actual = coerceVariableValue listType list actual = coerceVariableValue listType list
expected = Just $ List [String "asdf", String "qwer"] expected = Just $ List [String "asdf", String "qwer"]
in actual `shouldBe` expected 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