module Hasura.Backends.Postgres.Execute.ConnectionTemplate
  ( PrimaryTag (..),
    DefaultTag (..),
    ReadReplicasTag (..),
    ConnectionSetMemberTemplateContext (..),
    RequestContextHeaders (..),
    ConnectionSetTemplateContext,
    QueryContext (..),
    RequestContext (..),
    PostgresConnectionTemplateContext (..),
    PostgresResolvedConnectionTemplate (..),
    QueryOperationType (..),
    mkConnectionSetMemberTemplateContext,
    makeConnectionTemplateContext,
    makeRequestContext,
    runKritiEval,
  )
where

import Data.Aeson qualified as J
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.CaseInsensitive qualified as CI
import Data.HashMap.Strict qualified as HashMap
import Data.Text.Extended
import Hasura.Backends.Postgres.Connection.Settings
import Hasura.Prelude
import Hasura.Session (SessionVariables)
import Kriti.Eval qualified as Kriti
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Types qualified as HTTP

-- | This connection tag represents primary database connection
data PrimaryTag = PrimaryTag deriving (PrimaryTag -> PrimaryTag -> Bool
(PrimaryTag -> PrimaryTag -> Bool)
-> (PrimaryTag -> PrimaryTag -> Bool) -> Eq PrimaryTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrimaryTag -> PrimaryTag -> Bool
== :: PrimaryTag -> PrimaryTag -> Bool
$c/= :: PrimaryTag -> PrimaryTag -> Bool
/= :: PrimaryTag -> PrimaryTag -> Bool
Eq, Int -> PrimaryTag -> ShowS
[PrimaryTag] -> ShowS
PrimaryTag -> String
(Int -> PrimaryTag -> ShowS)
-> (PrimaryTag -> String)
-> ([PrimaryTag] -> ShowS)
-> Show PrimaryTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrimaryTag -> ShowS
showsPrec :: Int -> PrimaryTag -> ShowS
$cshow :: PrimaryTag -> String
show :: PrimaryTag -> String
$cshowList :: [PrimaryTag] -> ShowS
showList :: [PrimaryTag] -> ShowS
Show, (forall x. PrimaryTag -> Rep PrimaryTag x)
-> (forall x. Rep PrimaryTag x -> PrimaryTag) -> Generic PrimaryTag
forall x. Rep PrimaryTag x -> PrimaryTag
forall x. PrimaryTag -> Rep PrimaryTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrimaryTag -> Rep PrimaryTag x
from :: forall x. PrimaryTag -> Rep PrimaryTag x
$cto :: forall x. Rep PrimaryTag x -> PrimaryTag
to :: forall x. Rep PrimaryTag x -> PrimaryTag
Generic)

instance Hashable PrimaryTag

instance NFData PrimaryTag

primaryTagValue :: J.Value
primaryTagValue :: Value
primaryTagValue = Text -> Value
J.String Text
"PRIMARY"

instance J.ToJSON PrimaryTag where
  toJSON :: PrimaryTag -> Value
toJSON PrimaryTag
PrimaryTag = Value
primaryTagValue

instance J.FromJSON PrimaryTag where
  parseJSON :: Value -> Parser PrimaryTag
parseJSON Value
v
    | Value
v Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
primaryTagValue = PrimaryTag -> Parser PrimaryTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimaryTag
PrimaryTag
    | Bool
otherwise = String -> Parser PrimaryTag
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser PrimaryTag) -> String -> Parser PrimaryTag
forall a b. (a -> b) -> a -> b
$ String
"expected value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
primaryTagValue

-- | This connection tag represents default behaviour of database connections.
--
--   For example, if read replica is set, then it will redirect GQL queries to
--   read replicas and mutations to the primary connection
data DefaultTag = DefaultTag deriving (DefaultTag -> DefaultTag -> Bool
(DefaultTag -> DefaultTag -> Bool)
-> (DefaultTag -> DefaultTag -> Bool) -> Eq DefaultTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefaultTag -> DefaultTag -> Bool
== :: DefaultTag -> DefaultTag -> Bool
$c/= :: DefaultTag -> DefaultTag -> Bool
/= :: DefaultTag -> DefaultTag -> Bool
Eq, Int -> DefaultTag -> ShowS
[DefaultTag] -> ShowS
DefaultTag -> String
(Int -> DefaultTag -> ShowS)
-> (DefaultTag -> String)
-> ([DefaultTag] -> ShowS)
-> Show DefaultTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefaultTag -> ShowS
showsPrec :: Int -> DefaultTag -> ShowS
$cshow :: DefaultTag -> String
show :: DefaultTag -> String
$cshowList :: [DefaultTag] -> ShowS
showList :: [DefaultTag] -> ShowS
Show, (forall x. DefaultTag -> Rep DefaultTag x)
-> (forall x. Rep DefaultTag x -> DefaultTag) -> Generic DefaultTag
forall x. Rep DefaultTag x -> DefaultTag
forall x. DefaultTag -> Rep DefaultTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DefaultTag -> Rep DefaultTag x
from :: forall x. DefaultTag -> Rep DefaultTag x
$cto :: forall x. Rep DefaultTag x -> DefaultTag
to :: forall x. Rep DefaultTag x -> DefaultTag
Generic)

instance Hashable DefaultTag

instance NFData DefaultTag

defaultTagValue :: J.Value
defaultTagValue :: Value
defaultTagValue = Text -> Value
J.String Text
"DEFAULT"

instance J.ToJSON DefaultTag where
  toJSON :: DefaultTag -> Value
toJSON DefaultTag
DefaultTag = Value
defaultTagValue

instance J.FromJSON DefaultTag where
  parseJSON :: Value -> Parser DefaultTag
parseJSON Value
v
    | Value
v Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
defaultTagValue = DefaultTag -> Parser DefaultTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DefaultTag
DefaultTag
    | Bool
