{-# LANGUAGE DeriveAnyClass #-}

module Hasura.GraphQL.Execute.Remote
  ( buildExecStepRemote,
    getVariableDefinitionAndValue,
    resolveRemoteVariable,
    resolveRemoteField,
    runVariableCache,
  )
where

import Data.Aeson qualified as J
import Data.HashMap.Strict qualified as Map
import Data.HashSet qualified as Set
import Data.Text qualified as T
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.GraphQL.Execute.Backend
import Hasura.GraphQL.Execute.RemoteJoin.Types (RemoteJoins)
import Hasura.GraphQL.Parser
import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.GraphQL.Transport.HTTP.Protocol qualified as GH
import Hasura.Prelude
import Hasura.RQL.IR.RemoteSchema qualified as IR
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.ResultCustomization
import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G

getVariableDefinitionAndValue :: Variable -> (G.VariableDefinition, (G.Name, J.Value))
getVariableDefinitionAndValue :: Variable -> (VariableDefinition, (Name, Value))
getVariableDefinitionAndValue var :: Variable
var@(Variable VariableInfo
varInfo GType
gType InputValue Void
varValue) =
  (VariableDefinition
varDefn, (Name
varName, Value
varJSONValue))
  where
    varName :: Name
varName = Variable -> Name
forall a. HasName a => a -> Name
getName Variable
var

    varDefn :: VariableDefinition
varDefn = Name -> GType -> Maybe (Value Void) -> VariableDefinition
G.VariableDefinition Name
varName GType
gType Maybe (Value Void)
defaultVal

    defaultVal :: Maybe (Value Void)
defaultVal =
      case VariableInfo
varInfo of
        VIRequired Name
_ -> Maybe (Value Void)
forall a. Maybe a
Nothing
        VIOptional Name
_ Value Void
val -> Value Void -> Maybe (Value Void)
forall a. a -> Maybe a
Just Value Void
val

    varJSONValue :: Value
varJSONValue =
      case InputValue Void
varValue of
        JSONValue Value
v -> Value
v
        GraphQLValue Value Void
val -> Value Void -> Value
graphQLValueToJSON Value Void
val

unresolveVariables ::
  forall fragments.
  Functor fragments =>
  G.SelectionSet fragments Variable ->
  G.SelectionSet fragments G.Name
unresolveVariables :: SelectionSet fragments Variable -> SelectionSet fragments Name
unresolveVariables =
  (Selection fragments Variable -> Selection fragments Name)
-> SelectionSet fragments Variable -> SelectionSet fragments Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Variable -> Name)
-> Selection fragments Variable -> Selection fragments Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VariableInfo -> Name
forall a. HasName a => a -> Name
getName (VariableInfo -> Name)
-> (Variable -> VariableInfo) -> Variable -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> VariableInfo
vInfo))

collectVariables ::
  forall fragments var.
  (Foldable fragments, Hashable var, Eq var) =>
  G.SelectionSet fragments var ->
  Set.HashSet var
collectVariables :: SelectionSet fragments var -> HashSet var
collectVariables =
  [HashSet var] -> HashSet var
forall a. (Eq a, Hashable a) => [HashSet a] -> HashSet a
Set.unions ([HashSet var] -> HashSet var)
-> (SelectionSet fragments var -> [HashSet var])
-> SelectionSet fragments var
-> HashSet var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Selection fragments var -> HashSet var)
-> SelectionSet fragments var -> [HashSet var]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((var -> HashSet var) -> Selection fragments var -> HashSet var
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap var -> HashSet var
forall a. Hashable a => a -> HashSet a
Set.singleton)

buildExecStepRemote ::
  RemoteSchemaInfo ->
  ResultCustomizer ->
  G.OperationType ->
  IR.GraphQLField Void Variable ->
  Maybe RemoteJoins ->
  Maybe OperationName ->
  ExecutionStep
buildExecStepRemote :: RemoteSchemaInfo
-> ResultCustomizer
-> OperationType
-> GraphQLField Void Variable
-> Maybe RemoteJoins
-> Maybe OperationName
-> ExecutionStep
buildExecStepRemote RemoteSchemaInfo
remoteSchemaInfo ResultCustomizer
resultCustomizer OperationType
tp GraphQLField Void Variable
rootField Maybe RemoteJoins
remoteJoins Maybe OperationName
operationName =
  let selSet :: [Selection NoFragments Variable]
