mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
7e334e08a4
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8947 GitOrigin-RevId: 18e52c928e1df535579e2077b4af6c2ce92bdcef
104 lines
4.0 KiB
Haskell
104 lines
4.0 KiB
Haskell
-- | Implements /variable resolution/ for GraphQL queries, which annotates the
|
|
-- use site of each GraphQL variable with its value.
|
|
module Hasura.GraphQL.Execute.Resolve
|
|
( resolveVariables,
|
|
)
|
|
where
|
|
|
|
import Data.HashMap.Strict.Extended qualified as HashMap
|
|
import Data.HashSet qualified as HS
|
|
import Data.List qualified as L
|
|
import Data.Text qualified as T
|
|
import Data.Text.Extended
|
|
import Hasura.Base.Error
|
|
import Hasura.GraphQL.Parser.Names
|
|
import Hasura.GraphQL.Parser.Variable
|
|
import Hasura.GraphQL.Transport.HTTP.Protocol qualified as GH
|
|
import Hasura.Prelude
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
resolveVariables ::
|
|
forall m fragments.
|
|
(MonadError QErr m, Traversable fragments) =>
|
|
[G.VariableDefinition] ->
|
|
GH.VariableValues ->
|
|
[G.Directive G.Name] ->
|
|
G.SelectionSet fragments G.Name ->
|
|
m
|
|
( [G.Directive Variable],
|
|
G.SelectionSet fragments Variable
|
|
)
|
|
resolveVariables definitions jsonValues directives selSet = do
|
|
variablesByName <- HashMap.groupOnNE getName <$> traverse buildVariable definitions
|
|
uniqueVariables <- flip
|
|
HashMap.traverseWithKey
|
|
variablesByName
|
|
\variableName variableDefinitions ->
|
|
case variableDefinitions of
|
|
a :| [] -> return a
|
|
_ ->
|
|
throw400 ParseFailed $
|
|
"multiple definitions for variable " <>> variableName
|
|
((directives', selSet'), usedVariables) <- flip runStateT mempty $ do
|
|
d <- traverse (traverse (resolveVariable uniqueVariables)) directives
|
|
s <- traverse (traverse (resolveVariable uniqueVariables)) selSet
|
|
pure (d, s)
|
|
let variablesByNameSet = HS.fromList . HashMap.keys $ variablesByName
|
|
jsonVariableNames = HS.fromList $ HashMap.keys jsonValues
|
|
-- At the time of writing, this check is disabled using
|
|
-- a local binding because, the master branch doesn't implement this
|
|
-- check.
|
|
-- TODO: Do this check using a feature flag
|
|
isVariableValidationEnabled = False
|
|
|
|
when (isVariableValidationEnabled && usedVariables /= variablesByNameSet) $
|
|
throw400 ValidationFailed $
|
|
"following variable(s) have been defined, but have not been used in the query - "
|
|
<> T.concat
|
|
( L.intersperse ", " $
|
|
map G.unName $
|
|
HS.toList $
|
|
HS.difference variablesByNameSet usedVariables
|
|
)
|
|
|
|
-- There may be variables which have a default value and may not be
|
|
-- included in the variables JSON Map. So, we should only see, if a
|
|
-- variable is inlcuded in the JSON Map, then it must be used in the
|
|
-- query
|
|
when (HS.difference jsonVariableNames usedVariables /= HS.empty) $
|
|
throw400 ValidationFailed $
|
|
"unexpected variables in variableValues: "
|
|
<> T.concat
|
|
( L.intersperse ", " $
|
|
map G.unName $
|
|
HS.toList $
|
|
HS.difference jsonVariableNames usedVariables
|
|
)
|
|
|
|
return (directives', selSet')
|
|
where
|
|
buildVariable :: G.VariableDefinition -> m Variable
|
|
buildVariable G.VariableDefinition {G._vdName, G._vdType, G._vdDefaultValue} = do
|
|
let defaultValue = fromMaybe G.VNull _vdDefaultValue
|
|
isOptional = isJust _vdDefaultValue || G.isNullable _vdType
|
|
value <- case HashMap.lookup _vdName jsonValues of
|
|
Just jsonValue -> pure $ JSONValue jsonValue
|
|
Nothing
|
|
| isOptional -> pure $ GraphQLValue $ absurd <$> defaultValue
|
|
| otherwise ->
|
|
throw400 ValidationFailed $
|
|
"expecting a value for non-nullable variable: " <>> _vdName
|
|
pure $!
|
|
Variable
|
|
{ vInfo =
|
|
if isOptional
|
|
then VIOptional _vdName defaultValue
|
|
else VIRequired _vdName,
|
|
vType = _vdType,
|
|
vValue = value
|
|
}
|
|
resolveVariable :: HashMap G.Name Variable -> G.Name -> StateT (HS.HashSet G.Name) m Variable
|
|
resolveVariable variables name = case HashMap.lookup name variables of
|
|
Just variable -> modify (HS.insert name) >> pure variable
|
|
Nothing -> throw400 ValidationFailed $ "unbound variable " <>> name
|