otherwise = String -> Parser DefaultTag
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser DefaultTag) -> String -> Parser DefaultTag
forall a b. (a -> b) -> a -> b
$ String
"expected value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
defaultTagValue

-- | This connection tag represents read replica database connection
data ReadReplicasTag = ReadReplicasTag deriving (ReadReplicasTag -> ReadReplicasTag -> Bool
(ReadReplicasTag -> ReadReplicasTag -> Bool)
-> (ReadReplicasTag -> ReadReplicasTag -> Bool)
-> Eq ReadReplicasTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReadReplicasTag -> ReadReplicasTag -> Bool
== :: ReadReplicasTag -> ReadReplicasTag -> Bool
$c/= :: ReadReplicasTag -> ReadReplicasTag -> Bool
/= :: ReadReplicasTag -> ReadReplicasTag -> Bool
Eq, Int -> ReadReplicasTag -> ShowS
[ReadReplicasTag] -> ShowS
ReadReplicasTag -> String
(Int -> ReadReplicasTag -> ShowS)
-> (ReadReplicasTag -> String)
-> ([ReadReplicasTag] -> ShowS)
-> Show ReadReplicasTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadReplicasTag -> ShowS
showsPrec :: Int -> ReadReplicasTag -> ShowS
$cshow :: ReadReplicasTag -> String
show :: ReadReplicasTag -> String
$cshowList :: [ReadReplicasTag] -> ShowS
showList :: [ReadReplicasTag] -> ShowS
Show, (forall x. ReadReplicasTag -> Rep ReadReplicasTag x)
-> (forall x. Rep ReadReplicasTag x -> ReadReplicasTag)
-> Generic ReadReplicasTag
forall x. Rep ReadReplicasTag x -> ReadReplicasTag
forall x. ReadReplicasTag -> Rep ReadReplicasTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReadReplicasTag -> Rep ReadReplicasTag x
from :: forall x. ReadReplicasTag -> Rep ReadReplicasTag x
$cto :: forall x. Rep ReadReplicasTag x -> ReadReplicasTag
to :: forall x. Rep ReadReplicasTag x -> ReadReplicasTag
Generic)

instance Hashable ReadReplicasTag

instance NFData ReadReplicasTag

readReplicasTagValue :: J.Value
readReplicasTagValue :: Value
readReplicasTagValue = Text -> Value
J.String Text
"READ_REPLICAS"

instance J.ToJSON ReadReplicasTag where
  toJSON :: ReadReplicasTag -> Value
toJSON ReadReplicasTag
ReadReplicasTag = Value
readReplicasTagValue

instance J.FromJSON ReadReplicasTag where
  parseJSON :: Value -> Parser ReadReplicasTag
parseJSON Value
v
    | Value
v Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
readReplicasTagValue = ReadReplicasTag -> Parser ReadReplicasTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReadReplicasTag
ReadReplicasTag
    | Bool
otherwise = String -> Parser ReadReplicasTag
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ReadReplicasTag)
-> String -> Parser ReadReplicasTag
forall a b. (a -> b) -> a -> b
$ String
"expected value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
readReplicasTagValue

-- | The connection_set template context type. Always encodes to "connection_set"
-- string value in template context.
data ConnectionSetTemplateContextType = ConnectionSetTemplateContextType
  deriving (ConnectionSetTemplateContextType
-> ConnectionSetTemplateContextType -> Bool
(ConnectionSetTemplateContextType
 -> ConnectionSetTemplateContextType -> Bool)
-> (ConnectionSetTemplateContextType
    -> ConnectionSetTemplateContextType -> Bool)
-> Eq ConnectionSetTemplateContextType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionSetTemplateContextType
-> ConnectionSetTemplateContextType -> Bool
== :: ConnectionSetTemplateContextType
-> ConnectionSetTemplateContextType -> Bool
$c/= :: ConnectionSetTemplateContextType
-> ConnectionSetTemplateContextType -> Bool
/= :: ConnectionSetTemplateContextType
-> ConnectionSetTemplateContextType -> Bool
Eq, Int -> ConnectionSetTemplateContextType -> ShowS
[ConnectionSetTemplateContextType] -> ShowS
ConnectionSetTemplateContextType -> String
(Int -> ConnectionSetTemplateContextType -> ShowS)
-> (ConnectionSetTemplateContextType -> String)
-> ([ConnectionSetTemplateContextType] -> ShowS)
-> Show ConnectionSetTemplateContextType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionSetTemplateContextType -> ShowS
showsPrec :: Int -> ConnectionSetTemplateContextType -> ShowS
$cshow :: ConnectionSetTemplateContextType -> String
show :: ConnectionSetTemplateContextType -> String
$cshowList :: [ConnectionSetTemplateContextType] -> ShowS
showList :: [ConnectionSetTemplateContextType] -> ShowS
Show, (forall x.
 ConnectionSetTemplateContextType
 -> Rep ConnectionSetTemplateContextType x)
-> (forall x.
    Rep ConnectionSetTemplateContextType x
    -> ConnectionSetTemplateContextType)
-> Generic ConnectionSetTemplateContextType
forall x.
Rep ConnectionSetTemplateContextType x
-> ConnectionSetTemplateContextType
forall x.
ConnectionSetTemplateContextType
-> Rep ConnectionSetTemplateContextType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ConnectionSetTemplateContextType
-> Rep ConnectionSetTemplateContextType x
from :: forall x.
ConnectionSetTemplateContextType
-> Rep ConnectionSetTemplateContextType x
$cto :: forall x.
Rep ConnectionSetTemplateContextType x
-> ConnectionSetTemplateContextType
to :: forall x.
Rep ConnectionSetTemplateContextType x
-> ConnectionSetTemplateContextType
Generic)

instance Hashable ConnectionSetTemplateContextType

instance NFData ConnectionSetTemplateContextType

