{-# 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 HashMap
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.ResultCustomization
import Hasura.RemoteSchema.SchemaCache
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 Maybe (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 Maybe (InputValue Void)
varValue of
        Just (JSONValue Value
v) -> Value
v
        Just (GraphQLValue Value Void
val) -> Value Void -> Value
graphQLValueToJSON Value Void
val
        -- TODO: is this semantically correct RE: GraphQL spec June 2018, section 2.9.5?
        Maybe (InputValue Void)
Nothing -> Value
J.Null

unresolveVariables ::
  forall fragments.
  (Functor fragments) =>
  G.SelectionSet fragments Variable ->
  G.SelectionSet fragments G.Name
unresolveVariables :: forall (fragments :: * -> *).
Functor fragments =>
SelectionSet fragments Variable -> SelectionSet fragments Name
unresolveVariables =
  (Selection fragments Variable -> Selection fragments Name)
-> [Selection fragments Variable] -> [Selection fragments Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Variable -> Name)
-> Selection fragments Variable -> Selection fragments Name
forall a b.
(a -> b) -> Selection fragments a -> Selection fragments b
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) =>
  G.SelectionSet fragments var ->
  Set.HashSet var
collectVariables :: forall (fragments :: * -> *) var.
(Foldable fragments, Hashable var) =>
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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((var -> HashSet var) -> Selection fragments var -> HashSet var
forall m a. Monoid m => (a -> m) -> Selection fragments a -> m
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) =>
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
HashMap.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
HashMap.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 GH.GQLReq {Maybe (HashMap Name Value)
Maybe OperationName
TypedOperationDefinition NoFragments Name
_grQuery :: TypedOperationDefinition NoFragments Name
_grVariables :: Maybe (HashMap Name Value)
_grOperationName :: Maybe OperationName
_grOperationName :: Maybe OperationName
_grQuery :: TypedOperationDefinition NoFragments Name
_grVariables :: Maybe (HashMap Name Value)
..} 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
$c== :: RemoteJSONVariableMap -> RemoteJSONVariableMap -> Bool
== :: RemoteJSONVariableMap -> RemoteJSONVariableMap -> Bool
$c/= :: RemoteJSONVariableMap -> RemoteJSONVariableMap -> Bool
/= :: 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
$cmempty :: RemoteJSONVariableMap
mempty :: RemoteJSONVariableMap
$cmappend :: RemoteJSONVariableMap
-> RemoteJSONVariableMap -> RemoteJSONVariableMap
mappend :: RemoteJSONVariableMap
-> RemoteJSONVariableMap -> RemoteJSONVariableMap
$cmconcat :: [RemoteJSONVariableMap] -> RemoteJSONVariableMap
mconcat :: [RemoteJSONVariableMap] -> RemoteJSONVariableMap
Monoid, 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
$c<> :: RemoteJSONVariableMap
-> RemoteJSONVariableMap -> RemoteJSONVariableMap
<> :: RemoteJSONVariableMap
-> RemoteJSONVariableMap -> RemoteJSONVariableMap
$csconcat :: NonEmpty RemoteJSONVariableMap -> RemoteJSONVariableMap
sconcat :: NonEmpty RemoteJSONVariableMap -> RemoteJSONVariableMap
$cstimes :: forall b.
Integral b =>
b -> RemoteJSONVariableMap -> RemoteJSONVariableMap
stimes :: forall b.
Integral b =>
b -> 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
$c== :: RemoteJSONVariableKey -> RemoteJSONVariableKey -> Bool
== :: RemoteJSONVariableKey -> RemoteJSONVariableKey -> Bool
$c/= :: RemoteJSONVariableKey -> RemoteJSONVariableKey -> Bool
/= :: 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
$cfrom :: forall x. RemoteJSONVariableKey -> Rep RemoteJSONVariableKey x
from :: forall x. RemoteJSONVariableKey -> Rep RemoteJSONVariableKey x
$cto :: forall x. Rep RemoteJSONVariableKey x -> RemoteJSONVariableKey
to :: forall x. Rep RemoteJSONVariableKey x -> RemoteJSONVariableKey
Generic)
  deriving anyclass (Eq RemoteJSONVariableKey
Eq RemoteJSONVariableKey
-> (Int -> RemoteJSONVariableKey -> Int)
-> (RemoteJSONVariableKey -> Int)
-> Hashable RemoteJSONVariableKey
Int -> RemoteJSONVariableKey -> Int
RemoteJSONVariableKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> RemoteJSONVariableKey -> Int
hashWithSalt :: Int -> RemoteJSONVariableKey -> Int
$chash :: RemoteJSONVariableKey -> Int
hash :: 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 :: forall (m :: * -> *).
MonadError QErr m =>
UserInfo
-> RemoteSchemaVariable -> StateT RemoteJSONVariableMap m Variable
resolveRemoteVariable UserInfo
userInfo = \case
  SessionPresetVariable SessionVariable
sessionVar Name
typeName SessionArgumentPresetInfo
presetInfo -> do
    Text
sessionVarVal <-
      Maybe Text
-> StateT RemoteJSONVariableMap m Text
-> StateT RemoteJSONVariableMap m Text
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (SessionVariable -> SessionVariables -> Maybe Text
getSessionVariableValue SessionVariable
sessionVar (SessionVariables -> Maybe Text) -> SessionVariables -> Maybe Text
forall a b. (a -> b) -> a -> b
$ UserInfo -> SessionVariables
_uiSession UserInfo
userInfo)
        (StateT RemoteJSONVariableMap m Text
 -> StateT RemoteJSONVariableMap m Text)
-> StateT RemoteJSONVariableMap m Text
-> StateT RemoteJSONVariableMap m Text
forall a b. (a -> b) -> a -> b
$ Code -> Text -> StateT RemoteJSONVariableMap m Text
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound
        (Text -> StateT RemoteJSONVariableMap m Text)
-> Text -> StateT RemoteJSONVariableMap m Text
forall a b. (a -> b) -> a -> b
$ SessionVariable
sessionVar
        SessionVariable -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" 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` Text -> StateT RemoteJSONVariableMap m Name
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SessionVariable -> Text
sessionVariableToText SessionVariable
sessionVar Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' cannot be made into a valid GraphQL name")
    Value Void
coercedValue <-
      case SessionArgumentPresetInfo
presetInfo of
        SessionArgumentPresetInfo
SessionArgumentPresetScalar ->
          case Name -> Text
G.unName Name
typeName of
            Text
"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
$ Text -> String
T.unpack Text
sessionVarVal of
                Maybe Integer
Nothing -> Code -> Text -> StateT RemoteJSONVariableMap m (Value Void)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
CoercionError (Text -> StateT RemoteJSONVariableMap m (Value Void))
-> Text -> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ Text
sessionVarVal Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" cannot be coerced into an Int value"
                Just Integer
i -> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a. a -> StateT RemoteJSONVariableMap m a
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
            Text
"Boolean" ->
              if
                | Text
sessionVarVal Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"true", Text
"false"] ->
                    Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a. a -> StateT RemoteJSONVariableMap m a
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
$ Text
"true" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
sessionVarVal
                | Bool
