Reject variables as default values

2020-05-22 10:11:48 +02:00 · 2020-05-22 10:11:48 +02:00 · 26cc53ce06
commit 26cc53ce06
parent c3ecfece03
10 changed files with 374 additions and 210 deletions
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -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
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@ -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)
+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
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@ -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

--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@ -410,25 +410,31 @@ value = Variable <$> variable
    <|> String <$> blockString
    <|> String <$> string
    <|> Enum <$> try enumValue
-    <|> List     <$> listValue
-    <|> Object   <$> objectValue
+    <|> List <$> brackets (some value)
+    <|> Object <$> braces (some $ objectField value)
    <?> "value error!"
-  where
-    booleanValue :: Parser Bool
-    booleanValue = True  <$ symbol "true"
+
+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 = True  <$ symbol "true"
    <|> False <$ symbol "false"

-    listValue :: Parser [Value]
-    listValue = brackets $ some value
-
-    objectValue :: Parser [ObjectField]
-    objectValue = braces $ some objectField
-
 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

--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@ -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
--- a/src/Language/GraphQL/Execute/Coerce.hs
+++ b/src/Language/GraphQL/Execute/Coerce.hs
@ -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
--- a/src/Language/GraphQL/Execute/Transform.hs
+++ b/src/Language/GraphQL/Execute/Transform.hs
@ -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'
--- a/src/Language/GraphQL/Type/Definition.hs
+++ b/src/Language/GraphQL/Type/Definition.hs
@ -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)
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@ -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)

@ -142,3 +142,10 @@ spec = describe "Parser" $ do
              isHiddenLocally: Boolean
            }
        |]
+
+    it "rejects variables in DefaultValue" $
+        parse document "" `shouldFailOn` [r|
+            query ($book: String = "Zarathustra", $author: String = $book) {
+              title
+            }
+        |]
--- a/tests/Language/GraphQL/Execute/CoerceSpec.hs
+++ b/tests/Language/GraphQL/Execute/CoerceSpec.hs
@ -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