instance J.ToJSON ConnectionSetTemplateContextType where
  toJSON :: ConnectionSetTemplateContextType -> Value
toJSON ConnectionSetTemplateContextType
ConnectionSetTemplateContextType = Text -> Value
J.String Text
"connection_set"

instance J.FromJSON ConnectionSetTemplateContextType where
  parseJSON :: Value -> Parser ConnectionSetTemplateContextType
parseJSON = String
-> (Text -> Parser ConnectionSetTemplateContextType)
-> Value
-> Parser ConnectionSetTemplateContextType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"ConnectionSetTemplateContextType" \case
    Text
"connection_set" -> ConnectionSetTemplateContextType
-> Parser ConnectionSetTemplateContextType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectionSetTemplateContextType
ConnectionSetTemplateContextType
    Text
t -> String -> Parser ConnectionSetTemplateContextType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ConnectionSetTemplateContextType)
-> String -> Parser ConnectionSetTemplateContextType
forall a b. (a -> b) -> a -> b
$ String
"unexpected type for connection set member " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t

-- | Data type for single member in connection_set for connection template context
data ConnectionSetMemberTemplateContext = ConnectionSetMemberTemplateContext
  { ConnectionSetMemberTemplateContext
-> ConnectionSetTemplateContextType
_cseType :: ConnectionSetTemplateContextType,
    ConnectionSetMemberTemplateContext
-> PostgresConnectionSetMemberName
_cseName :: PostgresConnectionSetMemberName
  }
  deriving (ConnectionSetMemberTemplateContext
-> ConnectionSetMemberTemplateContext -> Bool
(ConnectionSetMemberTemplateContext
 -> ConnectionSetMemberTemplateContext -> Bool)
-> (ConnectionSetMemberTemplateContext
    -> ConnectionSetMemberTemplateContext -> Bool)
-> Eq ConnectionSetMemberTemplateContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionSetMemberTemplateContext
-> ConnectionSetMemberTemplateContext -> Bool
== :: ConnectionSetMemberTemplateContext
-> ConnectionSetMemberTemplateContext -> Bool
$c/= :: ConnectionSetMemberTemplateContext
-> ConnectionSetMemberTemplateContext -> Bool
/= :: ConnectionSetMemberTemplateContext
-> ConnectionSetMemberTemplateContext -> Bool
Eq, Int -> ConnectionSetMemberTemplateContext -> ShowS
[ConnectionSetMemberTemplateContext] -> ShowS
ConnectionSetMemberTemplateContext -> String
(Int -> ConnectionSetMemberTemplateContext -> ShowS)
-> (ConnectionSetMemberTemplateContext -> String)
-> ([ConnectionSetMemberTemplateContext] -> ShowS)
-> Show ConnectionSetMemberTemplateContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionSetMemberTemplateContext -> ShowS
showsPrec :: Int -> ConnectionSetMemberTemplateContext -> ShowS
$cshow :: ConnectionSetMemberTemplateContext -> String
show :: ConnectionSetMemberTemplateContext -> String
$cshowList :: [ConnectionSetMemberTemplateContext] -> ShowS
showList :: [ConnectionSetMemberTemplateContext] -> ShowS
Show, (forall x.
 ConnectionSetMemberTemplateContext
 -> Rep ConnectionSetMemberTemplateContext x)
-> (forall x.
    Rep ConnectionSetMemberTemplateContext x
    -> ConnectionSetMemberTemplateContext)
-> Generic ConnectionSetMemberTemplateContext
forall x.
Rep ConnectionSetMemberTemplateContext x
-> ConnectionSetMemberTemplateContext
forall x.
ConnectionSetMemberTemplateContext
-> Rep ConnectionSetMemberTemplateContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ConnectionSetMemberTemplateContext
-> Rep ConnectionSetMemberTemplateContext x
from :: forall x.
ConnectionSetMemberTemplateContext
-> Rep ConnectionSetMemberTemplateContext x
$cto :: forall x.
Rep ConnectionSetMemberTemplateContext x
-> ConnectionSetMemberTemplateContext
to :: forall x.
Rep ConnectionSetMemberTemplateContext x
-> ConnectionSetMemberTemplateContext
Generic)

instance J.FromJSON ConnectionSetMemberTemplateContext where
  parseJSON :: Value -> Parser ConnectionSetMemberTemplateContext
parseJSON = Options -> Value -> Parser ConnectionSetMemberTemplateContext
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON Options
hasuraJSON

instance J.ToJSON ConnectionSetMemberTemplateContext where
  toJSON :: ConnectionSetMemberTemplateContext -> Value
toJSON = Options -> ConnectionSetMemberTemplateContext -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: ConnectionSetMemberTemplateContext -> Encoding
toEncoding = Options -> ConnectionSetMemberTemplateContext -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

instance Hashable ConnectionSetMemberTemplateContext

instance NFData ConnectionSetMemberTemplateContext

mkConnectionSetMemberTemplateContext :: PostgresConnectionSetMemberName -> ConnectionSetMemberTemplateContext
mkConnectionSetMemberTemplateContext :: PostgresConnectionSetMemberName
-> ConnectionSetMemberTemplateContext
mkConnectionSetMemberTemplateContext PostgresConnectionSetMemberName
memberName =
  ConnectionSetMemberTemplateContext
    { _cseType :: ConnectionSetTemplateContextType
_cseType = ConnectionSetTemplateContextType
ConnectionSetTemplateContextType,
      _cseName :: PostgresConnectionSetMemberName
_cseName = PostgresConnectionSetMemberName
memberName
    }

