85 lines
4.3 KiB
Haskell
85 lines
4.3 KiB
Haskell
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
|
||
|
|
-- | Types and functions used for input and result coercion.
|
||
|
|
module Language.GraphQL.Execute.Coerce
|
||
|
|
( VariableValue(..)
|
||
|
|
) where
|
||
|
|
|
||
|
|
import qualified Data.Aeson as Aeson
|
||
|
|
import qualified Data.HashMap.Strict as HashMap
|
||
|
|
import Data.Scientific (toBoundedInteger, toRealFloat)
|
||
|
|
import Language.GraphQL.AST.Core
|
||
|
|
import Language.GraphQL.Type.Definition
|
||
|
|
|
||
|
|
-- | Since variables are passed separately from the query, in an independent
|
||
|
|
-- format, they should be first coerced to the internal representation used by
|
||
|
|
-- this implementation.
|
||
|
|
class VariableValue a where
|
||
|
|
-- | Only a basic, format-specific, coercion must be done here. Type
|
||
|
|
-- correctness or nullability shouldn't be validated here, they will be
|
||
|
|
-- validated later. The type information is provided only as a hint.
|
||
|
|
--
|
||
|
|
-- For example @GraphQL@ prohibits the coercion from a 't:Float' to an
|
||
|
|
-- 't:Int', but @JSON@ doesn't have integers, so whole numbers should be
|
||
|
|
-- coerced to 't:Int` when receiving variables as a JSON object. The same
|
||
|
|
-- holds for 't:Enum'. There are formats that support enumerations, @JSON@
|
||
|
|
-- doesn't, so the type information is given and 'coerceVariableValue' can
|
||
|
|
-- check that an 't:Enum' is expected and treat the given value
|
||
|
|
-- appropriately. Even checking whether this value is a proper member of the
|
||
|
|
-- corresponding 't:Enum' type isn't required here, since this can be
|
||
|
|
-- checked independently.
|
||
|
|
--
|
||
|
|
-- Another example is an @ID@. @GraphQL@ explicitly allows to coerce
|
||
|
|
-- integers and strings to @ID@s, so if an @ID@ is received as an integer,
|
||
|
|
-- it can be left as is and will be coerced later.
|
||
|
|
--
|
||
|
|
-- If a value cannot be coerced without losing information, 'Nothing' should
|
||
|
|
-- be returned, the coercion will fail then and the query won't be executed.
|
||
|
|
coerceVariableValue
|
||
|
|
:: InputType -- ^ Expected type (variable type given in the query).
|
||
|
|
-> a -- ^ Variable value being coerced.
|
||
|
|
-> Maybe Value -- ^ Coerced value on success, 'Nothing' otherwise.
|
||
|
|
|
||
|
|
instance VariableValue Aeson.Value where
|
||
|
|
coerceVariableValue _ Aeson.Null = Just Null
|
||
|
|
coerceVariableValue (ScalarInputTypeDefinition scalarType) value
|
||
|
|
| (Aeson.String stringValue) <- value = Just $ String stringValue
|
||
|
|
| (Aeson.Bool booleanValue) <- value = Just $ Boolean booleanValue
|
||
|
|
| (Aeson.Number numberValue) <- value
|
||
|
|
, (ScalarType "Float" _) <- scalarType =
|
||
|
|
Just $ Float $ toRealFloat numberValue
|
||
|
|
| (Aeson.Number numberValue) <- value = -- ID or Int
|
||
|
|
Int <$> toBoundedInteger numberValue
|
||
|
|
coerceVariableValue (EnumInputTypeDefinition _) (Aeson.String stringValue) =
|
||
|
|
Just $ Enum stringValue
|
||
|
|
coerceVariableValue (ObjectInputTypeDefinition objectType) value
|
||
|
|
| (Aeson.Object objectValue) <- value = do
|
||
|
|
let (InputObjectType _ _ inputFields) = objectType
|
||
|
|
(newObjectValue, resultMap) <- foldWithKey objectValue inputFields
|
||
|
|
if HashMap.null newObjectValue
|
||
|
|
then Just $ Object resultMap
|
||
|
|
else Nothing
|
||
|
|
where
|
||
|
|
foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues
|
||
|
|
$ Just (objectValue, HashMap.empty)
|
||
|
|
matchFieldValues _ _ Nothing = Nothing
|
||
|
|
matchFieldValues fieldName inputField (Just (objectValue, resultMap)) =
|
||
|
|
let (InputField _ fieldType _) = inputField
|
||
|
|
insert = flip (HashMap.insert fieldName) resultMap
|
||
|
|
newObjectValue = HashMap.delete fieldName objectValue
|
||
|
|
in case HashMap.lookup fieldName objectValue of
|
||
|
|
Just variableValue -> do
|
||
|
|
coerced <- coerceVariableValue fieldType variableValue
|
||
|
|
pure (newObjectValue, insert coerced)
|
||
|
|
Nothing -> Just (objectValue, resultMap)
|
||
|
|
coerceVariableValue (ListInputTypeDefinition listType) value
|
||
|
|
| (Aeson.Array arrayValue) <- value = List
|
||
|
|
<$> foldr foldVector (Just []) arrayValue
|
||
|
|
| otherwise = coerceVariableValue listType value
|
||
|
|
where
|
||
|
|
foldVector _ Nothing = Nothing
|
||
|
|
foldVector variableValue (Just list) = do
|
||
|
|
coerced <- coerceVariableValue listType variableValue
|
||
|
|
pure $ coerced : list
|
||
|
|
coerceVariableValue _ _ = Nothing
|