selSet = [Field NoFragments Variable -> Selection NoFragments Variable
forall (frag :: * -> *) var. Field frag var -> Selection frag var
G.SelectionField (Field NoFragments Variable -> Selection NoFragments Variable)
-> Field NoFragments Variable -> Selection NoFragments Variable
forall a b. (a -> b) -> a -> b
$ GraphQLField Void Variable -> Field NoFragments Variable
forall var.
Eq var =>
GraphQLField Void var -> Field NoFragments var
IR.convertGraphQLField GraphQLField Void Variable
rootField]
      unresolvedSelSet :: SelectionSet NoFragments Name
unresolvedSelSet = [Selection NoFragments Variable] -> SelectionSet NoFragments Name
forall (fragments :: * -> *).
Functor fragments =>
SelectionSet fragments Variable -> SelectionSet fragments Name
unresolveVariables [Selection NoFragments Variable]
selSet
      allVars :: [(VariableDefinition, (Name, Value))]
allVars = (Variable -> (VariableDefinition, (Name, Value)))
-> [Variable] -> [(VariableDefinition, (Name, Value))]
forall a b. (a -> b) -> [a] -> [b]
map Variable -> (VariableDefinition, (Name, Value))
getVariableDefinitionAndValue ([Variable] -> [(VariableDefinition, (Name, Value))])
-> [Variable] -> [(VariableDefinition, (Name, Value))]
forall a b. (a -> b) -> a -> b
$ HashSet Variable -> [Variable]
forall a. HashSet a -> [a]
Set.toList (HashSet Variable -> [Variable]) -> HashSet Variable -> [Variable]
forall a b. (a -> b) -> a -> b
$ [Selection NoFragments Variable] -> HashSet Variable
forall (fragments :: * -> *) var.
(Foldable fragments, Hashable var, Eq var) =>
SelectionSet fragments var -> HashSet var
collectVariables [Selection NoFragments Variable]
selSet
      varValues :: HashMap Name Value