-- | Outcome of the connection template resolution
data PostgresResolvedConnectionTemplate
  = PCTODefault DefaultTag
  | PCTOPrimary PrimaryTag
  | PCTOReadReplicas ReadReplicasTag
  | PCTOConnectionSet PostgresConnectionSetMemberName
  deriving (PostgresResolvedConnectionTemplate
-> PostgresResolvedConnectionTemplate -> Bool
(PostgresResolvedConnectionTemplate
 -> PostgresResolvedConnectionTemplate -> Bool)
-> (PostgresResolvedConnectionTemplate
    -> PostgresResolvedConnectionTemplate -> Bool)
-> Eq PostgresResolvedConnectionTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostgresResolvedConnectionTemplate
-> PostgresResolvedConnectionTemplate -> Bool
== :: PostgresResolvedConnectionTemplate
-> PostgresResolvedConnectionTemplate -> Bool
$c/= :: PostgresResolvedConnectionTemplate
-> PostgresResolvedConnectionTemplate -> Bool
/= :: PostgresResolvedConnectionTemplate
-> PostgresResolvedConnectionTemplate -> Bool
Eq, Int -> PostgresResolvedConnectionTemplate -> ShowS
[PostgresResolvedConnectionTemplate] -> ShowS
PostgresResolvedConnectionTemplate -> String
(Int -> PostgresResolvedConnectionTemplate -> ShowS)
-> (PostgresResolvedConnectionTemplate -> String)
-> ([PostgresResolvedConnectionTemplate] -> ShowS)
-> Show PostgresResolvedConnectionTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostgresResolvedConnectionTemplate -> ShowS
showsPrec :: Int -> PostgresResolvedConnectionTemplate -> ShowS
$cshow :: PostgresResolvedConnectionTemplate -> String
show :: PostgresResolvedConnectionTemplate -> String
$cshowList :: [PostgresResolvedConnectionTemplate] -> ShowS
showList :: [PostgresResolvedConnectionTemplate] -> ShowS
Show, (forall x.
 PostgresResolvedConnectionTemplate
 -> Rep PostgresResolvedConnectionTemplate x)
-> (forall x.
    Rep PostgresResolvedConnectionTemplate x
    -> PostgresResolvedConnectionTemplate)
-> Generic PostgresResolvedConnectionTemplate
forall x.
Rep PostgresResolvedConnectionTemplate x
-> PostgresResolvedConnectionTemplate
forall x.
PostgresResolvedConnectionTemplate
-> Rep PostgresResolvedConnectionTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
PostgresResolvedConnectionTemplate
-> Rep PostgresResolvedConnectionTemplate x
from :: forall x.
PostgresResolvedConnectionTemplate
-> Rep PostgresResolvedConnectionTemplate x
$cto :: forall x.
Rep PostgresResolvedConnectionTemplate x
-> PostgresResolvedConnectionTemplate
to :: forall x.
Rep PostgresResolvedConnectionTemplate x
-> PostgresResolvedConnectionTemplate
Generic)

instance Hashable PostgresResolvedConnectionTemplate

instance NFData PostgresResolvedConnectionTemplate

instance J.FromJSON PostgresResolvedConnectionTemplate where
  parseJSON :: Value -> Parser PostgresResolvedConnectionTemplate
parseJSON Value
v =
    (PrimaryTag -> PostgresResolvedConnectionTemplate
PCTOPrimary (PrimaryTag -> PostgresResolvedConnectionTemplate)
-> Parser PrimaryTag -> Parser PostgresResolvedConnectionTemplate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser PrimaryTag
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v)
      Parser PostgresResolvedConnectionTemplate
-> Parser PostgresResolvedConnectionTemplate
-> Parser PostgresResolvedConnectionTemplate
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (DefaultTag -> PostgresResolvedConnectionTemplate
PCTODefault (DefaultTag -> PostgresResolvedConnectionTemplate)
-> Parser DefaultTag -> Parser PostgresResolvedConnectionTemplate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser DefaultTag
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v)
      Parser PostgresResolvedConnectionTemplate
-> Parser PostgresResolvedConnectionTemplate
-> Parser PostgresResolvedConnectionTemplate
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ReadReplicasTag -> PostgresResolvedConnectionTemplate
PCTOReadReplicas (ReadReplicasTag -> PostgresResolvedConnectionTemplate)
-> Parser ReadReplicasTag
-> Parser PostgresResolvedConnectionTemplate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ReadReplicasTag
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v)
      Parser PostgresResolvedConnectionTemplate
-> Parser PostgresResolvedConnectionTemplate
-> Parser PostgresResolvedConnectionTemplate
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PostgresConnectionSetMemberName
-> PostgresResolvedConnectionTemplate
PCTOConnectionSet (PostgresConnectionSetMemberName
 -> PostgresResolvedConnectionTemplate)
-> (ConnectionSetMemberTemplateContext
    -> PostgresConnectionSetMemberName)
-> ConnectionSetMemberTemplateContext
-> PostgresResolvedConnectionTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionSetMemberTemplateContext
-> PostgresConnectionSetMemberName
_cseName (ConnectionSetMemberTemplateContext
 -> PostgresResolvedConnectionTemplate)
-> Parser ConnectionSetMemberTemplateContext
-> Parser PostgresResolvedConnectionTemplate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ConnectionSetMemberTemplateContext
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v)

instance J.ToJSON PostgresResolvedConnectionTemplate where
  toJSON :: PostgresResolvedConnectionTemplate -> Value
toJSON PostgresResolvedConnectionTemplate
resolvedConnTemplate =
    let (Text
routingTo, Value
value) = case PostgresResolvedConnectionTemplate
resolvedConnTemplate of
          (PCTOPrimary PrimaryTag
_) -> (Text
"primary", Value
J.Null)
          (PCTODefault DefaultTag
_) -> (Text
"default", Value
J.Null)
          (PCTOReadReplicas ReadReplicasTag
_) -> (Text
"read_replicas", Value
J.Null)
          (PCTOConnectionSet PostgresConnectionSetMemberName
v) -> (Text
"connection_set", PostgresConnectionSetMemberName -> Value
forall a. ToJSON a => a -> Value
J.toJSON PostgresConnectionSetMemberName
v)
     in [Pair] -> Value
