Coerce argument values properly

Fixes #44.
This commit is contained in:
Eugen Wissner 2020-06-06 21:22:11 +02:00
parent 93a0403288
commit 4c9264c12c
6 changed files with 251 additions and 160 deletions

View File

@ -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

View File

@ -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,20 +92,38 @@ instance VariableValue Aeson.Value where
pure $ coerced : list
coerceVariableValue _ _ = Nothing
-- | 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.
coerceInputLiterals
:: HashMap Name In.Type
-> 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 (In.NamedScalarType type') value
coerceInputLiteral :: In.Type -> Value -> Maybe Value
coerceInputLiteral (In.ScalarBaseType type') value
| (String stringValue) <- value
, (ScalarType "String" _) <- type' = Just $ String stringValue
| (Boolean booleanValue) <- value
@ -119,31 +139,20 @@ coerceInputLiterals variableTypes variableValues =
, (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)
where
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

View File

@ -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,13 +103,17 @@ 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
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
@ -111,26 +121,26 @@ executeField prev (Out.Resolver fieldDefinition resolver) field = do
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

View File

@ -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
objectField
:: Full.ObjectField Full.Value
-> State (Replacement m) (Full.Name, Value)
Definition.Object . HashMap.fromList <$> traverse objectField o
where
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

View File

@ -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

View File

@ -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"