{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hasura.Backends.Postgres.Instances.Transport
( runPGMutationTransaction,
)
where
import Data.Aeson qualified as J
import Data.ByteString qualified as B
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.Text.Extended
import Database.PG.Query qualified as Q
import Hasura.Backends.Postgres.Connection.MonadTx
import Hasura.Backends.Postgres.Execute.Subscription qualified as PGL
import Hasura.Backends.Postgres.Execute.Types
import Hasura.Backends.Postgres.Instances.Execute qualified as EQ
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Backends.Postgres.Translate.Select (PostgresAnnotatedFieldJSON)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Execute.Backend
import Hasura.GraphQL.Execute.Subscription.Plan
import Hasura.GraphQL.Logging
import Hasura.GraphQL.Namespace
( RootFieldAlias,
RootFieldMap,
mkUnNamespacedRootFieldAlias,
)
import Hasura.GraphQL.Transport.Backend
import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.Logging qualified as L
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.SQL.Backend
import Hasura.Server.Types (RequestId)
import Hasura.Session
import Hasura.Tracing
import Hasura.Tracing qualified as Tracing
instance
( Backend ('Postgres pgKind),
PostgresAnnotatedFieldJSON pgKind
) =>
BackendTransport ('Postgres pgKind)
where
runDBQuery :: RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres pgKind)
-> ExecutionMonad ('Postgres pgKind) EncJSON
-> Maybe (PreparedQuery ('Postgres pgKind))
-> m (DiffTime, EncJSON)
runDBQuery = RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres pgKind)
-> ExecutionMonad ('Postgres pgKind) EncJSON
-> Maybe (PreparedQuery ('Postgres pgKind))
-> m (DiffTime, EncJSON)
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadIO m, MonadError QErr m, MonadQueryLog m, MonadTrace m) =>
RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres pgKind)
-> TraceT (TxET QErr IO) EncJSON
-> Maybe PreparedSql
-> m (DiffTime, EncJSON)
runPGQuery
runDBMutation :: RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres pgKind)
-> ExecutionMonad ('Postgres pgKind) EncJSON
-> Maybe (PreparedQuery ('Postgres pgKind))
-> m (DiffTime, EncJSON)
runDBMutation = RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres pgKind)
-> ExecutionMonad ('Postgres pgKind) EncJSON
-> Maybe (PreparedQuery ('Postgres pgKind))
-> m (DiffTime, EncJSON)
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadIO m, MonadError QErr m, MonadQueryLog m, MonadTrace m) =>
RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres pgKind)
-> TraceT (TxET QErr IO) EncJSON
-> Maybe PreparedSql
-> m (DiffTime, EncJSON)
runPGMutation
runDBSubscription :: SourceConfig ('Postgres pgKind)
-> MultiplexedQuery ('Postgres pgKind)
-> [(CohortId, CohortVariables)]
-> m (DiffTime, Either QErr [(CohortId, ByteString)])
runDBSubscription = SourceConfig ('Postgres pgKind)
-> MultiplexedQuery ('Postgres pgKind)
-> [(CohortId, CohortVariables)]
-> m (DiffTime, Either QErr [(CohortId, ByteString)])
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadIO m =>
SourceConfig ('Postgres pgKind)
-> MultiplexedQuery ('Postgres pgKind)
-> [(CohortId, CohortVariables)]
-> m (DiffTime, Either QErr [(CohortId, ByteString)])
runPGSubscription
runDBStreamingSubscription :: SourceConfig ('Postgres pgKind)
-> MultiplexedQuery ('Postgres pgKind)
-> [(CohortId, CohortVariables)]
-> m (DiffTime,
Either QErr [(CohortId, ByteString, CursorVariableValues)])
runDBStreamingSubscription = SourceConfig ('Postgres pgKind)
-> MultiplexedQuery ('Postgres pgKind)
-> [(CohortId, CohortVariables)]
-> m (DiffTime,
Either QErr [(CohortId, ByteString, CursorVariableValues)])
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadIO m =>
SourceConfig ('Postgres pgKind)
-> MultiplexedQuery ('Postgres pgKind)
-> [(CohortId, CohortVariables)]
-> m (DiffTime,
Either QErr [(CohortId, ByteString, CursorVariableValues)])
runPGStreamingSubscription
runDBQueryExplain :: DBStepInfo ('Postgres pgKind) -> m EncJSON
runDBQueryExplain = DBStepInfo ('Postgres pgKind) -> m EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadIO m, MonadError QErr m) =>
DBStepInfo ('Postgres pgKind) -> m EncJSON
runPGQueryExplain
runPGQuery ::
( MonadIO m,
MonadError QErr m,
MonadQueryLog m,
MonadTrace m
) =>
RequestId ->
GQLReqUnparsed ->
RootFieldAlias ->
UserInfo ->
L.Logger L.Hasura ->
SourceConfig ('Postgres pgKind) ->
Tracing.TraceT (Q.TxET QErr IO) EncJSON ->
Maybe EQ.PreparedSql ->
m (DiffTime, EncJSON)
runPGQuery :: RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres pgKind)
-> TraceT (TxET QErr IO) EncJSON
-> Maybe PreparedSql
-> m (DiffTime, EncJSON)
runPGQuery RequestId
reqId GQLReqUnparsed
query RootFieldAlias
fieldName UserInfo
_userInfo Logger Hasura
logger SourceConfig ('Postgres pgKind)
sourceConfig TraceT (TxET QErr IO) EncJSON
tx Maybe PreparedSql
genSql = do
Logger Hasura -> QueryLog -> m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger (QueryLog -> m ()) -> QueryLog -> m ()
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
-> RootFieldAlias -> Maybe PreparedSql -> RequestId -> QueryLog
mkQueryLog GQLReqUnparsed
query RootFieldAlias
fieldName Maybe PreparedSql
genSql RequestId
reqId
m EncJSON -> m (DiffTime, EncJSON)
forall (m :: * -> *) a. MonadIO m => m a -> m (DiffTime, a)
withElapsedTime (m EncJSON -> m (DiffTime, EncJSON))
-> m EncJSON -> m (DiffTime, EncJSON)
forall a b. (a -> b) -> a -> b
$
Text -> m EncJSON -> m EncJSON
forall (m :: * -> *) a. MonadTrace m => Text -> m a -> m a
trace (Text
"Postgres Query for root field " Text -> RootFieldAlias -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RootFieldAlias
fieldName) (m EncJSON -> m EncJSON) -> m EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$
(TxET QErr IO (EncJSON, TracingMetadata)
-> m (EncJSON, TracingMetadata))
-> TraceT (TxET QErr IO) EncJSON -> m EncJSON
forall (n :: * -> *) (m :: * -> *) a b.
MonadTrace n =>
(m (a, TracingMetadata) -> n (b, TracingMetadata))
-> TraceT m a -> n b
Tracing.interpTraceT (PGExecCtx
-> TxET QErr IO (EncJSON, TracingMetadata)
-> m (EncJSON, TracingMetadata)
forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m) =>
PGExecCtx -> TxET QErr IO a -> m a
runQueryTx (PGExecCtx
-> TxET QErr IO (EncJSON, TracingMetadata)
-> m (EncJSON, TracingMetadata))
-> PGExecCtx
-> TxET QErr IO (EncJSON, TracingMetadata)
-> m (EncJSON, TracingMetadata)
forall a b. (a -> b) -> a -> b
$ PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) TraceT (TxET QErr IO) EncJSON
tx
runPGMutation ::
( MonadIO m,
MonadError QErr m,
MonadQueryLog m,
MonadTrace m
) =>
RequestId ->
GQLReqUnparsed ->
RootFieldAlias ->
UserInfo ->
L.Logger L.Hasura ->
SourceConfig ('Postgres pgKind) ->
Tracing.TraceT (Q.TxET QErr IO) EncJSON ->
Maybe EQ.PreparedSql ->
m (DiffTime, EncJSON)
runPGMutation :: RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres pgKind)
-> TraceT (TxET QErr IO) EncJSON
-> Maybe PreparedSql
-> m (DiffTime, EncJSON)
runPGMutation RequestId
reqId GQLReqUnparsed
query RootFieldAlias
fieldName UserInfo
userInfo Logger Hasura
logger SourceConfig ('Postgres pgKind)
sourceConfig TraceT (TxET QErr IO) EncJSON
tx Maybe PreparedSql
_genSql = do
Logger Hasura -> QueryLog -> m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger (QueryLog -> m ()) -> QueryLog -> m ()
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
-> RootFieldAlias -> Maybe PreparedSql -> RequestId -> QueryLog
mkQueryLog GQLReqUnparsed
query RootFieldAlias
fieldName Maybe PreparedSql
forall a. Maybe a
Nothing RequestId
reqId
TraceContext
ctx <- m TraceContext
forall (m :: * -> *). MonadTrace m => m TraceContext
Tracing.currentContext
m EncJSON -> m (DiffTime, EncJSON)
forall (m :: * -> *) a. MonadIO m => m a -> m (DiffTime, a)
withElapsedTime (m EncJSON -> m (DiffTime, EncJSON))
-> m EncJSON -> m (DiffTime, EncJSON)
forall a b. (a -> b) -> a -> b
$
Text -> m EncJSON -> m EncJSON
forall (m :: * -> *) a. MonadTrace m => Text -> m a -> m a
trace (Text
"Postgres Mutation for root field " Text -> RootFieldAlias -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RootFieldAlias
fieldName) (m EncJSON -> m EncJSON) -> m EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$
(TxET QErr IO (EncJSON, TracingMetadata)
-> m (EncJSON, TracingMetadata))
-> TraceT (TxET QErr IO) EncJSON -> m EncJSON
forall (n :: * -> *) (m :: * -> *) a b.
MonadTrace n =>
(m (a, TracingMetadata) -> n (b, TracingMetadata))
-> TraceT m a -> n b
Tracing.interpTraceT
( m (Either QErr (EncJSON, TracingMetadata))
-> m (EncJSON, TracingMetadata)
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr (EncJSON, TracingMetadata))
-> m (EncJSON, TracingMetadata))
-> (TxET QErr IO (EncJSON, TracingMetadata)
-> m (Either QErr (EncJSON, TracingMetadata)))
-> TxET QErr IO (EncJSON, TracingMetadata)
-> m (EncJSON, TracingMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either QErr (EncJSON, TracingMetadata))
-> m (Either QErr (EncJSON, TracingMetadata))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either QErr (EncJSON, TracingMetadata))
-> m (Either QErr (EncJSON, TracingMetadata)))
-> (TxET QErr IO (EncJSON, TracingMetadata)
-> IO (Either QErr (EncJSON, TracingMetadata)))
-> TxET QErr IO (EncJSON, TracingMetadata)
-> m (Either QErr (EncJSON, TracingMetadata))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT QErr IO (EncJSON, TracingMetadata)
-> IO (Either QErr (EncJSON, TracingMetadata))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
(ExceptT QErr IO (EncJSON, TracingMetadata)
-> IO (Either QErr (EncJSON, TracingMetadata)))
-> (TxET QErr IO (EncJSON, TracingMetadata)
-> ExceptT QErr IO (EncJSON, TracingMetadata))
-> TxET QErr IO (EncJSON, TracingMetadata)
-> IO (Either QErr (EncJSON, TracingMetadata))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGExecCtx
-> TxAccess
-> TxET QErr IO (EncJSON, TracingMetadata)
-> ExceptT QErr IO (EncJSON, TracingMetadata)
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
PGExecCtx -> TxAccess -> TxET QErr m a -> ExceptT QErr m a
runTx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) TxAccess
Q.ReadWrite
(TxET QErr IO (EncJSON, TracingMetadata)
-> ExceptT QErr IO (EncJSON, TracingMetadata))
-> (TxET QErr IO (EncJSON, TracingMetadata)
-> TxET QErr IO (EncJSON, TracingMetadata))
-> TxET QErr IO (EncJSON, TracingMetadata)
-> ExceptT QErr IO (EncJSON, TracingMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceContext
-> TxET QErr IO (EncJSON, TracingMetadata)
-> TxET QErr IO (EncJSON, TracingMetadata)
forall (m :: * -> *) a.
MonadIO m =>
TraceContext -> TxET QErr m a -> TxET QErr m a
withTraceContext TraceContext
ctx
(TxET QErr IO (EncJSON, TracingMetadata)
-> TxET QErr IO (EncJSON, TracingMetadata))
-> (TxET QErr IO (EncJSON, TracingMetadata)
-> TxET QErr IO (EncJSON, TracingMetadata))
-> TxET QErr IO (EncJSON, TracingMetadata)
-> TxET QErr IO (EncJSON, TracingMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo
-> TxET QErr IO (EncJSON, TracingMetadata)
-> TxET QErr IO (EncJSON, TracingMetadata)
forall (m :: * -> *) a.
MonadIO m =>
UserInfo -> TxET QErr m a -> TxET QErr m a
withUserInfo UserInfo
userInfo
)
TraceT (TxET QErr IO) EncJSON
tx
runPGSubscription ::
MonadIO m =>
SourceConfig ('Postgres pgKind) ->
MultiplexedQuery ('Postgres pgKind) ->
[(CohortId, CohortVariables)] ->
m (DiffTime, Either QErr [(CohortId, B.ByteString)])
runPGSubscription :: SourceConfig ('Postgres pgKind)
-> MultiplexedQuery ('Postgres pgKind)
-> [(CohortId, CohortVariables)]
-> m (DiffTime, Either QErr [(CohortId, ByteString)])
runPGSubscription SourceConfig ('Postgres pgKind)
sourceConfig MultiplexedQuery ('Postgres pgKind)
query [(CohortId, CohortVariables)]
variables =
m (Either QErr [(CohortId, ByteString)])
-> m (DiffTime, Either QErr [(CohortId, ByteString)])
forall (m :: * -> *) a. MonadIO m => m a -> m (DiffTime, a)
withElapsedTime (m (Either QErr [(CohortId, ByteString)])
-> m (DiffTime, Either QErr [(CohortId, ByteString)]))
-> m (Either QErr [(CohortId, ByteString)])
-> m (DiffTime, Either QErr [(CohortId, ByteString)])
forall a b. (a -> b) -> a -> b
$
ExceptT QErr m [(CohortId, ByteString)]
-> m (Either QErr [(CohortId, ByteString)])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m [(CohortId, ByteString)]
-> m (Either QErr [(CohortId, ByteString)]))
-> ExceptT QErr m [(CohortId, ByteString)]
-> m (Either QErr [(CohortId, ByteString)])
forall a b. (a -> b) -> a -> b
$ PGExecCtx
-> TxET QErr IO [(CohortId, ByteString)]
-> ExceptT QErr m [(CohortId, ByteString)]
forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m) =>
PGExecCtx -> TxET QErr IO a -> m a
runQueryTx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) (TxET QErr IO [(CohortId, ByteString)]
-> ExceptT QErr m [(CohortId, ByteString)])
-> TxET QErr IO [(CohortId, ByteString)]
-> ExceptT QErr m [(CohortId, ByteString)]
forall a b. (a -> b) -> a -> b
$ MultiplexedQuery
-> [(CohortId, CohortVariables)]
-> TxET QErr IO [(CohortId, ByteString)]
forall (m :: * -> *).
MonadTx m =>
MultiplexedQuery
-> [(CohortId, CohortVariables)] -> m [(CohortId, ByteString)]
PGL.executeMultiplexedQuery MultiplexedQuery
MultiplexedQuery ('Postgres pgKind)
query [(CohortId, CohortVariables)]
variables
runPGStreamingSubscription ::
MonadIO m =>
SourceConfig ('Postgres pgKind) ->
MultiplexedQuery ('Postgres pgKind) ->
[(CohortId, CohortVariables)] ->
m (DiffTime, Either QErr [(CohortId, B.ByteString, CursorVariableValues)])
runPGStreamingSubscription :: SourceConfig ('Postgres pgKind)
-> MultiplexedQuery ('Postgres pgKind)
-> [(CohortId, CohortVariables)]
-> m (DiffTime,
Either QErr [(CohortId, ByteString, CursorVariableValues)])
runPGStreamingSubscription SourceConfig ('Postgres pgKind)
sourceConfig MultiplexedQuery ('Postgres pgKind)
query [(CohortId, CohortVariables)]
variables =
m (Either QErr [(CohortId, ByteString, CursorVariableValues)])
-> m (DiffTime,
Either QErr [(CohortId, ByteString, CursorVariableValues)])
forall (m :: * -> *) a. MonadIO m => m a -> m (DiffTime, a)
withElapsedTime (m (Either QErr [(CohortId, ByteString, CursorVariableValues)])
-> m (DiffTime,
Either QErr [(CohortId, ByteString, CursorVariableValues)]))
-> m (Either QErr [(CohortId, ByteString, CursorVariableValues)])
-> m (DiffTime,
Either QErr [(CohortId, ByteString, CursorVariableValues)])
forall a b. (a -> b) -> a -> b
$
ExceptT QErr m [(CohortId, ByteString, CursorVariableValues)]
-> m (Either QErr [(CohortId, ByteString, CursorVariableValues)])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m [(CohortId, ByteString, CursorVariableValues)]
-> m (Either QErr [(CohortId, ByteString, CursorVariableValues)]))
-> ExceptT QErr m [(CohortId, ByteString, CursorVariableValues)]
-> m (Either QErr [(CohortId, ByteString, CursorVariableValues)])
forall a b. (a -> b) -> a -> b
$ do
[(CohortId, ByteString, AltJ CursorVariableValues)]
res <- PGExecCtx
-> TxET QErr IO [(CohortId, ByteString, AltJ CursorVariableValues)]
-> ExceptT
QErr m [(CohortId, ByteString, AltJ CursorVariableValues)]
forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m) =>
PGExecCtx -> TxET QErr IO a -> m a
runQueryTx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) (TxET QErr IO [(CohortId, ByteString, AltJ CursorVariableValues)]
-> ExceptT
QErr m [(CohortId, ByteString, AltJ CursorVariableValues)])
-> TxET QErr IO [(CohortId, ByteString, AltJ CursorVariableValues)]
-> ExceptT
QErr m [(CohortId, ByteString, AltJ CursorVariableValues)]
forall a b. (a -> b) -> a -> b
$ MultiplexedQuery
-> [(CohortId, CohortVariables)]
-> TxET QErr IO [(CohortId, ByteString, AltJ CursorVariableValues)]
forall (m :: * -> *).
MonadTx m =>
MultiplexedQuery
-> [(CohortId, CohortVariables)]
-> m [(CohortId, ByteString, AltJ CursorVariableValues)]
PGL.executeStreamingMultiplexedQuery MultiplexedQuery
MultiplexedQuery ('Postgres pgKind)
query [(CohortId, CohortVariables)]
variables
[(CohortId, ByteString, CursorVariableValues)]
-> ExceptT QErr m [(CohortId, ByteString, CursorVariableValues)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(CohortId, ByteString, CursorVariableValues)]
-> ExceptT QErr m [(CohortId, ByteString, CursorVariableValues)])
-> [(CohortId, ByteString, CursorVariableValues)]
-> ExceptT QErr m [(CohortId, ByteString, CursorVariableValues)]
forall a b. (a -> b) -> a -> b
$ [(CohortId, ByteString, AltJ CursorVariableValues)]
res [(CohortId, ByteString, AltJ CursorVariableValues)]
-> ((CohortId, ByteString, AltJ CursorVariableValues)
-> (CohortId, ByteString, CursorVariableValues))
-> [(CohortId, ByteString, CursorVariableValues)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(CohortId
cohortId, ByteString
cohortRes, AltJ CursorVariableValues
cursorVariableVals) -> (CohortId
cohortId, ByteString
cohortRes, AltJ CursorVariableValues -> CursorVariableValues
forall a. AltJ a -> a
Q.getAltJ AltJ CursorVariableValues
cursorVariableVals))
runPGQueryExplain ::
forall pgKind m.
( MonadIO m,
MonadError QErr m
) =>
DBStepInfo ('Postgres pgKind) ->
m EncJSON
runPGQueryExplain :: DBStepInfo ('Postgres pgKind) -> m EncJSON
runPGQueryExplain (DBStepInfo SourceName
_ SourceConfig ('Postgres pgKind)
sourceConfig Maybe (PreparedQuery ('Postgres pgKind))
_ ExecutionMonad ('Postgres pgKind) EncJSON
action) =
PGExecCtx -> TxET QErr IO EncJSON -> m EncJSON
forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m) =>
PGExecCtx -> TxET QErr IO a -> m a
runQueryTx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) (TxET QErr IO EncJSON -> m EncJSON)
-> TxET QErr IO EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Reporter
-> Text -> TraceT (TxET QErr IO) EncJSON -> TxET QErr IO EncJSON
forall (m :: * -> *) a.
MonadIO m =>
Reporter -> Text -> TraceT m a -> m a
runTraceTWithReporter Reporter
noReporter Text
"explain" (TraceT (TxET QErr IO) EncJSON -> TxET QErr IO EncJSON)
-> TraceT (TxET QErr IO) EncJSON -> TxET QErr IO EncJSON
forall a b. (a -> b) -> a -> b
$ TraceT (TxET QErr IO) EncJSON
ExecutionMonad ('Postgres pgKind) EncJSON
action
mkQueryLog ::
GQLReqUnparsed ->
RootFieldAlias ->
Maybe EQ.PreparedSql ->
RequestId ->
QueryLog
mkQueryLog :: GQLReqUnparsed
-> RootFieldAlias -> Maybe PreparedSql -> RequestId -> QueryLog
mkQueryLog GQLReqUnparsed
gqlQuery RootFieldAlias
fieldName Maybe PreparedSql
preparedSql RequestId
requestId =
GQLReqUnparsed
-> Maybe (RootFieldAlias, GeneratedQuery)
-> RequestId
-> QueryLogKind
-> QueryLog
QueryLog GQLReqUnparsed
gqlQuery ((RootFieldAlias
fieldName,) (GeneratedQuery -> (RootFieldAlias, GeneratedQuery))
-> Maybe GeneratedQuery -> Maybe (RootFieldAlias, GeneratedQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GeneratedQuery
generatedQuery) RequestId
requestId QueryLogKind
QueryLogKindDatabase
where
generatedQuery :: Maybe GeneratedQuery
generatedQuery =
Maybe PreparedSql
preparedSql Maybe PreparedSql
-> (PreparedSql -> GeneratedQuery) -> Maybe GeneratedQuery
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(EQ.PreparedSql Query
query PrepArgMap
args) ->
Text -> Value -> GeneratedQuery
GeneratedQuery (Query -> Text
Q.getQueryText Query
query) (IntMap Value -> Value
forall a. ToJSON a => a -> Value
J.toJSON (IntMap Value -> Value) -> IntMap Value -> Value
forall a b. (a -> b) -> a -> b
$ PGScalarValue -> Value
pgScalarValueToJson (PGScalarValue -> Value)
-> ((PrepArg, PGScalarValue) -> PGScalarValue)
-> (PrepArg, PGScalarValue)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrepArg, PGScalarValue) -> PGScalarValue
forall a b. (a, b) -> b
snd ((PrepArg, PGScalarValue) -> Value) -> PrepArgMap -> IntMap Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrepArgMap
args)
runPGMutationTransaction ::
( MonadIO m,
MonadError QErr m,
MonadQueryLog m,
MonadTrace m
) =>
RequestId ->
GQLReqUnparsed ->
UserInfo ->
L.Logger L.Hasura ->
SourceConfig ('Postgres pgKind) ->
RootFieldMap (DBStepInfo ('Postgres pgKind)) ->
m (DiffTime, RootFieldMap EncJSON)
runPGMutationTransaction :: RequestId
-> GQLReqUnparsed
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres pgKind)
-> RootFieldMap (DBStepInfo ('Postgres pgKind))
-> m (DiffTime, RootFieldMap EncJSON)
runPGMutationTransaction RequestId
reqId GQLReqUnparsed
query UserInfo
userInfo Logger Hasura
logger SourceConfig ('Postgres pgKind)
sourceConfig RootFieldMap (DBStepInfo ('Postgres pgKind))
mutations = do
Logger Hasura -> QueryLog -> m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger (QueryLog -> m ()) -> QueryLog -> m ()
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
-> RootFieldAlias -> Maybe PreparedSql -> RequestId -> QueryLog
mkQueryLog GQLReqUnparsed
query (Name -> RootFieldAlias
mkUnNamespacedRootFieldAlias Name
Name._transaction) Maybe PreparedSql
forall a. Maybe a
Nothing RequestId
reqId
TraceContext
ctx <- m TraceContext
forall (m :: * -> *). MonadTrace m => m TraceContext
Tracing.currentContext
m (RootFieldMap EncJSON) -> m (DiffTime, RootFieldMap EncJSON)
forall (m :: * -> *) a. MonadIO m => m a -> m (DiffTime, a)
withElapsedTime (m (RootFieldMap EncJSON) -> m (DiffTime, RootFieldMap EncJSON))
-> m (RootFieldMap EncJSON) -> m (DiffTime, RootFieldMap EncJSON)
forall a b. (a -> b) -> a -> b
$ do
(TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> m (RootFieldMap EncJSON, TracingMetadata))
-> TraceT (TxET QErr IO) (RootFieldMap EncJSON)
-> m (RootFieldMap EncJSON)
forall (n :: * -> *) (m :: * -> *) a b.
MonadTrace n =>
(m (a, TracingMetadata) -> n (b, TracingMetadata))
-> TraceT m a -> n b
Tracing.interpTraceT
( m (Either QErr (RootFieldMap EncJSON, TracingMetadata))
-> m (RootFieldMap EncJSON, TracingMetadata)
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr (RootFieldMap EncJSON, TracingMetadata))
-> m (RootFieldMap EncJSON, TracingMetadata))
-> (TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> m (Either QErr (RootFieldMap EncJSON, TracingMetadata)))
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> m (RootFieldMap EncJSON, TracingMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either QErr (RootFieldMap EncJSON, TracingMetadata))
-> m (Either QErr (RootFieldMap EncJSON, TracingMetadata))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either QErr (RootFieldMap EncJSON, TracingMetadata))
-> m (Either QErr (RootFieldMap EncJSON, TracingMetadata)))
-> (TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> IO (Either QErr (RootFieldMap EncJSON, TracingMetadata)))
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> m (Either QErr (RootFieldMap EncJSON, TracingMetadata))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> IO (Either QErr (RootFieldMap EncJSON, TracingMetadata))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
(ExceptT QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> IO (Either QErr (RootFieldMap EncJSON, TracingMetadata)))
-> (TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> ExceptT QErr IO (RootFieldMap EncJSON, TracingMetadata))
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> IO (Either QErr (RootFieldMap EncJSON, TracingMetadata))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGExecCtx
-> TxAccess
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> ExceptT QErr IO (RootFieldMap EncJSON, TracingMetadata)
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
PGExecCtx -> TxAccess -> TxET QErr m a -> ExceptT QErr m a
runTx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) TxAccess
Q.ReadWrite
(TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> ExceptT QErr IO (RootFieldMap EncJSON, TracingMetadata))
-> (TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata))
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> ExceptT QErr IO (RootFieldMap EncJSON, TracingMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceContext
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
forall (m :: * -> *) a.
MonadIO m =>
TraceContext -> TxET QErr m a -> TxET QErr m a
withTraceContext TraceContext
ctx
(TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata))
-> (TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata))
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
-> TxET QErr IO (RootFieldMap EncJSON, TracingMetadata)
forall (m :: * -> *) a.
MonadIO m =>
UserInfo -> TxET QErr m a -> TxET QErr m a
withUserInfo UserInfo
userInfo
)
(TraceT (TxET QErr IO) (RootFieldMap EncJSON)
-> m (RootFieldMap EncJSON))
-> TraceT (TxET QErr IO) (RootFieldMap EncJSON)
-> m (RootFieldMap EncJSON)
forall a b. (a -> b) -> a -> b
$ ((RootFieldAlias
-> DBStepInfo ('Postgres pgKind) -> TraceT (TxET QErr IO) EncJSON)
-> RootFieldMap (DBStepInfo ('Postgres pgKind))
-> TraceT (TxET QErr IO) (RootFieldMap EncJSON))
-> RootFieldMap (DBStepInfo ('Postgres pgKind))
-> (RootFieldAlias
-> DBStepInfo ('Postgres pgKind) -> TraceT (TxET QErr IO) EncJSON)
-> TraceT (TxET QErr IO) (RootFieldMap EncJSON)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (RootFieldAlias
-> DBStepInfo ('Postgres pgKind) -> TraceT (TxET QErr IO) EncJSON)
-> RootFieldMap (DBStepInfo ('Postgres pgKind))
-> TraceT (TxET QErr IO) (RootFieldMap EncJSON)
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b)
OMap.traverseWithKey RootFieldMap (DBStepInfo ('Postgres pgKind))
mutations \RootFieldAlias
fieldName DBStepInfo ('Postgres pgKind)
dbsi ->
Text
-> TraceT (TxET QErr IO) EncJSON -> TraceT (TxET QErr IO) EncJSON
forall (m :: * -> *) a. MonadTrace m => Text -> m a -> m a
trace (Text
"Postgres Mutation for root field " Text -> RootFieldAlias -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RootFieldAlias
fieldName) (TraceT (TxET QErr IO) EncJSON -> TraceT (TxET QErr IO) EncJSON)
-> TraceT (TxET QErr IO) EncJSON -> TraceT (TxET QErr IO) EncJSON
forall a b. (a -> b) -> a -> b
$ DBStepInfo ('Postgres pgKind)
-> ExecutionMonad ('Postgres pgKind) EncJSON
forall (b :: BackendType). DBStepInfo b -> ExecutionMonad b EncJSON
dbsiAction DBStepInfo ('Postgres pgKind)
dbsi