J.object [Key
"routing_to" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (Text
routingTo :: Text), Key
"value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Value
value]

-- | Headers information for the connection template context
data RequestContextHeaders = RequestContextHeaders (HashMap Text Text)
  deriving (Int -> RequestContextHeaders -> ShowS
[RequestContextHeaders] -> ShowS
RequestContextHeaders -> String
(Int -> RequestContextHeaders -> ShowS)
-> (RequestContextHeaders -> String)
-> ([RequestContextHeaders] -> ShowS)
-> Show RequestContextHeaders
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestContextHeaders -> ShowS
showsPrec :: Int -> RequestContextHeaders -> ShowS
$cshow :: RequestContextHeaders -> String
show :: RequestContextHeaders -> String
$cshowList :: [RequestContextHeaders] -> ShowS
showList :: [RequestContextHeaders] -> ShowS
Show, (forall x. RequestContextHeaders -> Rep RequestContextHeaders x)
-> (forall x. Rep RequestContextHeaders x -> RequestContextHeaders)
-> Generic RequestContextHeaders
forall x. Rep RequestContextHeaders x -> RequestContextHeaders
forall x. RequestContextHeaders -> Rep RequestContextHeaders x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RequestContextHeaders -> Rep RequestContextHeaders x
from :: forall x. RequestContextHeaders -> Rep RequestContextHeaders x
$cto :: forall x. Rep RequestContextHeaders x -> RequestContextHeaders
to :: forall x. Rep RequestContextHeaders x -> RequestContextHeaders
Generic)

instance J.FromJSON RequestContextHeaders where
  parseJSON :: Value -> Parser RequestContextHeaders
parseJSON = Options -> Value -> Parser RequestContextHeaders
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON Options
hasuraJSON

instance J.ToJSON RequestContextHeaders where
  toJSON :: RequestContextHeaders -> Value
toJSON = Options -> RequestContextHeaders -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: RequestContextHeaders -> Encoding
toEncoding = Options -> RequestContextHeaders -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

-- | Data type for connection_set for connection template context
newtype ConnectionSetTemplateContext = ConnectionSetTemplateContext {ConnectionSetTemplateContext
-> HashMap
     PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext
_getConnectionSet :: HashMap PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext}
  deriving (Int -> ConnectionSetTemplateContext -> ShowS
[ConnectionSetTemplateContext] -> ShowS
ConnectionSetTemplateContext -> String
(Int -> ConnectionSetTemplateContext -> ShowS)
-> (ConnectionSetTemplateContext -> String)
-> ([ConnectionSetTemplateContext] -> ShowS)
-> Show ConnectionSetTemplateContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionSetTemplateContext -> ShowS
showsPrec :: Int -> ConnectionSetTemplateContext -> ShowS
$cshow :: ConnectionSetTemplateContext -> String
show :: ConnectionSetTemplateContext -> String
$cshowList :: [ConnectionSetTemplateContext] -> ShowS
showList :: [ConnectionSetTemplateContext] -> ShowS
Show, NonEmpty ConnectionSetTemplateContext
-> ConnectionSetTemplateContext
ConnectionSetTemplateContext
-> ConnectionSetTemplateContext -> ConnectionSetTemplateContext
(ConnectionSetTemplateContext
 -> ConnectionSetTemplateContext -> ConnectionSetTemplateContext)
-> (NonEmpty ConnectionSetTemplateContext
    -> ConnectionSetTemplateContext)
-> (forall b.
    Integral b =>
    b -> ConnectionSetTemplateContext -> ConnectionSetTemplateContext)
-> Semigroup ConnectionSetTemplateContext
forall b.
Integral b =>
b -> ConnectionSetTemplateContext -> ConnectionSetTemplateContext
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ConnectionSetTemplateContext
-> ConnectionSetTemplateContext -> ConnectionSetTemplateContext
<> :: ConnectionSetTemplateContext
-> ConnectionSetTemplateContext -> ConnectionSetTemplateContext
$csconcat :: NonEmpty ConnectionSetTemplateContext
-> ConnectionSetTemplateContext
sconcat :: NonEmpty ConnectionSetTemplateContext
-> ConnectionSetTemplateContext
$cstimes :: forall b.
Integral b =>
b -> ConnectionSetTemplateContext -> ConnectionSetTemplateContext
stimes :: forall b.
Integral b =>
b -> ConnectionSetTemplateContext -> ConnectionSetTemplateContext
Semigroup, Semigroup ConnectionSetTemplateContext
ConnectionSetTemplateContext
Semigroup ConnectionSetTemplateContext
-> ConnectionSetTemplateContext
-> (ConnectionSetTemplateContext
    -> ConnectionSetTemplateContext -> ConnectionSetTemplateContext)
-> ([ConnectionSetTemplateContext] -> ConnectionSetTemplateContext)
-> Monoid ConnectionSetTemplateContext
[ConnectionSetTemplateContext] -> ConnectionSetTemplateContext
ConnectionSetTemplateContext
-> ConnectionSetTemplateContext -> ConnectionSetTemplateContext
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: ConnectionSetTemplateContext
mempty :: ConnectionSetTemplateContext
$cmappend :: ConnectionSetTemplateContext
-> ConnectionSetTemplateContext -> ConnectionSetTemplateContext
mappend :: ConnectionSetTemplateContext
-> ConnectionSetTemplateContext -> ConnectionSetTemplateContext
$cmconcat :: [ConnectionSetTemplateContext] -> ConnectionSetTemplateContext
mconcat :: [ConnectionSetTemplateContext] -> ConnectionSetTemplateContext
Monoid)

instance J.FromJSON ConnectionSetTemplateContext where
  parseJSON :: Value -> Parser ConnectionSetTemplateContext
