mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
342391f39d
This upgrades the version of Ormolu required by the HGE repository to v0.5.0.1, and reformats all code accordingly. Ormolu v0.5 reformats code that uses infix operators. This is mostly useful, adding newlines and indentation to make it clear which operators are applied first, but in some cases, it's unpleasant. To make this easier on the eyes, I had to do the following: * Add a few fixity declarations (search for `infix`) * Add parentheses to make precedence clear, allowing Ormolu to keep everything on one line * Rename `relevantEq` to `(==~)` in #6651 and set it to `infix 4` * Add a few _.ormolu_ files (thanks to @hallettj for helping me get started), mostly for Autodocodec operators that don't have explicit fixity declarations In general, I think these changes are quite reasonable. They mostly affect indentation. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6675 GitOrigin-RevId: cd47d87f1d089fb0bc9dcbbe7798dbceedcd7d83
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 Map
|
|
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 <- Map.groupOnNE getName <$> traverse buildVariable definitions
|
|
uniqueVariables <- flip
|
|
Map.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 . Map.keys $ variablesByName
|
|
jsonVariableNames = HS.fromList $ Map.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 Map.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 Map.lookup name variables of
|
|
Just variable -> modify (HS.insert name) >> pure variable
|
|
Nothing -> throw400 ValidationFailed $ "unbound variable " <>> name
|