otherwise ->
                    Code -> Text -> StateT RemoteJSONVariableMap m (Value Void)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
CoercionError (Text -> StateT RemoteJSONVariableMap m (Value Void))
-> Text -> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ Text
sessionVarVal Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" cannot be coerced into a Boolean value"
            Text
"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
$ Text -> String
T.unpack Text
sessionVarVal of
                Maybe Scientific
Nothing ->
                  Code -> Text -> StateT RemoteJSONVariableMap m (Value Void)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
CoercionError (Text -> StateT RemoteJSONVariableMap m (Value Void))
-> Text -> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ Text
sessionVarVal Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" cannot be coerced into a Float value"
                Just Scientific
i -> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a. a -> StateT RemoteJSONVariableMap m a
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
            Text
"String" -> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a. a -> StateT RemoteJSONVariableMap m a
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
$ Text -> Value Void
forall var. Text -> Value var
G.VString Text
sessionVarVal
            Text
"ID" -> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a. a -> StateT RemoteJSONVariableMap m a
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
$ Text -> Value Void
forall var. Text -> Value var
G.VString Text
sessionVarVal
            -- When we encounter a custom scalar, we just pass it as a string
            Text
_ -> Value Void -> StateT RemoteJSONVariableMap m (Value Void)
forall a. a -> StateT RemoteJSONVariableMap m a
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
$ Text -> Value Void
forall var. Text -> Value var
G.VString Text
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
                (Text -> Maybe Name
G.mkName Text
sessionVarVal)
                (Code -> Text -> StateT RemoteJSONVariableMap m Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
CoercionError (Text -> StateT RemoteJSONVariableMap m Name)
-> Text -> StateT RemoteJSONVariableMap m Name
forall a b. (a -> b) -> a -> b
$ Text
sessionVarVal Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" 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 a. a -> StateT RemoteJSONVariableMap m a
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 -> Text -> StateT RemoteJSONVariableMap m (Value Void)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
CoercionError (Text -> StateT RemoteJSONVariableMap m (Value Void))
-> Text -> StateT RemoteJSONVariableMap m (Value Void)
forall a b. (a -> b) -> a -> b
$ EnumValue
sessionVarEnumVal EnumValue -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" 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 a. a -> StateT RemoteJSONVariableMap m a
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 -> Maybe (InputValue Void) -> Variable
Variable (Name -> VariableInfo
VIRequired Name
varName) GType
variableGType (Maybe (InputValue Void) -> Variable)
-> Maybe (InputValue Void) -> Variable
forall a b. (a -> b) -> a -> b
$ InputValue Void -> Maybe (InputValue Void)
forall a. a -> Maybe a
Just (InputValue Void -> Maybe (InputValue Void))
-> InputValue Void -> Maybe (InputValue Void)
forall a b. (a -> b) -> a -> b
$ 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
forall a b. Coercible a b => a -> b
coerce
    Int
index <-
      RemoteJSONVariableKey
-> HashMap RemoteJSONVariableKey Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.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
HashMap.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
forall a b. Coercible a b => a -> b
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
HashMap.insert RemoteJSONVariableKey
key Int
i HashMap RemoteJSONVariableKey Int
varMap
        Int -> StateT RemoteJSONVariableMap m Int
forall a. a -> StateT RemoteJSONVariableMap m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
    -- This should never fail.
    let varText :: Text
varText = Text
"hasura_json_var_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
index
    Name
varName <-
      Text -> Maybe Name
G.mkName Text
varText
        Maybe Name
-> StateT RemoteJSONVariableMap m Name
-> StateT RemoteJSONVariableMap m Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> StateT RemoteJSONVariableMap m Name
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
varText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' is not a valid GraphQL name")
    Variable -> StateT RemoteJSONVariableMap m Variable
forall a. a -> StateT RemoteJSONVariableMap m a
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 -> Maybe (InputValue Void) -> Variable
Variable (Name -> VariableInfo
VIRequired Name
varName) GType
gtype (Maybe (InputValue Void) -> Variable)
-> Maybe (InputValue Void) -> Variable
forall a b. (a -> b) -> a -> b
$ InputValue Void -> Maybe (InputValue Void)
forall a. a -> Maybe a
Just (InputValue Void -> Maybe (InputValue Void))
-> InputValue Void -> Maybe (InputValue Void)
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 a. a -> StateT RemoteJSONVariableMap m a
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 :: forall (m :: * -> *) r.
MonadError QErr m =>
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> RemoteSchemaRootField r a -> f (RemoteSchemaRootField r 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 :: forall (m :: * -> *) a.
Monad m =>
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