varValues = [(Name, Value)] -> HashMap Name Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Name, Value)] -> HashMap Name Value)
-> [(Name, Value)] -> HashMap Name Value
forall a b. (a -> b) -> a -> b
$ ((VariableDefinition, (Name, Value)) -> (Name, Value))
-> [(VariableDefinition, (Name, Value))] -> [(Name, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (VariableDefinition, (Name, Value)) -> (Name, Value)
forall a b. (a, b) -> b
snd [(VariableDefinition, (Name, Value))]
allVars
      varValsM :: Maybe (HashMap Name Value)
varValsM = Maybe (HashMap Name Value)
-> Maybe (HashMap Name Value) -> Bool -> Maybe (HashMap Name Value)
forall a. a -> a -> Bool -> a
bool (HashMap Name Value -> Maybe (HashMap Name Value)
forall a. a -> Maybe a
Just HashMap Name Value
varValues) Maybe (HashMap Name Value)
forall a. Maybe a
Nothing (Bool -> Maybe (HashMap Name Value))
-> Bool -> Maybe (HashMap Name Value)
forall a b. (a -> b) -> a -> b
$ HashMap Name Value -> Bool
forall k v. HashMap k v -> Bool
Map.null HashMap Name Value
varValues
      varDefs :: [VariableDefinition]
varDefs = ((VariableDefinition, (Name, Value)) -> VariableDefinition)
-> [(VariableDefinition, (Name, Value))] -> [VariableDefinition]
forall a b. (a -> b) -> [a] -> [b]
map (VariableDefinition, (Name, Value)) -> VariableDefinition
forall a b. (a, b) -> a
fst [(VariableDefinition, (Name, Value))]
allVars
      _grQuery :: TypedOperationDefinition NoFragments Name
_grQuery = OperationType
-> Maybe Name
-> [VariableDefinition]
-> [Directive Name]
-> SelectionSet NoFragments Name
-> TypedOperationDefinition NoFragments Name
forall (frag :: * -> *) var.
OperationType
-> Maybe Name
-> [VariableDefinition]
-> [Directive var]
-> SelectionSet frag var
-> TypedOperationDefinition frag var
G.TypedOperationDefinition OperationType
tp (OperationName -> Name
_unOperationName (OperationName -> Name) -> Maybe OperationName -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe OperationName
operationName) [VariableDefinition]
varDefs [] SelectionSet NoFragments Name
unresolvedSelSet
      _grVariables :: Maybe (HashMap Name Value)
_grVariables = Maybe (HashMap Name Value)
varValsM
      _grOperationName :: Maybe OperationName
_grOperationName = Maybe OperationName
operationName
   in RemoteSchemaInfo
-> ResultCustomizer
-> GQLReqOutgoing
-> Maybe RemoteJoins
-> ExecutionStep
ExecStepRemote RemoteSchemaInfo
remoteSchemaInfo ResultCustomizer
resultCustomizer GQLReq :: forall a.
Maybe OperationName -> a -> Maybe (HashMap Name Value) -> GQLReq a
GH.GQLReq {Maybe (HashMap Name Value)
Maybe OperationName
TypedOperationDefinition NoFragments Name
_grVariables :: Maybe (HashMap Name Value)
_grQuery :: TypedOperationDefinition NoFragments Name
_grOperationName :: Maybe OperationName
_grOperationName :: Maybe OperationName
_grVariables :: Maybe (HashMap Name Value)
_grQuery :: TypedOperationDefinition NoFragments Name
..} Maybe RemoteJoins
remoteJoins

-- | Association between keys uniquely identifying some remote JSON variable and
-- an 'Int' identifier that will be used to construct a valid variable name to
-- be used in a GraphQL query.
newtype RemoteJSONVariableMap
  = RemoteJSONVariableMap (HashMap RemoteJSONVariableKey Int)
  deriving newtype (RemoteJSONVariableMap -> RemoteJSONVariableMap -> Bool
(RemoteJSONVariableMap -> RemoteJSONVariableMap -> Bool)
-> (RemoteJSONVariableMap -> RemoteJSONVariableMap -> Bool)
-> Eq RemoteJSONVariableMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteJSONVariableMap -> RemoteJSONVariableMap -> Bool
$c/= :: RemoteJSONVariableMap -> RemoteJSONVariableMap -> Bool
== :: RemoteJSONVariableMap -> RemoteJSONVariableMap -> Bool
$c== :: RemoteJSONVariableMap -> RemoteJSONVariableMap -> Bool
Eq, Semigroup RemoteJSONVariableMap
RemoteJSONVariableMap
Semigroup RemoteJSONVariableMap
-> RemoteJSONVariableMap
-> (RemoteJSONVariableMap
    -> RemoteJSONVariableMap -> RemoteJSONVariableMap)
-> ([RemoteJSONVariableMap] -> RemoteJSONVariableMap)
-> Monoid RemoteJSONVariableMap
[RemoteJSONVariableMap] -> RemoteJSONVariableMap
RemoteJSONVariableMap
-> RemoteJSONVariableMap -> RemoteJSONVariableMap
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [RemoteJSONVariableMap] -> RemoteJSONVariableMap
$cmconcat :: [RemoteJSONVariableMap] -> RemoteJSONVariableMap
mappend :: RemoteJSONVariableMap
-> RemoteJSONVariableMap -> RemoteJSONVariableMap
$cmappend :: RemoteJSONVariableMap
-> RemoteJSONVariableMap -> RemoteJSONVariableMap
mempty :: RemoteJSONVariableMap
$cmempty :: RemoteJSONVariableMap
$cp1Monoid :: Semigroup RemoteJSONVariableMap
Monoid, b -> RemoteJSONVariableMap -> RemoteJSONVariableMap
NonEmpty RemoteJSONVariableMap -> RemoteJSONVariableMap
RemoteJSONVariableMap
-> RemoteJSONVariableMap -> RemoteJSONVariableMap
(RemoteJSONVariableMap
 -> RemoteJSONVariableMap -> RemoteJSONVariableMap)
-> (NonEmpty RemoteJSONVariableMap -> RemoteJSONVariableMap)
-> (forall b.
    Integral b =>
    b -> RemoteJSONVariableMap -> RemoteJSONVariableMap)
-> Semigroup RemoteJSONVariableMap
forall b.
Integral b =>
b -> RemoteJSONVariableMap -> RemoteJSONVariableMap
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> RemoteJSONVariableMap -> RemoteJSONVariableMap
$cstimes :: forall b.
Integral b =>
b -> RemoteJSONVariableMap -> RemoteJSONVariableMap
sconcat :: NonEmpty RemoteJSONVariableMap -> RemoteJSONVariableMap
$csconcat :: NonEmpty RemoteJSONVariableMap -> RemoteJSONVariableMap
<> :: RemoteJSONVariableMap
-> RemoteJSONVariableMap -> RemoteJSONVariableMap
$c<> :: RemoteJSONVariableMap
-> RemoteJSONVariableMap -> RemoteJSONVariableMap
Semigroup)

-- | A unique identifier for some remote JSON variable whose name will need to
-- be substituted when constructing a GraphQL query.
--
-- For a detailed explanation of this behavior, see the following comment:
-- https://github.com/hasura/graphql-engine/issues/7170#issuecomment-880838970
data RemoteJSONVariableKey = RemoteJSONVariableKey !G.GType !J.Value
  deriving stock (RemoteJSONVariableKey -> RemoteJSONVariableKey -> Bool
(RemoteJSONVariableKey -> RemoteJSONVariableKey -> Bool)
-> (RemoteJSONVariableKey -> RemoteJSONVariableKey -> Bool)
-> Eq RemoteJSONVariableKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteJSONVariableKey -> RemoteJSONVariableKey -> Bool
$c/= :: RemoteJSONVariableKey -> RemoteJSONVariableKey -> Bool
== :: RemoteJSONVariableKey -> RemoteJSONVariableKey -> Bool
$c== :: RemoteJSONVariableKey -> RemoteJSONVariableKey -> Bool
Eq, (forall x. RemoteJSONVariableKey -> Rep RemoteJSONVariableKey x)
-> (forall x. Rep RemoteJSONVariableKey x -> RemoteJSONVariableKey)
-> Generic RemoteJSONVariableKey
forall x. Rep RemoteJSONVariableKey x -> RemoteJSONVariableKey
forall x. RemoteJSONVariableKey -> Rep RemoteJSONVariableKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoteJSONVariableKey x -> RemoteJSONVariableKey
$cfrom :: forall x. RemoteJSONVariableKey -> Rep RemoteJSONVariableKey x
Generic)
  deriving anyclass (Int -> RemoteJSONVariableKey -> Int
RemoteJSONVariableKey -> Int
(Int -> RemoteJSONVariableKey -> Int)
-> (RemoteJSONVariableKey -> Int) -> Hashable RemoteJSONVariableKey
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: RemoteJSONVariableKey -> Int
$chash :: RemoteJSONVariableKey -> Int
hashWithSalt :: Int -> RemoteJSONVariableKey -> Int
$chashWithSalt :: Int -> RemoteJSONVariableKey -> Int
Hashable)

-- | Resolves a `RemoteSchemaVariable` into a GraphQL `Variable`.
--
-- A `RemoteSchemaVariable` can either be a query variable (i.e. a variable
-- provided in the query) or it can be a `SessionPresetVariable` (in which case
-- we look up the value of the session variable and coerce it into the
-- appropriate type and then construct the GraphQL 'Variable').
--
-- NOTE: The session variable preset is a hard preset (i.e. if the session
-- variable doesn't exist, an error will be thrown).
--
-- The name of the GraphQL variable generated will be a GraphQL-ized version of
-- the session variable (i.e. '-' will be replaced with '_'), since session
-- variables are not valid GraphQL names.
--
-- Additionally, we need to handle partially traversed JSON values; likewise, we
-- create a new variable out of thin air.
--
-- For example, considering the following schema for a role:
--
--   input UserName {
--     firstName : String! @preset(value:"Foo")
--     lastName  : String!
--   }
--
--   type Query {
--     user(
--       user_id:   Int! @preset(value:"x-hasura-user-id")
--       user_name: UserName!
--     ): User
--   }
--
-- and the incoming query to the graphql-engine is:
--
--   query($foo: UserName!) {
--     user(user_name: $foo) { id name }
--   }
--
-- with variables:
--
--   { "foo": {"lastName": "Bar"} }
--
--
-- After resolving the session argument presets, the query that will be sent to
-- the remote server will be:
--
-- query ($x_hasura_user_id: Int!, $hasura_json_var_1: String!) {
--   user (user_id: $x_hasura_user_id, user_name: {firstName: "Foo", lastName: $hasura_json_var_1}) {
--     id
--     name
--   }
-- }
resolveRemoteVariable ::
  (MonadError QErr m) =>
  UserInfo ->
  RemoteSchemaVariable ->
  StateT RemoteJSONVariableMap m Variable
resolveRemoteVariable :: UserInfo
-> RemoteSchemaVariable -> StateT RemoteJSONVariableMap m Variable
resolveRemoteVariable UserInfo
userInfo = \case
  SessionPresetVariable SessionVariable
sessionVar Name
typeName SessionArgumentPresetInfo
presetInfo -> do
    SessionVariableValue
sessionVarVal <-
      Maybe SessionVariableValue
-> StateT RemoteJSONVariableMap m SessionVariableValue
-> StateT RemoteJSONVariableMap m SessionVariableValue
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (SessionVariable -> SessionVariables -> Maybe SessionVariableValue
getSessionVariableValue SessionVariable
sessionVar (SessionVariables -> Maybe SessionVariableValue)
-> SessionVariables -> Maybe SessionVariableValue
forall a b. (a -> b) -> a -> b
$ UserInfo -> SessionVariables
_uiSession UserInfo
userInfo) (StateT RemoteJSONVariableMap m SessionVariableValue
 -> StateT RemoteJSONVariableMap m SessionVariableValue)
-> StateT RemoteJSONVariableMap m SessionVariableValue
-> StateT RemoteJSONVariableMap m SessionVariableValue
forall a b. (a -> b) -> a -> b
$
        Code
-> SessionVariableValue
-> StateT RemoteJSONVariableMap m SessionVariableValue
forall (m :: * -> *) a.
QErrM m =>
Code -> SessionVariableValue -> m a
throw400 Code
NotFound (SessionVariableValue
 -> StateT RemoteJSONVariableMap m SessionVariableValue)
-> SessionVariableValue
-> StateT RemoteJSONVariableMap m SessionVariableValue
forall a b. (a -> b) -> a -> b
$ SessionVariable
sessionVar SessionVariable -> SessionVariableValue -> SessionVariableValue
forall t.
ToTxt t =>
t -> SessionVariableValue -> SessionVariableValue
<<> SessionVariableValue
" session variable expected, but not found"
    Name
varName <-
      SessionVariable -> Maybe Name
sessionVariableToGraphQLName SessionVariable
sessionVar
        Maybe Name
-> StateT RemoteJSONVariableMap m Name
-> StateT RemoteJSONVariableMap m Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` SessionVariableValue -> StateT RemoteJSONVariableMap m Name
forall (m :: * -> *) a. QErrM m => SessionVariableValue -> m a
throw500 (SessionVariableValue
"'" SessionVariableValue
-> SessionVariableValue -> SessionVariableValue
forall a. Semigroup a => a -> a -> a
<> SessionVariable -> SessionVariableValue
sessionVariableToText SessionVariable
sessionVar SessionVariableValue
-> SessionVariableValue -> SessionVariableValue
forall a. Semigroup a => a -> a -> a
<> SessionVariableValue
"' cannot be made into a valid GraphQL name")
    Value Void
coercedValue <-
      case SessionArgumentPresetInfo
presetInfo of
        SessionArgumentPresetInfo
SessionArgumentPresetScalar ->
          case Name -> SessionVariableValue
G.unName Name
typeName of
            SessionVariableValue
"Int" ->
              case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer) -> String -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ SessionVariableValue -> String
T.unpack SessionVariableValue
sessionVarVal of
                Maybe Integer
Nothing -> Code
-> SessionVariableValue
-> StateT RemoteJSONVariableMap m (Value Void)
forall (m :: * -> *) a.
QErrM m =>
Code -> SessionVariableValue -> m a
throw400 Code
CoercionError (SessionVariableValue
 -> StateT RemoteJSONVariableMap m (Value Void))
-> SessionVariableValue
-> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ SessionVariableValue
sessionVarVal SessionVariableValue
-> SessionVariableValue -> SessionVariableValue
forall t.
ToTxt t =>
t -> SessionVariableValue -> SessionVariableValue
<<> SessionVariableValue
" cannot be coerced into an Int value"
                Just Integer
i -> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Void -> StateT RemoteJSONVariableMap m (Value Void))
-> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ Integer -> Value Void
forall var. Integer -> Value var
G.VInt Integer
i
            SessionVariableValue
"Boolean" ->
              if
                  | SessionVariableValue
sessionVarVal SessionVariableValue -> [SessionVariableValue] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SessionVariableValue
"true", SessionVariableValue
"false"] ->
                    Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Void -> StateT RemoteJSONVariableMap m (Value Void))
-> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ Bool -> Value Void
forall var. Bool -> Value var
G.VBoolean (Bool -> Value Void) -> Bool -> Value Void
forall a b. (a -> b) -> a -> b
$ SessionVariableValue
"true" SessionVariableValue -> SessionVariableValue -> Bool
forall a. Eq a => a -> a -> Bool
== SessionVariableValue
sessionVarVal
                  | Bool
otherwise ->
                    Code
-> SessionVariableValue
-> StateT RemoteJSONVariableMap m (Value Void)
forall (m :: * -> *) a.
QErrM m =>
Code -> SessionVariableValue -> m a
throw400 Code
CoercionError (SessionVariableValue
 -> StateT RemoteJSONVariableMap m (Value Void))
-> SessionVariableValue
-> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ SessionVariableValue
sessionVarVal SessionVariableValue
-> SessionVariableValue -> SessionVariableValue
forall t.
ToTxt t =>
t -> SessionVariableValue -> SessionVariableValue
<<> SessionVariableValue
" cannot be coerced into a Boolean value"
            SessionVariableValue
"Float" ->
              case String -> Maybe Scientific
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Scientific) -> String -> Maybe Scientific
forall a b. (a -> b) -> a -> b
$ SessionVariableValue -> String
T.unpack SessionVariableValue
sessionVarVal of
                Maybe Scientific
Nothing ->
                  Code
-> SessionVariableValue
-> StateT RemoteJSONVariableMap m (Value Void)
forall (m :: * -> *) a.
QErrM m =>
Code -> SessionVariableValue -> m a
throw400 Code
CoercionError (SessionVariableValue
 -> StateT RemoteJSONVariableMap m (Value Void))
-> SessionVariableValue
-> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ SessionVariableValue
sessionVarVal SessionVariableValue
-> SessionVariableValue -> SessionVariableValue
forall t.
ToTxt t =>
t -> SessionVariableValue -> SessionVariableValue
<<> SessionVariableValue
" cannot be coerced into a Float value"
                Just Scientific
i -> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Void -> StateT RemoteJSONVariableMap m (Value Void))
-> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ Scientific -> Value Void
forall var. Scientific -> Value var
G.VFloat Scientific
i
            -- The `String`,`ID` and the default case all use the same code. But,
            -- it will be better to not merge all of them into the default case
            -- because it will be helpful to know how all the built-in scalars
            -- are handled
            SessionVariableValue
"String" -> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Void -> StateT RemoteJSONVariableMap m (Value Void))
-> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ SessionVariableValue -> Value Void
forall var. SessionVariableValue -> Value var
G.VString SessionVariableValue
sessionVarVal
            SessionVariableValue
"ID" -> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Void -> StateT RemoteJSONVariableMap m (Value Void))
-> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ SessionVariableValue -> Value Void
forall var. SessionVariableValue -> Value var
G.VString SessionVariableValue
sessionVarVal
            -- When we encounter a custom scalar, we just pass it as a string
            SessionVariableValue
_ -> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Void -> StateT RemoteJSONVariableMap m (Value Void))
-> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ SessionVariableValue -> Value Void
forall var. SessionVariableValue -> Value var
G.VString SessionVariableValue
sessionVarVal
        SessionArgumentPresetEnum HashSet EnumValue
enumVals -> do
          EnumValue
sessionVarEnumVal <-
            Name -> EnumValue
G.EnumValue
              (Name -> EnumValue)
-> StateT RemoteJSONVariableMap m Name
-> StateT RemoteJSONVariableMap m EnumValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
-> StateT RemoteJSONVariableMap m Name
-> StateT RemoteJSONVariableMap m Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing
                (SessionVariableValue -> Maybe Name
G.mkName SessionVariableValue
sessionVarVal)
                (Code -> SessionVariableValue -> StateT RemoteJSONVariableMap m Name
forall (m :: * -> *) a.
QErrM m =>
Code -> SessionVariableValue -> m a
throw400 Code
CoercionError (SessionVariableValue -> StateT RemoteJSONVariableMap m Name)
-> SessionVariableValue -> StateT RemoteJSONVariableMap m Name
forall a b. (a -> b) -> a -> b
$ SessionVariableValue
sessionVarVal SessionVariableValue
-> SessionVariableValue -> SessionVariableValue
forall t.
ToTxt t =>
t -> SessionVariableValue -> SessionVariableValue
<<> SessionVariableValue
" is not a valid GraphQL name")
          case EnumValue
sessionVarEnumVal EnumValue -> HashSet EnumValue -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet EnumValue
enumVals of
            Bool
True -> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Void -> StateT RemoteJSONVariableMap m (Value Void))
-> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ EnumValue -> Value Void
forall var. EnumValue -> Value var
G.VEnum EnumValue
sessionVarEnumVal
            Bool
False -> Code
-> SessionVariableValue
-> StateT RemoteJSONVariableMap m (Value Void)
forall (m :: * -> *) a.
QErrM m =>
Code -> SessionVariableValue -> m a
throw400 Code
CoercionError (SessionVariableValue
 -> StateT RemoteJSONVariableMap m (Value Void))
-> SessionVariableValue
-> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ EnumValue
sessionVarEnumVal EnumValue -> SessionVariableValue -> SessionVariableValue
forall t.
ToTxt t =>
t -> SessionVariableValue -> SessionVariableValue
<<> SessionVariableValue
" is not one of the valid enum values"
    -- nullability is false, because we treat presets as hard presets
    let variableGType :: GType
variableGType = Nullability -> Name -> GType
G.TypeNamed (Bool -> Nullability
G.Nullability Bool
False) Name
typeName
    Variable -> StateT RemoteJSONVariableMap m Variable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Variable -> StateT RemoteJSONVariableMap m Variable)
-> Variable -> StateT RemoteJSONVariableMap m Variable
forall a b. (a -> b) -> a -> b
$ VariableInfo -> GType -> InputValue Void -> Variable
Variable (Name -> VariableInfo
VIRequired Name
varName) GType
variableGType (Value Void -> InputValue Void
forall v. Value v -> InputValue v
GraphQLValue Value Void
coercedValue)
  RemoteJSONValue GType
gtype Value
jsonValue -> do
    let key :: RemoteJSONVariableKey
key = GType -> Value -> RemoteJSONVariableKey
RemoteJSONVariableKey GType
gtype Value
jsonValue
    HashMap RemoteJSONVariableKey Int
varMap <- (RemoteJSONVariableMap -> HashMap RemoteJSONVariableKey Int)
-> StateT
     RemoteJSONVariableMap m (HashMap RemoteJSONVariableKey Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RemoteJSONVariableMap -> HashMap RemoteJSONVariableKey Int
coerce
    Int
index <-
      RemoteJSONVariableKey
-> HashMap RemoteJSONVariableKey Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup RemoteJSONVariableKey
key HashMap RemoteJSONVariableKey Int
varMap Maybe Int
-> StateT RemoteJSONVariableMap m Int
-> StateT RemoteJSONVariableMap m Int
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` do
        let i :: Int
i = HashMap RemoteJSONVariableKey Int -> Int
forall k v. HashMap k v -> Int
Map.size HashMap RemoteJSONVariableKey Int
varMap Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        RemoteJSONVariableMap -> StateT RemoteJSONVariableMap m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (RemoteJSONVariableMap -> StateT RemoteJSONVariableMap m ())
-> (HashMap RemoteJSONVariableKey Int -> RemoteJSONVariableMap)
-> HashMap RemoteJSONVariableKey Int
-> StateT RemoteJSONVariableMap m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap RemoteJSONVariableKey Int -> RemoteJSONVariableMap
coerce (HashMap RemoteJSONVariableKey Int
 -> StateT RemoteJSONVariableMap m ())
-> HashMap RemoteJSONVariableKey Int
-> StateT RemoteJSONVariableMap m ()
forall a b. (a -> b) -> a -> b
$ RemoteJSONVariableKey
-> Int
-> HashMap RemoteJSONVariableKey Int
-> HashMap RemoteJSONVariableKey Int
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert RemoteJSONVariableKey
key Int
i HashMap RemoteJSONVariableKey Int
varMap
        Int -> StateT RemoteJSONVariableMap m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
    -- This should never fail.
    let varText :: SessionVariableValue
varText = SessionVariableValue
"hasura_json_var_" SessionVariableValue
-> SessionVariableValue -> SessionVariableValue
forall a. Semigroup a => a -> a -> a
<> Int -> SessionVariableValue
forall a. Show a => a -> SessionVariableValue
tshow Int
index
    Name
varName <-
      SessionVariableValue -> Maybe Name
G.mkName SessionVariableValue
varText
        Maybe Name
-> StateT RemoteJSONVariableMap m Name
-> StateT RemoteJSONVariableMap m Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` SessionVariableValue -> StateT RemoteJSONVariableMap m Name
forall (m :: * -> *) a. QErrM m => SessionVariableValue -> m a
throw500 (SessionVariableValue
"'" SessionVariableValue
-> SessionVariableValue -> SessionVariableValue
forall a. Semigroup a => a -> a -> a
<> SessionVariableValue
varText SessionVariableValue
-> SessionVariableValue -> SessionVariableValue
forall a. Semigroup a => a -> a -> a
<> SessionVariableValue
"' is not a valid GraphQL name")
    Variable -> StateT RemoteJSONVariableMap m Variable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Variable -> StateT RemoteJSONVariableMap m Variable)
-> Variable -> StateT RemoteJSONVariableMap m Variable
forall a b. (a -> b) -> a -> b
$ VariableInfo -> GType -> InputValue Void -> Variable
Variable (Name -> VariableInfo
VIRequired Name
varName) GType
gtype (InputValue Void -> Variable) -> InputValue Void -> Variable
forall a b. (a -> b) -> a -> b
$ Value -> InputValue Void
forall v. Value -> InputValue v
JSONValue Value
jsonValue
  QueryVariable Variable
variable -> Variable -> StateT RemoteJSONVariableMap m Variable
forall (f :: * -> *) a. Applicative f => a -> f a
pure Variable
variable

-- | TODO: Documentation.
resolveRemoteField ::
  (MonadError QErr m) =>
  UserInfo ->
  IR.RemoteSchemaRootField r RemoteSchemaVariable ->
  StateT RemoteJSONVariableMap m (IR.RemoteSchemaRootField r Variable)
resolveRemoteField :: UserInfo
-> RemoteSchemaRootField r RemoteSchemaVariable
-> StateT
     RemoteJSONVariableMap m (RemoteSchemaRootField r Variable)
resolveRemoteField UserInfo
userInfo = (RemoteSchemaVariable -> StateT RemoteJSONVariableMap m Variable)
-> RemoteSchemaRootField r RemoteSchemaVariable
-> StateT
     RemoteJSONVariableMap m (RemoteSchemaRootField r Variable)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (UserInfo
-> RemoteSchemaVariable -> StateT RemoteJSONVariableMap m Variable
forall (m :: * -> *).
MonadError QErr m =>
UserInfo
-> RemoteSchemaVariable -> StateT RemoteJSONVariableMap m Variable
resolveRemoteVariable UserInfo
userInfo)

-- | TODO: Documentation.
runVariableCache ::
  Monad m =>
  StateT RemoteJSONVariableMap m a ->
  m a
runVariableCache :: StateT RemoteJSONVariableMap m a -> m a
runVariableCache = (StateT RemoteJSONVariableMap m a -> RemoteJSONVariableMap -> m a)
-> RemoteJSONVariableMap -> StateT RemoteJSONVariableMap m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT RemoteJSONVariableMap m a -> RemoteJSONVariableMap -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT RemoteJSONVariableMap
forall a. Monoid a => a
mempty