Repository: hasura/graphql-engine
File: server/src-lib/Hasura/Db.hs (Haskell)

Code before:
  liftTx = lift . liftTx
instance (MonadTx m) => MonadTx (ValidateT e m) where
  liftTx = lift . liftTx

-- | Like 'Q.TxE', but defers acquiring a Postgres connection until the first execution of 'liftTx'.
-- If no call to 'liftTx' is ever reached (i.e. a successful result is returned or an error is
-- raised before ever executing a query), no connection is ever acquired.
--
-- This is useful for certain code paths that only conditionally need database access. For example,
-- although most queries will eventually hit Postgres, introspection queries or queries that
-- exclusively use remote schemas never will; using 'LazyTx' keeps those branches from unnecessarily
-- allocating a connection.
data LazyTx e a
  = LTErr !e
  | LTNoTx !a
  | LTTx !(Q.TxE e a)

lazyTxToQTx :: LazyTx e a -> Q.TxE e a
lazyTxToQTx = \case
  LTErr e  -> throwError e
  LTNoTx r -> return r
  LTTx tx  -> tx

runLazyTx
  :: PGExecCtx
  -> Maybe Q.TxAccess
  -> LazyTx QErr a -> ExceptT QErr IO a
runLazyTx (PGExecCtx pgPool txIso) txAccess = \case
  LTErr e  -> throwError e
  LTNoTx a -> return a
  LTTx tx  -> Q.runTx pgPool (txIso, txAccess) tx

runLazyTx'
  :: PGExecCtx -> LazyTx QErr a -> ExceptT QErr IO a
runLazyTx' (PGExecCtx pgPool _) = \case
  LTErr e  -> throwError e
  LTNoTx a -> return a
  LTTx tx  -> Q.runTx' pgPool tx

type RespTx = Q.TxE QErr EncJSON
type LazyRespTx = LazyTx QErr EncJSON

setHeadersTx :: UserVars -> Q.TxE QErr ()
setHeadersTx uVars =
  Q.unitQE defaultTxErrorHandler setSess () False
  where
    setSess = Q.fromText $
      "SET LOCAL \"hasura.user\" = " <>
      pgFmtLit (J.encodeToStrictText uVars)

defaultTxErrorHandler :: Q.PGTxErr -> QErr

Review comment (suggestion):
I get that the underlying API allows `Nothing`, which presumably means “use the value of the `default_transaction_read_only` configuration parameter, but it seems like it would be clearer to accept a `Q.TxAccess` directly here and just pass `Q.ReadWrite` instead of `Nothing`. That seems more correct anyway, since the places where we use `Nothing` currently need `Q.ReadWrite` access.

Code after:
  liftTx = lift . liftTx
instance (MonadTx m) => MonadTx (ValidateT e m) where
  liftTx = lift . liftTx

-- | Like 'Q.TxE', but defers acquiring a Postgres connection until the first execution of 'liftTx'.
-- If no call to 'liftTx' is ever reached (i.e. a successful result is returned or an error is
-- raised before ever executing a query), no connection is ever acquired.
--
-- This is useful for certain code paths that only conditionally need database access. For example,
-- although most queries will eventually hit Postgres, introspection queries or queries that
-- exclusively use remote schemas never will; using 'LazyTx' keeps those branches from unnecessarily
-- allocating a connection.
data LazyTx e a
  = LTErr !e
  | LTNoTx !a
  | LTTx !(Q.TxE e a)

lazyTxToQTx :: LazyTx e a -> Q.TxE e a
lazyTxToQTx = \case
  LTErr e  -> throwError e
  LTNoTx r -> return r
  LTTx tx  -> tx

runLazyTx
  :: PGExecCtx
  -> Q.TxAccess
  -> LazyTx QErr a -> ExceptT QErr IO a
runLazyTx (PGExecCtx pgPool txIso) txAccess = \case
  LTErr e  -> throwError e
  LTNoTx a -> return a
  LTTx tx  -> Q.runTx pgPool (txIso, Just txAccess) tx

runLazyTx'
  :: PGExecCtx -> LazyTx QErr a -> ExceptT QErr IO a
runLazyTx' (PGExecCtx pgPool _) = \case
  LTErr e  -> throwError e
  LTNoTx a -> return a
  LTTx tx  -> Q.runTx' pgPool tx

type RespTx = Q.TxE QErr EncJSON
type LazyRespTx = LazyTx QErr EncJSON

setHeadersTx :: UserVars -> Q.TxE QErr ()
setHeadersTx uVars =
  Q.unitQE defaultTxErrorHandler setSess () False
  where
    setSess = Q.fromText $
      "SET LOCAL \"hasura.user\" = " <>
      pgFmtLit (J.encodeToStrictText uVars)

defaultTxErrorHandler :: Q.PGTxErr -> QErr