parseJSON = String
-> (Object -> Parser ConnectionSetTemplateContext)
-> Value
-> Parser ConnectionSetTemplateContext
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"ConnectionSetTemplateContext" \Object
o -> do
    [(PostgresConnectionSetMemberName,
  ConnectionSetMemberTemplateContext)]
connections <-
      (Pair
 -> Parser
      (PostgresConnectionSetMemberName,
       ConnectionSetMemberTemplateContext))
-> [Pair]
-> Parser
     [(PostgresConnectionSetMemberName,
       ConnectionSetMemberTemplateContext)]
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) -> [a] -> f [b]
traverse
        ( \(Key
k, Value
v) -> do
            ConnectionSetMemberTemplateContext
connSetMember <- Value -> Parser ConnectionSetMemberTemplateContext
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v
            PostgresConnectionSetMemberName
connSetMemberName <- NonEmptyText -> PostgresConnectionSetMemberName
PostgresConnectionSetMemberName (NonEmptyText -> PostgresConnectionSetMemberName)
-> Parser NonEmptyText -> Parser PostgresConnectionSetMemberName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NonEmptyText
forall a. FromJSON a => Value -> Parser a
J.parseJSON (Key -> Value
forall a. ToJSON a => a -> Value
J.toJSON Key
k)
            (PostgresConnectionSetMemberName,
 ConnectionSetMemberTemplateContext)
-> Parser
     (PostgresConnectionSetMemberName,
      ConnectionSetMemberTemplateContext)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PostgresConnectionSetMemberName
connSetMemberName, ConnectionSetMemberTemplateContext
connSetMember)
        )
        (Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
o)
    ConnectionSetTemplateContext -> Parser ConnectionSetTemplateContext
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionSetTemplateContext
 -> Parser ConnectionSetTemplateContext)
-> ConnectionSetTemplateContext
-> Parser ConnectionSetTemplateContext
forall a b. (a -> b) -> a -> b
$ HashMap
  PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext
-> ConnectionSetTemplateContext
ConnectionSetTemplateContext ([(PostgresConnectionSetMemberName,
  ConnectionSetMemberTemplateContext)]
-> HashMap
     PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(PostgresConnectionSetMemberName,
  ConnectionSetMemberTemplateContext)]
connections)

instance J.ToJSON ConnectionSetTemplateContext where
  toJSON :: ConnectionSetTemplateContext -> Value
toJSON (ConnectionSetTemplateContext HashMap
  PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext
connections) =
    Object -> Value
J.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ HashMap Key Value -> Object
forall v. HashMap Key v -> KeyMap v
KM.fromHashMap (HashMap Key Value -> Object) -> HashMap Key Value -> Object
forall a b. (a -> b) -> a -> b
$ (ConnectionSetMemberTemplateContext -> Value)
-> HashMap Key ConnectionSetMemberTemplateContext
-> HashMap Key Value
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map (ConnectionSetMemberTemplateContext -> Value
forall a. ToJSON a => a -> Value
J.toJSON) ((PostgresConnectionSetMemberName -> Key)
-> HashMap
     PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext
-> HashMap Key ConnectionSetMemberTemplateContext
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HashMap.mapKeys (Text -> Key
K.fromText (Text -> Key)
-> (PostgresConnectionSetMemberName -> Text)
-> PostgresConnectionSetMemberName
-> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostgresConnectionSetMemberName -> Text
forall a. ToTxt a => a -> Text
toTxt) HashMap
  PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext
connections)

newtype QueryOperationType = QueryOperationType G.OperationType
  deriving (Int -> QueryOperationType -> ShowS
[QueryOperationType] -> ShowS
QueryOperationType -> String
(Int -> QueryOperationType -> ShowS)
-> (QueryOperationType -> String)
-> ([QueryOperationType] -> ShowS)
-> Show QueryOperationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryOperationType -> ShowS
showsPrec :: Int -> QueryOperationType -> ShowS
$cshow :: QueryOperationType -> String
show :: QueryOperationType -> String
$cshowList :: [QueryOperationType] -> ShowS
showList :: [QueryOperationType] -> ShowS
Show)

instance J.FromJSON QueryOperationType where
  parseJSON :: Value -> Parser QueryOperationType
parseJSON (J.String Text
"query") = QueryOperationType -> Parser QueryOperationType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationType -> QueryOperationType
QueryOperationType OperationType
G.OperationTypeQuery)
  parseJSON (J.String Text
"mutation") = QueryOperationType -> Parser QueryOperationType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationType -> QueryOperationType
QueryOperationType OperationType
G.OperationTypeMutation)
  parseJSON (J.String Text
"subscription") = QueryOperationType -> Parser QueryOperationType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationType -> QueryOperationType
QueryOperationType OperationType
G.OperationTypeSubscription)
  parseJSON Value
_ = String -> Parser QueryOperationType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"operation type can only be one of the following: query, mutation or subscription"

instance J.ToJSON QueryOperationType where
  toJSON :: QueryOperationType -> Value
toJSON (QueryOperationType OperationType
operationType) =
    Text -> Value
J.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case OperationType
operationType of
      OperationType
G.OperationTypeQuery -> Text
"query"
      OperationType
G.OperationTypeSubscription -> Text
"subscription"
      OperationType
G.OperationTypeMutation -> Text
"mutation"

-- | Query information (operation name and operation type) for connection
--   template context
data QueryContext = QueryContext
  { QueryContext -> Maybe Name
_qcOperationName :: Maybe G.Name,
    QueryContext -> QueryOperationType
_qcOperationType :: QueryOperationType
  }
  deriving (Int -> QueryContext -> ShowS
[QueryContext] -> ShowS
QueryContext -> String
(Int -> QueryContext -> ShowS)
-> (QueryContext -> String)
-> ([QueryContext] -> ShowS)
-> Show QueryContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryContext -> ShowS
showsPrec :: Int -> QueryContext -> ShowS
$cshow :: QueryContext -> String
show :: QueryContext -> String
$cshowList :: [QueryContext] -> ShowS
showList :: [QueryContext] -> ShowS
Show, (forall x. QueryContext -> Rep QueryContext x)
-> (forall x. Rep QueryContext x -> QueryContext)
-> Generic QueryContext
forall x. Rep QueryContext x -> QueryContext
forall x. QueryContext -> Rep QueryContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QueryContext -> Rep QueryContext x
from :: forall x. QueryContext -> Rep QueryContext x
$cto :: forall x. Rep QueryContext x -> QueryContext
to :: forall x. Rep QueryContext x -> QueryContext
Generic)

