Coerce argument values properly

Fixes #44.
2020-06-06 21:22:11 +02:00 · 2020-06-06 21:22:11 +02:00 · 4c9264c12c
commit 4c9264c12c
parent 93a0403288
6 changed files with 251 additions and 160 deletions
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -15,6 +15,8 @@ and this project adheres to
 - AST transformation should never fail.
    * Missing variable are assumed to be null.
    * Invalid (recusrive or non-existing) fragments should be skipped.
+- Argument value coercion.
+- Variable value coercion.

 ### Changed
 - `Schema.Resolver` was moved to `Type.Out`, it is a field and resolver function
--- a/src/Language/GraphQL/Execute/Coerce.hs
+++ b/src/Language/GraphQL/Execute/Coerce.hs
@ -1,20 +1,22 @@
+{-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE OverloadedStrings #-}

 -- | Types and functions used for input and result coercion.
 module Language.GraphQL.Execute.Coerce
    ( VariableValue(..)
-    , coerceInputLiterals
+    , coerceInputLiteral
+    , matchFieldValues
    ) 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 qualified Data.Set as Set
 import Data.Scientific (toBoundedInteger, toRealFloat)
-import Language.GraphQL.AST.Document (Name)
+import Language.GraphQL.AST.Core
 import qualified Language.GraphQL.Type.In as In
 import Language.GraphQL.Type.Definition

@ -67,10 +69,10 @@ instance VariableValue Aeson.Value where
                then Just $ Object resultMap
                else Nothing
      where
-        foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues
+        foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues'
            $ Just (objectValue, HashMap.empty)
-        matchFieldValues _ _ Nothing = Nothing
-        matchFieldValues fieldName inputField (Just (objectValue, resultMap)) =
+        matchFieldValues' _ _ Nothing = Nothing
+        matchFieldValues' fieldName inputField (Just (objectValue, resultMap)) =
            let (In.InputField _ fieldType _) = inputField
                insert = flip (HashMap.insert fieldName) resultMap
                newObjectValue = HashMap.delete fieldName objectValue
@ -90,60 +92,67 @@ instance VariableValue Aeson.Value where
            pure $ coerced : list 
    coerceVariableValue _ _ = Nothing

-- | Coerces operation arguments according to the input coercion rules for the
--   corresponding types.
-coerceInputLiterals
-    :: HashMap Name In.Type
-    -> HashMap Name Value
-    -> Maybe Subs
-coerceInputLiterals variableTypes variableValues =
-    foldWithKey operator variableTypes
+-- | Looks up a value by name in the given map, coerces it and inserts into the
+-- result map. If the coercion fails, returns 'Nothing'. If the value isn't
+-- given, but a default value is known, inserts the default value into the
+-- result map. Otherwise it fails with 'Nothing' if the Input Type is a
+-- Non-Nullable type, or returns the unchanged, original map.
+matchFieldValues :: forall a
+    . (In.Type -> a -> Maybe Value)
+    -> HashMap Name a
+    -> Name
+    -> In.Type
+    -> Maybe Value
+    -> Maybe (HashMap Name Value)
+    -> Maybe (HashMap Name Value)
+matchFieldValues coerce values' fieldName type' defaultValue resultMap =
+    case HashMap.lookup fieldName values' of
+        Just variableValue -> coerceRuntimeValue $ coerce type' variableValue
+        Nothing
+            | Just value <- defaultValue ->
+                HashMap.insert fieldName value <$> resultMap
+            | Nothing <- defaultValue
+            , In.isNonNullType type' -> Nothing
+            | otherwise -> resultMap
+  where
+    coerceRuntimeValue (Just Null)
+        | In.isNonNullType type' = Nothing
+    coerceRuntimeValue coercedValue =
+        HashMap.insert fieldName <$> coercedValue <*> resultMap
+
+-- | Coerces operation arguments according to the input coercion rules for the
+-- corresponding types.
+coerceInputLiteral :: In.Type -> Value -> Maybe Value
+coerceInputLiteral (In.ScalarBaseType 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
  where
-    operator variableName variableType resultMap =
-        HashMap.insert variableName
-        <$> (lookupVariable variableName >>= coerceInputLiteral variableType)
-        <*> resultMap
-    coerceInputLiteral (In.NamedScalarType 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 (In.NamedEnumType type') (Enum enumValue)
-        | member enumValue type' = Just $ Enum enumValue
-    coerceInputLiteral (In.NamedInputObjectType type') (Object _) = 
-        let (In.InputObjectType _ _ inputFields) = type'
-            in Object <$> foldWithKey matchFieldValues inputFields
-    coerceInputLiteral _ _ = Nothing
-    member value (EnumType _ _ members) = Set.member value members
-    matchFieldValues fieldName (In.InputField _ type' defaultValue) resultMap =
-        case lookupVariable fieldName of
-            Just Null
-                | In.isNonNullType 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
-                , In.isNonNullType 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
+coerceInputLiteral (In.EnumBaseType type') (Enum enumValue)
+    | member enumValue type' = Just $ Enum enumValue
+  where
+    member value (EnumType _ _ members) = Set.member value members
+coerceInputLiteral (In.InputObjectBaseType type') (Object values) = 
+    let (In.InputObjectType _ _ inputFields) = type'
+        in Object
+            <$> HashMap.foldrWithKey (matchFieldValues' values) (Just HashMap.empty) inputFields
+  where
+    matchFieldValues' values' fieldName (In.InputField _ inputFieldType defaultValue) =
+        matchFieldValues coerceInputLiteral values' fieldName inputFieldType defaultValue
+coerceInputLiteral _ _ = Nothing
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@ -19,17 +19,23 @@ import Data.Sequence (Seq(..))
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Sequence as Seq
-import Language.GraphQL.AST.Document (Name)
+import Language.GraphQL.AST.Core
 import Language.GraphQL.Error
+import Language.GraphQL.Execute.Coerce
 import Language.GraphQL.Execute.Transform
 import Language.GraphQL.Trans
-import Language.GraphQL.Type.Definition
+import qualified Language.GraphQL.Type.Definition as Definition
+import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Type.Schema

-resolveFieldValue :: Monad m => Value -> Field m -> ActionT m a -> m (Either Text a)
-resolveFieldValue result (Field _ _ args _) =
-    flip runReaderT (Context {arguments=args, values=result})
+resolveFieldValue :: Monad m
+    => Definition.Value
+    -> Definition.Subs
+    -> ActionT m a
+    -> m (Either Text a)
+resolveFieldValue result args =
+    flip runReaderT (Context {arguments = Arguments args, values = result})
    . runExceptT
    . runActionT

@ -54,10 +60,10 @@ aliasOrName (Field alias name _ _) = fromMaybe name alias

 resolveAbstractType :: Monad m
    => AbstractType m
-    -> HashMap Name Value
+    -> HashMap Name Definition.Value
    -> CollectErrsT m (Maybe (Out.ObjectType m))
 resolveAbstractType abstractType values'
-    | Just (String typeName) <- HashMap.lookup "__typename" values' = do
+    | Just (Definition.String typeName) <- HashMap.lookup "__typename" values' = do
        types' <- gets types
        case HashMap.lookup typeName types' of
            Just (ObjectType objectType) ->
@ -97,40 +103,44 @@ instanceOf objectType (AbstractUnionType unionType) =
         in acc || this == that

 executeField :: Monad m
-    => Value
+    => Definition.Value
    -> Out.Resolver m
    -> Field m
    -> CollectErrsT m Aeson.Value
 executeField prev (Out.Resolver fieldDefinition resolver) field = do
-    let Out.Field _ fieldType _ = fieldDefinition
-    answer <- lift $ resolveFieldValue prev field resolver
-    case answer of
-        Right result -> completeValue fieldType field result
-        Left errorMessage -> errmsg errorMessage
+    let Out.Field _ fieldType argumentDefinitions = fieldDefinition
+    let Field _ _ arguments' _ = field
+    case coerceArgumentValues argumentDefinitions arguments' of
+        Nothing -> errmsg "Argument coercing failed."
+        Just argumentValues -> do
+            answer <- lift $ resolveFieldValue prev argumentValues resolver
+            case answer of
+                Right result -> completeValue fieldType field result
+                Left errorMessage -> errmsg errorMessage

 completeValue :: Monad m
    => Out.Type m
    -> Field m
-    -> Value
+    -> Definition.Value
    -> CollectErrsT m Aeson.Value
-completeValue _ _ Null = pure Aeson.Null
-completeValue _ _ (Int integer) = pure $ Aeson.toJSON integer
-completeValue _ _ (Boolean boolean') = pure $ Aeson.Bool boolean'
-completeValue _ _ (Float float') = pure $ Aeson.toJSON float'
-completeValue _ _ (Enum enum) = pure $ Aeson.String enum
-completeValue _ _ (String string') = pure $ Aeson.String string'
+completeValue _ _ Definition.Null = pure Aeson.Null
+completeValue _ _ (Definition.Int integer) = pure $ Aeson.toJSON integer
+completeValue _ _ (Definition.Boolean boolean') = pure $ Aeson.Bool boolean'
+completeValue _ _ (Definition.Float float') = pure $ Aeson.toJSON float'
+completeValue _ _ (Definition.Enum enum) = pure $ Aeson.String enum
+completeValue _ _ (Definition.String string') = pure $ Aeson.String string'
 completeValue (Out.ObjectBaseType objectType) (Field _ _ _ seqSelection) result =
    executeSelectionSet result objectType seqSelection
-completeValue (Out.ListBaseType listType) selectionField (List list) =
+completeValue (Out.ListBaseType listType) selectionField (Definition.List list) =
    Aeson.toJSON <$> traverse (completeValue listType selectionField) list
 completeValue (Out.InterfaceBaseType interfaceType) (Field _ _ _ seqSelection) result
-    | Object objectMap <- result = do
+    | Definition.Object objectMap <- result = do
        abstractType <- resolveAbstractType (AbstractInterfaceType interfaceType) objectMap
        case abstractType of
            Just objectType -> executeSelectionSet result objectType seqSelection
            Nothing -> errmsg "Value completion failed."
 completeValue (Out.UnionBaseType unionType) (Field _ _ _ seqSelection) result
-    | Object objectMap <- result = do
+    | Definition.Object objectMap <- result = do
        abstractType <- resolveAbstractType (AbstractUnionType unionType) objectMap
        case abstractType of
            Just objectType -> executeSelectionSet result objectType seqSelection
@ -144,7 +154,7 @@ errmsg errorMessage = addErrMsg errorMessage >> pure Aeson.Null
 -- to each 'Selection'. Resolves into a value containing the resolved
 -- 'Selection', or a null value and error information.
 executeSelectionSet :: Monad m
-    => Value
+    => Definition.Value
    -> Out.ObjectType m
    -> Seq (Selection m)
    -> CollectErrsT m Aeson.Value
@ -161,3 +171,38 @@ executeSelectionSet result objectType@(Out.ObjectType _ _ _ resolvers) selection
        | Just typeField <- lookupResolver name =
            executeField result typeField fld
        | otherwise = errmsg $ Text.unwords ["field", name, "not resolved."]
+
+coerceArgumentValues
+    :: HashMap Name In.Argument
+    -> HashMap Name Input
+    -> Maybe Definition.Subs
+coerceArgumentValues argumentDefinitions argumentValues =
+    HashMap.foldrWithKey forEach (pure mempty) argumentDefinitions
+  where
+    forEach variableName (In.Argument _ variableType defaultValue) =
+        matchFieldValues coerceArgumentValue argumentValues variableName variableType defaultValue
+    coerceArgumentValue inputType (Int integer) =
+        coerceInputLiteral inputType (Definition.Int integer)
+    coerceArgumentValue inputType (Boolean boolean) =
+        coerceInputLiteral inputType (Definition.Boolean boolean)
+    coerceArgumentValue inputType (String string) =
+        coerceInputLiteral inputType (Definition.String string)
+    coerceArgumentValue inputType (Float float) =
+        coerceInputLiteral inputType (Definition.Float float)
+    coerceArgumentValue inputType (Enum enum) =
+        coerceInputLiteral inputType (Definition.Enum enum)
+    coerceArgumentValue inputType Null
+        | In.isNonNullType inputType = Nothing
+        | otherwise = coerceInputLiteral inputType Definition.Null
+    coerceArgumentValue (In.ListBaseType inputType) (List list) =
+        let coerceItem = coerceInputLiteral inputType
+         in Definition.List <$> traverse coerceItem list
+    coerceArgumentValue (In.InputObjectBaseType inputType) (Object object)
+        | In.InputObjectType _ _ inputFields <- inputType = 
+            let go = forEachField object
+                resultMap = HashMap.foldrWithKey go (pure mempty) inputFields
+             in Definition.Object <$> resultMap
+    coerceArgumentValue _ (Variable variable) = pure variable
+    coerceArgumentValue _ _ = Nothing
+    forEachField object variableName (In.InputField _ variableType defaultValue) =
+        matchFieldValues coerceArgumentValue object variableName variableType defaultValue
--- a/src/Language/GraphQL/Execute/Transform.hs
+++ b/src/Language/GraphQL/Execute/Transform.hs
@ -18,11 +18,12 @@
 -- the original AST.
 module Language.GraphQL.Execute.Transform
    ( Document(..)
-    , Fragment(..)
-    , QueryError(..)
-    , Operation(..)
-    , Selection(..)
    , Field(..)
+    , Fragment(..)
+    , Input(..)
+    , Operation(..)
+    , QueryError(..)
+    , Selection(..)
    , document
    , queryError
    ) where
@ -34,6 +35,7 @@ import Data.Foldable (find)
 import Data.Functor.Identity (Identity(..))
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
+import Data.Int (Int32)
 import Data.Maybe (fromMaybe)
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NonEmpty
@ -43,19 +45,18 @@ import qualified Data.Text as Text
 import qualified Language.GraphQL.AST as Full
 import Language.GraphQL.AST.Core
 import Language.GraphQL.Execute.Coerce
+import Language.GraphQL.Type.Directive (Directive(..))
 import qualified Language.GraphQL.Type.Directive as Directive
-import Language.GraphQL.Type.Definition (Subs, Value(..))
-import qualified Language.GraphQL.AST.Core as Core
+import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
-import qualified Language.GraphQL.Type.Directive as Core
 import Language.GraphQL.Type.Schema

-- | Associates a fragment name with a list of 'Core.Field's.
+-- | Associates a fragment name with a list of 'Field's.
 data Replacement m = Replacement
    { fragments :: HashMap Full.Name (Fragment m)
    , fragmentDefinitions :: FragmentDefinitions
-    , variableValues :: Subs
+    , variableValues :: Definition.Subs
    , types :: HashMap Full.Name (Type m)
    }

@ -78,7 +79,8 @@ data Operation m
    | Mutation (Maybe Text) (Seq (Selection m))

 -- | Single GraphQL field.
-data Field m = Field (Maybe Full.Name) Full.Name Arguments (Seq (Selection m))
+data Field m = Field
+    (Maybe Full.Name) Full.Name (HashMap Full.Name Input) (Seq (Selection m))

 -- | Contains the operation to be executed along with its root type.
 data Document m = Document
@ -100,6 +102,18 @@ data QueryError
    | EmptyDocument
    | UnsupportedRootOperation

+data Input
+    = Int Int32
+    | Float Double
+    | String Text
+    | Boolean Bool
+    | Null
+    | Enum Name
+    | List [Definition.Value]
+    | Object (HashMap Name Input)
+    | Variable Definition.Value
+    deriving (Eq, Show)
+
 queryError :: QueryError -> Text
 queryError (OperationNotFound operationName) = Text.unwords
    ["Operation", operationName, "couldn't be found in the document."]
@ -158,41 +172,33 @@ coerceVariableValues :: VariableValue a
    . HashMap Full.Name (Type m)
    -> OperationDefinition
    -> HashMap.HashMap Full.Name a
-    -> Either QueryError Subs
-coerceVariableValues types operationDefinition variableValues' =
+    -> Either QueryError Definition.Subs
+coerceVariableValues types operationDefinition variableValues =
    let OperationDefinition _ _ variableDefinitions _ _ = operationDefinition
     in maybe (Left CoercionError) Right
-        $ foldr coerceValue (Just HashMap.empty) variableDefinitions
+        $ foldr forEach (Just HashMap.empty) variableDefinitions
  where
-    coerceValue variableDefinition coercedValues = do
+    forEach variableDefinition coercedValues = do
        let Full.VariableDefinition variableName variableTypeName defaultValue =
                variableDefinition
        let defaultValue' = constValue <$> defaultValue
-        let value' = HashMap.lookup variableName variableValues'
-
        variableType <- lookupInputType variableTypeName types
-        HashMap.insert variableName
-            <$> choose value' defaultValue' variableType
-            <*> coercedValues
-    choose Nothing defaultValue variableType
-        | Just _ <- defaultValue = defaultValue
-        | not (In.isNonNullType variableType) = Just Null
-    choose (Just value') _ variableType
-        | Just coercedValue <- coerceVariableValue variableType value'
-        , not (In.isNonNullType variableType) || coercedValue /= Null =
-            Just coercedValue
-    choose _ _ _ = Nothing

-constValue :: Full.ConstValue -> Value
-constValue (Full.ConstInt i) = Int i
-constValue (Full.ConstFloat f) = Float f
-constValue (Full.ConstString x) = String x
-constValue (Full.ConstBoolean b) = Boolean b
-constValue Full.ConstNull = Null
-constValue (Full.ConstEnum e) = Enum e
-constValue (Full.ConstList l) = List $ constValue <$> l
+        matchFieldValues coerceVariableValue' variableValues variableName variableType defaultValue' coercedValues
+    coerceVariableValue' variableType value'
+        = coerceVariableValue variableType value'
+        >>= coerceInputLiteral variableType
+
+constValue :: Full.ConstValue -> Definition.Value
+constValue (Full.ConstInt i) = Definition.Int i
+constValue (Full.ConstFloat f) = Definition.Float f
+constValue (Full.ConstString x) = Definition.String x
+constValue (Full.ConstBoolean b) = Definition.Boolean b
+constValue Full.ConstNull = Definition.Null
+constValue (Full.ConstEnum e) = Definition.Enum e
+constValue (Full.ConstList l) = Definition.List $ constValue <$> l
 constValue (Full.ConstObject o) =
-    Object $ HashMap.fromList $ constObjectField <$> o
+    Definition.Object $ HashMap.fromList $ constObjectField <$> o
  where
    constObjectField (Full.ObjectField key value') = (key, constValue value')

@ -271,11 +277,15 @@ selection
    ->  State (Replacement m) (Either (Seq (Selection m)) (Selection m))
 selection (Full.Field alias name arguments' directives' selections) =
    maybe (Left mempty) (Right . SelectionField) <$> do
-        fieldArguments <- arguments arguments'
+        fieldArguments <- foldM go HashMap.empty arguments'
        fieldSelections <- appendSelection selections
        fieldDirectives <- Directive.selection <$> directives directives'
        let field' = Field alias name fieldArguments fieldSelections
        pure $ field' <$ fieldDirectives
+  where
+    go arguments (Full.Argument name' value') =
+        inputField arguments name' value'
+
 selection (Full.FragmentSpread name directives') =
    maybe (Left mempty) (Right . SelectionFragment) <$> do
        spreadDirectives <- Directive.selection <$> directives directives'
@ -320,11 +330,15 @@ appendSelection = foldM go mempty
    append acc (Left list) = list >< acc
    append acc (Right one) = one <| acc

-directives :: [Full.Directive] ->  State (Replacement m) [Core.Directive]
+directives :: [Full.Directive] ->  State (Replacement m) [Directive]
 directives = traverse directive
  where
-    directive (Full.Directive directiveName directiveArguments) =
-        Core.Directive directiveName <$> arguments directiveArguments
+    directive (Full.Directive directiveName directiveArguments)
+        = Directive directiveName . Arguments
+        <$> foldM go HashMap.empty directiveArguments
+    go arguments (Full.Argument name value') = do
+        substitutedValue <- value value'
+        return $ HashMap.insert name substitutedValue arguments

 -- * Fragment replacement

@ -371,27 +385,45 @@ fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do
        let newFragments = HashMap.insert name newValue fragments
         in replacement{ fragments = newFragments }

-arguments :: [Full.Argument] -> State (Replacement m) Core.Arguments
-arguments = fmap Core.Arguments . foldM go HashMap.empty
-  where
-    go arguments' (Full.Argument name value') = do
-        substitutedValue <- value value'
-        return $ HashMap.insert name substitutedValue arguments'
-
-value :: Full.Value -> State (Replacement m) Value
+value :: forall m. Full.Value -> State (Replacement m) Definition.Value
 value (Full.Variable name) =
-    gets $ fromMaybe Null . HashMap.lookup name . variableValues
-value (Full.Int i) = pure $ Int i
-value (Full.Float f) = pure $ Float f
-value (Full.String x) = pure $ String x
-value (Full.Boolean b) = pure $ Boolean b
-value Full.Null = pure   Null
-value (Full.Enum e) = pure $ Enum e
-value (Full.List l) = List <$> traverse value l
+    gets (fromMaybe Definition.Null . HashMap.lookup name . variableValues)
+value (Full.Int i) = pure $ Definition.Int i
+value (Full.Float f) = pure $ Definition.Float f
+value (Full.String x) = pure $ Definition.String x
+value (Full.Boolean b) = pure $ Definition.Boolean b
+value Full.Null = pure Definition.Null
+value (Full.Enum e) = pure $ Definition.Enum e
+value (Full.List l) = Definition.List <$> traverse value l
 value (Full.Object o) =
-    Object . HashMap.fromList <$> traverse objectField o
+    Definition.Object . HashMap.fromList <$> traverse objectField o
+  where
+    objectField (Full.ObjectField name value') = (name,) <$> value value'

-objectField
-    :: Full.ObjectField Full.Value
-    -> State (Replacement m) (Full.Name, Value)
-objectField (Full.ObjectField name value') = (name,) <$> value value'
+input :: forall m. Full.Value -> State (Replacement m) (Maybe Input)
+input (Full.Variable name) =
+    gets (fmap Variable . HashMap.lookup name . variableValues)
+input (Full.Int i) = pure $ pure $ Int i
+input (Full.Float f) = pure $ pure $ Float f
+input (Full.String x) = pure $ pure $ String x
+input (Full.Boolean b) = pure $ pure $ Boolean b
+input Full.Null = pure $ pure Null
+input (Full.Enum e) = pure $ pure $ Enum e
+input (Full.List list) = pure . List <$> traverse value list
+input (Full.Object object) = do
+    objectFields <- foldM objectField HashMap.empty object
+    pure $ pure $ Object objectFields
+  where
+    objectField resultMap (Full.ObjectField name value') =
+        inputField resultMap name value'
+
+inputField :: forall m
+    . HashMap Full.Name Input
+    -> Full.Name
+    -> Full.Value
+    -> State (Replacement m) (HashMap Full.Name Input)
+inputField resultMap name value' = do
+    objectFieldValue <-  input value'
+    case objectFieldValue of
+        Just fieldValue -> pure $ HashMap.insert name fieldValue resultMap
+        Nothing -> pure resultMap
--- a/tests/Language/GraphQL/Execute/CoerceSpec.hs
+++ b/tests/Language/GraphQL/Execute/CoerceSpec.hs
@ -6,12 +6,10 @@ 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.Document (Name)
 import Language.GraphQL.Execute.Coerce
 import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.In as In
@ -22,14 +20,6 @@ direction :: EnumType
 direction = EnumType "Direction" Nothing 
    $ Set.fromList ["NORTH", "EAST", "SOUTH", "WEST"]

-coerceInputLiteral :: In.Type -> 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 :: In.Type
 singletonInputObject = In.NamedInputObjectType type'
  where
@ -39,7 +29,7 @@ singletonInputObject = In.NamedInputObjectType type'

 spec :: Spec
 spec = do
-    describe "ToGraphQL Aeson" $ do
+    describe "VariableValue Aeson" $ do
        it "coerces strings" $
            let expected = Just (String "asdf")
                actual = coerceVariableValue
@ -107,7 +97,7 @@ spec = do
            let expected = Just (Enum "NORTH")
                actual = coerceInputLiteral
                    (In.NamedEnumType direction) (Enum "NORTH")
-             in lookupActual actual `shouldBe` expected
+             in actual `shouldBe` expected
        it "fails with non-existing enum value" $
            let actual = coerceInputLiteral
                    (In.NamedEnumType direction) (Enum "NORTH_EAST")
@ -115,4 +105,4 @@ spec = do
        it "coerces integers to IDs" $
            let expected = Just (String "1234")
                actual = coerceInputLiteral (In.NamedScalarType id) (Int 1234)
-             in lookupActual actual `shouldBe` expected
+             in actual `shouldBe` expected
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@ -11,10 +11,12 @@ import Data.Functor.Identity (Identity)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
+import qualified Data.Set as Set
 import Language.GraphQL.Trans
 import Language.GraphQL.Type.Definition
+import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
-import Language.GraphQL.Type.Schema
+import Language.GraphQL.Type.Schema (Schema(..))
 import Test.StarWars.Data
 import Prelude hiding (id)

@ -24,10 +26,17 @@ schema :: Schema Identity
 schema = Schema { query = queryType, mutation = Nothing }
  where
    queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
-        [ ("hero", Out.Resolver (Out.Field Nothing (Out.NamedObjectType heroObject) mempty) hero)
-        , ("human", Out.Resolver (Out.Field Nothing (Out.NamedObjectType heroObject) mempty) human)
-        , ("droid", Out.Resolver (Out.Field Nothing (Out.NamedObjectType droidObject) mempty) droid)
+        [ ("hero", Out.Resolver heroField hero)
+        , ("human", Out.Resolver humanField human)
+        , ("droid", Out.Resolver droidField droid)
        ]
+    heroField = Out.Field Nothing (Out.NamedObjectType heroObject)
+        $ HashMap.singleton "episode"
+        $ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing
+    humanField = Out.Field Nothing (Out.NamedObjectType heroObject)
+        $ HashMap.singleton "id"
+        $ In.Argument Nothing (In.NonNullScalarType string) Nothing
+    droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty

 heroObject :: Out.ObjectType Identity
 heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
@ -76,6 +85,10 @@ idField f = do
    let (Object v') = v
    pure $ v' HashMap.! f

+episodeEnum :: EnumType
+episodeEnum = EnumType "Episode" Nothing
+    $ Set.fromList ["NEW_HOPE", "EMPIRE", "JEDI"]
+
 hero :: ActionT Identity Value
 hero = do
  episode <- argument "episode"