instance J.FromJSON QueryContext where
  parseJSON :: Value -> Parser QueryContext
parseJSON = Options -> Value -> Parser QueryContext
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

instance J.ToJSON QueryContext where
  toJSON :: QueryContext -> Value
toJSON = Options -> QueryContext -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}
  toEncoding :: QueryContext -> Encoding
toEncoding = Options -> QueryContext -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

-- | Request information for connection template context
data RequestContext = RequestContext
  { RequestContext -> RequestContextHeaders
_rcHeaders :: RequestContextHeaders,
    RequestContext -> SessionVariables
_rcSession :: SessionVariables,
    RequestContext -> Maybe QueryContext
_rcQuery :: Maybe QueryContext
  }
  deriving (Int -> RequestContext -> ShowS
[RequestContext] -> ShowS
RequestContext -> String
(Int -> RequestContext -> ShowS)
-> (RequestContext -> String)
-> ([RequestContext] -> ShowS)
-> Show RequestContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestContext -> ShowS
showsPrec :: Int -> RequestContext -> ShowS
$cshow :: RequestContext -> String
show :: RequestContext -> String
$cshowList :: [RequestContext] -> ShowS
showList :: [RequestContext] -> ShowS
Show, (forall x. RequestContext -> Rep RequestContext x)
-> (forall x. Rep RequestContext x -> RequestContext)
-> Generic RequestContext
forall x. Rep RequestContext x -> RequestContext
forall x. RequestContext -> Rep RequestContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RequestContext -> Rep RequestContext x
from :: forall x. RequestContext -> Rep RequestContext x
$cto :: forall x. Rep RequestContext x -> RequestContext
to :: forall x. Rep RequestContext x -> RequestContext
Generic)

instance J.FromJSON RequestContext where
  parseJSON :: Value -> Parser RequestContext
parseJSON = String
-> (Object -> Parser RequestContext)
-> Value
-> Parser RequestContext
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"RequestContext" ((Object -> Parser RequestContext)
 -> Value -> Parser RequestContext)
-> (Object -> Parser RequestContext)
-> Value
-> Parser RequestContext
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    RequestContextHeaders
headers <- Object
o Object -> Key -> Parser (Maybe RequestContextHeaders)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"headers" Parser (Maybe RequestContextHeaders)
-> RequestContextHeaders -> Parser RequestContextHeaders
forall a. Parser (Maybe a) -> a -> Parser a
J..!= (HashMap Text Text -> RequestContextHeaders
RequestContextHeaders HashMap Text Text
forall a. Monoid a => a
mempty)
    SessionVariables
sessionVars <- Object
o Object -> Key -> Parser (Maybe SessionVariables)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"session" Parser (Maybe SessionVariables)
-> SessionVariables -> Parser SessionVariables
forall a. Parser (Maybe a) -> a -> Parser a
J..!= SessionVariables
forall a. Monoid a => a
mempty
    Maybe QueryContext
queryContext <- Object
o Object -> Key -> Parser (Maybe QueryContext)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"query"
    RequestContext -> Parser RequestContext
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestContextHeaders
-> SessionVariables -> Maybe QueryContext -> RequestContext
RequestContext RequestContextHeaders
headers SessionVariables
sessionVars Maybe QueryContext
queryContext)

instance J.ToJSON RequestContext where
  toJSON :: RequestContext -> Value
toJSON = Options -> RequestContext -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

-- | The complete connection template context used for resolving connection
--   template
data PostgresConnectionTemplateContext = PostgresConnectionTemplateContext
  { PostgresConnectionTemplateContext -> RequestContext
_pctcRequest :: RequestContext,
    PostgresConnectionTemplateContext -> PrimaryTag
_pctcPrimary :: PrimaryTag,
    PostgresConnectionTemplateContext -> ReadReplicasTag
_pctcReadReplicas :: ReadReplicasTag,
    PostgresConnectionTemplateContext -> DefaultTag
_pctcDefault :: DefaultTag,
    PostgresConnectionTemplateContext -> ConnectionSetTemplateContext
_pctcConnectionSet :: ConnectionSetTemplateContext
  }
  deriving (Int -> PostgresConnectionTemplateContext -> ShowS
[PostgresConnectionTemplateContext] -> ShowS
PostgresConnectionTemplateContext -> String
(Int -> PostgresConnectionTemplateContext -> ShowS)
-> (PostgresConnectionTemplateContext -> String)
-> ([PostgresConnectionTemplateContext] -> ShowS)
-> Show PostgresConnectionTemplateContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostgresConnectionTemplateContext -> ShowS
showsPrec :: Int -> PostgresConnectionTemplateContext -> ShowS
$cshow :: PostgresConnectionTemplateContext -> String
show :: PostgresConnectionTemplateContext -> String
$cshowList :: [PostgresConnectionTemplateContext] -> ShowS
showList :: [PostgresConnectionTemplateContext] -> ShowS
Show, (forall x.
 PostgresConnectionTemplateContext
 -> Rep PostgresConnectionTemplateContext x)
-> (forall x.
    Rep PostgresConnectionTemplateContext x
    -> PostgresConnectionTemplateContext)
-> Generic PostgresConnectionTemplateContext
forall x.
Rep PostgresConnectionTemplateContext x
-> PostgresConnectionTemplateContext
forall x.
PostgresConnectionTemplateContext
-> Rep PostgresConnectionTemplateContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
PostgresConnectionTemplateContext
-> Rep PostgresConnectionTemplateContext x
from :: forall x.
PostgresConnectionTemplateContext
-> Rep PostgresConnectionTemplateContext x
$cto :: forall x.
Rep PostgresConnectionTemplateContext x
-> PostgresConnectionTemplateContext
to :: forall x.
Rep PostgresConnectionTemplateContext x
-> PostgresConnectionTemplateContext
Generic)

instance J.FromJSON PostgresConnectionTemplateContext where
  parseJSON :: Value -> Parser PostgresConnectionTemplateContext
parseJSON = Options -> Value -> Parser PostgresConnectionTemplateContext
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON Options
hasuraJSON

instance J.ToJSON PostgresConnectionTemplateContext where
  toJSON :: PostgresConnectionTemplateContext -> Value
toJSON = Options -> PostgresConnectionTemplateContext -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: PostgresConnectionTemplateContext -> Encoding
toEncoding = Options -> PostgresConnectionTemplateContext -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

-- | Construct template context
makeConnectionTemplateContext :: RequestContext -> [PostgresConnectionSetMemberName] -> PostgresConnectionTemplateContext
makeConnectionTemplateContext :: RequestContext
-> [PostgresConnectionSetMemberName]
-> PostgresConnectionTemplateContext
makeConnectionTemplateContext RequestContext
reqCtx [PostgresConnectionSetMemberName]
connectionSetMembers =
  RequestContext
-> PrimaryTag
-> ReadReplicasTag
-> DefaultTag
-> ConnectionSetTemplateContext
-> PostgresConnectionTemplateContext
PostgresConnectionTemplateContext
    RequestContext
reqCtx
    PrimaryTag
PrimaryTag
    ReadReplicasTag
ReadReplicasTag
    DefaultTag
DefaultTag
    ConnectionSetTemplateContext
connectionSet
  where
    connectionSet :: ConnectionSetTemplateContext
connectionSet =
      HashMap
  PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext
-> ConnectionSetTemplateContext
ConnectionSetTemplateContext (HashMap
   PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext
 -> ConnectionSetTemplateContext)
-> HashMap
     PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext
-> ConnectionSetTemplateContext
forall a b. (a -> b) -> a -> b
$ [(PostgresConnectionSetMemberName,
  ConnectionSetMemberTemplateContext)]
-> HashMap
     PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(PostgresConnectionSetMemberName,
   ConnectionSetMemberTemplateContext)]
 -> HashMap
      PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext)
-> [(PostgresConnectionSetMemberName,
     ConnectionSetMemberTemplateContext)]
-> HashMap
     PostgresConnectionSetMemberName ConnectionSetMemberTemplateContext
forall a b. (a -> b) -> a -> b
$ (PostgresConnectionSetMemberName
 -> (PostgresConnectionSetMemberName,
     ConnectionSetMemberTemplateContext))
-> [PostgresConnectionSetMemberName]
-> [(PostgresConnectionSetMemberName,
     ConnectionSetMemberTemplateContext)]
forall a b. (a -> b) -> [a] -> [b]
map (PostgresConnectionSetMemberName -> PostgresConnectionSetMemberName
forall a. a -> a
id (PostgresConnectionSetMemberName
 -> PostgresConnectionSetMemberName)
-> (PostgresConnectionSetMemberName
    -> ConnectionSetMemberTemplateContext)
-> PostgresConnectionSetMemberName
-> (PostgresConnectionSetMemberName,
    ConnectionSetMemberTemplateContext)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PostgresConnectionSetMemberName
-> ConnectionSetMemberTemplateContext
mkConnectionSetMemberTemplateContext) [PostgresConnectionSetMemberName]
connectionSetMembers

-- | We should move this to Data.Aeson.Kriti.Functions
runKritiEval :: PostgresConnectionTemplateContext -> KritiTemplate -> Either Kriti.EvalError J.Value
runKritiEval :: PostgresConnectionTemplateContext
-> KritiTemplate -> Either EvalError Value
runKritiEval PostgresConnectionTemplateContext
ktcContext (KritiTemplate Text
rawTemplate ValueExt
templateAST) = ByteString -> ValueExt -> [(Text, Value)] -> Either EvalError Value
Kriti.runEval ByteString
templateBS ValueExt
templateAST [(Text, Value)]
templateCtx
  where
    templateBS :: ByteString
templateBS = Text -> ByteString
txtToBs Text
rawTemplate
    templateCtx :: [(Text, Value)]
templateCtx = [(Text
"$", PostgresConnectionTemplateContext -> Value
forall a. ToJSON a => a -> Value
J.toJSON PostgresConnectionTemplateContext
ktcContext)]

makeRequestContext :: Maybe QueryContext -> [HTTP.Header] -> SessionVariables -> RequestContext
makeRequestContext :: Maybe QueryContext
-> [Header] -> SessionVariables -> RequestContext
makeRequestContext Maybe QueryContext
queryContext [Header]
reqHeaders SessionVariables
sessionVars =
  let reqHeaderHashMap :: HashMap Text Text
reqHeaderHashMap = [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, Text)] -> HashMap Text Text)
-> [(Text, Text)] -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$ (Header -> (Text, Text)) -> [Header] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(CI ByteString
hdrName, ByteString
hdrVal) -> (ByteString -> Text
bsToTxt (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
hdrName), ByteString -> Text
bsToTxt ByteString
hdrVal)) [Header]
reqHeaders
   in RequestContextHeaders
-> SessionVariables -> Maybe QueryContext -> RequestContext
RequestContext (HashMap Text Text -> RequestContextHeaders
RequestContextHeaders HashMap Text Text
reqHeaderHashMap) SessionVariables
sessionVars Maybe QueryContext
queryContext