{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Postgres Connection MonadTx
--
-- This module contains 'MonadTx' and related combinators.
--
-- 'MonadTx', a class which abstracts the 'QErr' in 'Q.TxE' via 'MonadError'.
--
-- The combinators are used for running, tracing, or otherwise perform database
-- related tasks. Please consult the individual documentation for more
-- information.
module Hasura.Backends.Postgres.Connection.MonadTx
  ( MonadTx (..),
    runTx,
    runTxWithCtx,
    runQueryTx,
    withUserInfo,
    withTraceContext,
    setHeadersTx,
    setTraceContextInTx,
    sessionInfoJsonExp,
    checkDbConnection,
    doesSchemaExist,
    doesTableExist,
    enablePgcryptoExtension,
    dropHdbCatalogSchema,
    ExtensionsSchema (..),
  )
where

import Control.Monad.Morph (hoist)
import Control.Monad.Trans.Control (MonadBaseControl (..))
import Control.Monad.Validate
import Data.Aeson
import Data.Aeson.Extended
import Data.Time.Clock.Compat ()
import Database.PG.Query qualified as Q
import Database.PG.Query.Connection qualified as Q
import Hasura.Backends.Postgres.Execute.Types as ET
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Base.Error
import Hasura.Base.Instances ()
import Hasura.Prelude
import Hasura.SQL.Types
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Test.QuickCheck.Instances.Semigroup ()
import Test.QuickCheck.Instances.Time ()

class (MonadError QErr m) => MonadTx m where
  liftTx :: Q.TxE QErr a -> m a

instance (MonadTx m) => MonadTx (StateT s m) where
  liftTx :: TxE QErr a -> StateT s m a
liftTx = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a)
-> (TxE QErr a -> m a) -> TxE QErr a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx

instance (MonadTx m) => MonadTx (ReaderT s m) where
  liftTx :: TxE QErr a -> ReaderT s m a
liftTx = m a -> ReaderT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT s m a)
-> (TxE QErr a -> m a) -> TxE QErr a -> ReaderT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx

instance (Monoid w, MonadTx m) => MonadTx (WriterT w m) where
  liftTx :: TxE QErr a -> WriterT w m a
liftTx = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (TxE QErr a -> m a) -> TxE QErr a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx

instance (MonadTx m) => MonadTx (ValidateT e m) where
  liftTx :: TxE QErr a -> ValidateT e m a
liftTx = m a -> ValidateT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ValidateT e m a)
-> (TxE QErr a -> m a) -> TxE QErr a -> ValidateT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx

instance (MonadTx m) => MonadTx (Tracing.TraceT m) where
  liftTx :: TxE QErr a -> TraceT m a
liftTx = m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TraceT m a)
-> (TxE QErr a -> m a) -> TxE QErr a -> TraceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx

instance (MonadIO m) => MonadTx (Q.TxET QErr m) where
  liftTx :: TxE QErr a -> TxET QErr m a
liftTx = (forall a. IO a -> m a) -> TxE QErr a -> TxET QErr m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Executes the given query in a transaction of the specified
-- mode, within the provided PGExecCtx.
runTx ::
  ( MonadIO m,
    MonadBaseControl IO m
  ) =>
  PGExecCtx ->
  Q.TxAccess ->
  Q.TxET QErr m a ->
  ExceptT QErr m a
runTx :: PGExecCtx -> TxAccess -> TxET QErr m a -> ExceptT QErr m a
runTx PGExecCtx
pgExecCtx = \case
  TxAccess
Q.ReadOnly -> PGExecCtx
-> forall (m :: * -> *) a.
   (MonadIO m, MonadBaseControl IO m) =>
   TxET QErr m a -> ExceptT QErr m a
_pecRunReadOnly PGExecCtx
pgExecCtx
  TxAccess
Q.ReadWrite -> PGExecCtx
-> forall (m :: * -> *) a.
   (MonadIO m, MonadBaseControl IO m) =>
   TxET QErr m a -> ExceptT QErr m a
_pecRunReadWrite PGExecCtx
pgExecCtx

runTxWithCtx ::
  ( MonadIO m,
    MonadBaseControl IO m,
    MonadError QErr m,
    Tracing.MonadTrace m,
    UserInfoM m
  ) =>
  PGExecCtx ->
  Q.TxAccess ->
  Q.TxET QErr m a ->
  m a
runTxWithCtx :: PGExecCtx -> TxAccess -> TxET QErr m a -> m a
runTxWithCtx PGExecCtx
pgExecCtx TxAccess
txAccess TxET QErr m a
tx = do
  TraceContext
traceCtx <- m TraceContext
forall (m :: * -> *). MonadTrace m => m TraceContext
Tracing.currentContext
  UserInfo
userInfo <- m UserInfo
forall (m :: * -> *). UserInfoM m => m UserInfo
askUserInfo
  m (Either QErr a) -> m a
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr a) -> m a) -> m (Either QErr a) -> m a
forall a b. (a -> b) -> a -> b
$
    ExceptT QErr m a -> m (Either QErr a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m a -> m (Either QErr a))
-> ExceptT QErr m a -> m (Either QErr a)
forall a b. (a -> b) -> a -> b
$
      PGExecCtx -> TxAccess -> TxET QErr m a -> ExceptT QErr m a
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
PGExecCtx -> TxAccess -> TxET QErr m a -> ExceptT QErr m a
runTx PGExecCtx
pgExecCtx TxAccess
txAccess (TxET QErr m a -> ExceptT QErr m a)
-> TxET QErr m a -> ExceptT QErr m a
forall a b. (a -> b) -> a -> b
$
        TraceContext -> TxET QErr m a -> TxET QErr m a
forall (m :: * -> *) a.
MonadIO m =>
TraceContext -> TxET QErr m a -> TxET QErr m a
withTraceContext TraceContext
traceCtx (TxET QErr m a -> TxET QErr m a) -> TxET QErr m a -> TxET QErr m a
forall a b. (a -> b) -> a -> b
$
          UserInfo -> TxET QErr m a -> TxET QErr m a
forall (m :: * -> *) a.
MonadIO m =>
UserInfo -> TxET QErr m a -> TxET QErr m a
withUserInfo UserInfo
userInfo TxET QErr m a
tx

-- | This runs the given set of statements (Tx) without wrapping them in BEGIN
-- and COMMIT. This should only be used for running a single statement query!
runQueryTx ::
  ( MonadIO m,
    MonadError QErr m
  ) =>
  PGExecCtx ->
  Q.TxET QErr IO a ->
  m a
runQueryTx :: PGExecCtx -> TxET QErr IO a -> m a
runQueryTx PGExecCtx
pgExecCtx TxET QErr IO a
tx =
  Either QErr a -> m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either QErr a -> m a) -> m (Either QErr a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either QErr a) -> m (Either QErr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QErr IO a -> IO (Either QErr a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr IO a -> IO (Either QErr a))
-> ExceptT QErr IO a -> IO (Either QErr a)
forall a b. (a -> b) -> a -> b
$ PGExecCtx -> TxET QErr IO a -> ExceptT QErr IO a
PGExecCtx
-> forall (m :: * -> *) a.
   (MonadIO m, MonadBaseControl IO m) =>
   TxET QErr m a -> ExceptT QErr m a
_pecRunReadNoTx PGExecCtx
pgExecCtx TxET QErr IO a
tx)

setHeadersTx :: (MonadIO m) => SessionVariables -> Q.TxET QErr m ()
setHeadersTx :: SessionVariables -> TxET QErr m ()
setHeadersTx SessionVariables
session = do
  (PGTxErr -> QErr) -> Query -> () -> Bool -> TxET QErr m ()
forall (m :: * -> *) r e.
(MonadIO m, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m ()
Q.unitQE PGTxErr -> QErr
defaultTxErrorHandler Query
setSess () Bool
False
  where
    setSess :: Query
setSess =
      Text -> Query
Q.fromText (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
        Text
"SET LOCAL \"hasura.user\" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SQLExp -> Text
forall a. ToSQL a => a -> Text
toSQLTxt (SessionVariables -> SQLExp
sessionInfoJsonExp SessionVariables
session)

sessionInfoJsonExp :: SessionVariables -> S.SQLExp
sessionInfoJsonExp :: SessionVariables -> SQLExp
sessionInfoJsonExp = Text -> SQLExp
S.SELit (Text -> SQLExp)
-> (SessionVariables -> Text) -> SessionVariables -> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariables -> Text
forall a. ToJSON a => a -> Text
encodeToStrictText

withUserInfo :: (MonadIO m) => UserInfo -> Q.TxET QErr m a -> Q.TxET QErr m a
withUserInfo :: UserInfo -> TxET QErr m a -> TxET QErr m a
withUserInfo UserInfo
uInfo TxET QErr m a
tx = SessionVariables -> TxET QErr m ()
forall (m :: * -> *).
MonadIO m =>
SessionVariables -> TxET QErr m ()
setHeadersTx (UserInfo -> SessionVariables
_uiSession UserInfo
uInfo) TxET QErr m () -> TxET QErr m a -> TxET QErr m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TxET QErr m a
tx

setTraceContextInTx :: (MonadIO m) => Tracing.TraceContext -> Q.TxET QErr m ()
setTraceContextInTx :: TraceContext -> TxET QErr m ()
setTraceContextInTx TraceContext
traceCtx = (PGTxErr -> QErr) -> Query -> () -> Bool -> TxET QErr m ()
forall (m :: * -> *) r e.
(MonadIO m, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m ()
Q.unitQE PGTxErr -> QErr
defaultTxErrorHandler Query
sql () Bool
False
  where
    sql :: Query
sql =
      Text -> Query
Q.fromText (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
        Text
"SET LOCAL \"hasura.tracecontext\" = "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SQLExp -> Text
forall a. ToSQL a => a -> Text
toSQLTxt (Text -> SQLExp
S.SELit (Text -> SQLExp)
-> (TraceContext -> Text) -> TraceContext -> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
forall a. ToJSON a => a -> Text
encodeToStrictText (Value -> Text) -> (TraceContext -> Value) -> TraceContext -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceContext -> Value
Tracing.injectEventContext (TraceContext -> SQLExp) -> TraceContext -> SQLExp
forall a b. (a -> b) -> a -> b
$ TraceContext
traceCtx)

-- | Inject the trace context as a transaction-local variable,
-- so that it can be picked up by any triggers (including event triggers).
withTraceContext ::
  (MonadIO m) =>
  Tracing.TraceContext ->
  Q.TxET QErr m a ->
  Q.TxET QErr m a
withTraceContext :: TraceContext -> TxET QErr m a -> TxET QErr m a
withTraceContext TraceContext
ctx TxET QErr m a
tx = TraceContext -> TxET QErr m ()
forall (m :: * -> *). MonadIO m => TraceContext -> TxET QErr m ()
setTraceContextInTx TraceContext
ctx TxET QErr m () -> TxET QErr m a -> TxET QErr m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TxET QErr m a
tx

deriving instance Tracing.MonadTrace m => Tracing.MonadTrace (Q.TxET e m)

checkDbConnection :: MonadTx m => m ()
checkDbConnection :: m ()
checkDbConnection = do
  Q.Discard () <- TxE QErr Discard -> m Discard
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr Discard -> m Discard) -> TxE QErr Discard -> m Discard
forall a b. (a -> b) -> a -> b
$ (PGTxErr -> QErr) -> Query -> () -> Bool -> TxE QErr Discard
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
Q.withQE PGTxErr -> QErr
defaultTxErrorHandler [Q.sql| SELECT 1; |] () Bool
False
  () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

doesSchemaExist :: MonadTx m => SchemaName -> m Bool
doesSchemaExist :: SchemaName -> m Bool
doesSchemaExist SchemaName
schemaName =
  TxE QErr Bool -> m Bool
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr Bool -> m Bool) -> TxE QErr Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
    (Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool)
-> (SingleRow (Identity Bool) -> Identity Bool)
-> SingleRow (Identity Bool)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity Bool) -> Identity Bool
forall a. SingleRow a -> a
Q.getRow)
      (SingleRow (Identity Bool) -> Bool)
-> TxET QErr IO (SingleRow (Identity Bool)) -> TxE QErr Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> Identity SchemaName
-> Bool
-> TxET QErr IO (SingleRow (Identity Bool))
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
Q.withQE
        PGTxErr -> QErr
defaultTxErrorHandler
        [Q.sql|
    SELECT EXISTS
    ( SELECT 1 FROM information_schema.schemata
      WHERE schema_name = $1
    ) |]
        (SchemaName -> Identity SchemaName
forall a. a -> Identity a
Identity SchemaName
schemaName)
        Bool
False

doesTableExist :: MonadTx m => SchemaName -> TableName -> m Bool
doesTableExist :: SchemaName -> TableName -> m Bool
doesTableExist SchemaName
schemaName TableName
tableName =
  TxE QErr Bool -> m Bool
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr Bool -> m Bool) -> TxE QErr Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
    (Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool)
-> (SingleRow (Identity Bool) -> Identity Bool)
-> SingleRow (Identity Bool)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity Bool) -> Identity Bool
forall a. SingleRow a -> a
Q.getRow)
      (SingleRow (Identity Bool) -> Bool)
-> TxET QErr IO (SingleRow (Identity Bool)) -> TxE QErr Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> (SchemaName, TableName)
-> Bool
-> TxET QErr IO (SingleRow (Identity Bool))
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
Q.withQE
        PGTxErr -> QErr
defaultTxErrorHandler
        [Q.sql|
    SELECT EXISTS
    ( SELECT 1 FROM pg_tables
      WHERE schemaname = $1 AND tablename = $2
    ) |]
        (SchemaName
schemaName, TableName
tableName)
        Bool
False

isExtensionAvailable :: MonadTx m => Text -> m Bool
isExtensionAvailable :: Text -> m Bool
isExtensionAvailable Text
extensionName =
  TxE QErr Bool -> m Bool
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr Bool -> m Bool) -> TxE QErr Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
    (Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool)
-> (SingleRow (Identity Bool) -> Identity Bool)
-> SingleRow (Identity Bool)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity Bool) -> Identity Bool
forall a. SingleRow a -> a
Q.getRow)
      (SingleRow (Identity Bool) -> Bool)
-> TxET QErr IO (SingleRow (Identity Bool)) -> TxE QErr Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> Identity Text
-> Bool
-> TxET QErr IO (SingleRow (Identity Bool))
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
Q.withQE
        PGTxErr -> QErr
defaultTxErrorHandler
        [Q.sql|
    SELECT EXISTS
    ( SELECT 1 FROM pg_catalog.pg_available_extensions
      WHERE name = $1
    ) |]
        (Text -> Identity Text
forall a. a -> Identity a
Identity Text
extensionName)
        Bool
False

enablePgcryptoExtension :: forall m. MonadTx m => ExtensionsSchema -> m ()
enablePgcryptoExtension :: ExtensionsSchema -> m ()
enablePgcryptoExtension (ExtensionsSchema Text
extensionsSchema) = do
  Bool
pgcryptoAvailable <- Text -> m Bool
forall (m :: * -> *). MonadTx m => Text -> m Bool
isExtensionAvailable Text
"pgcrypto"
  if Bool
pgcryptoAvailable
    then m ()
createPgcryptoExtension
    else
      Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
Unexpected (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        Text
"pgcrypto extension is required, but could not find the extension in the "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"PostgreSQL server. Please make sure this extension is available."
  where
    createPgcryptoExtension :: m ()
    createPgcryptoExtension :: m ()
createPgcryptoExtension =
      TxE QErr () -> m ()
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr () -> m ()) -> TxE QErr () -> m ()
forall a b. (a -> b) -> a -> b
$
        (PGTxErr -> QErr) -> Query -> () -> Bool -> TxE QErr ()
forall (m :: * -> *) r e.
(MonadIO m, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m ()
Q.unitQE
          PGTxErr -> QErr
needsPGCryptoError
          (Text -> Query
Q.fromText (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"CREATE EXTENSION IF NOT EXISTS pgcrypto SCHEMA " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
extensionsSchema)
          ()
          Bool
False
      where
        needsPGCryptoError :: PGTxErr -> QErr
needsPGCryptoError e :: PGTxErr
e@(Q.PGTxErr Text
_ [PrepArg]
_ Bool
_ PGErrInternal
err) =
          case PGErrInternal
err of
            Q.PGIUnexpected Text
_ -> QErr
requiredError
            Q.PGIStatement PGStmtErrDetail
pgErr -> case PGStmtErrDetail -> Maybe Text
Q.edStatusCode PGStmtErrDetail
pgErr of
              Just Text
"42501" -> Code -> Text -> QErr
err500 Code
PostgresError Text
permissionsMessage
              Maybe Text
_ -> QErr
requiredError
          where
            requiredError :: QErr
requiredError =
              (Code -> Text -> QErr
err500 Code
PostgresError Text
requiredMessage) {qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal (Value -> QErrExtra) -> Value -> QErrExtra
forall a b. (a -> b) -> a -> b
$ PGTxErr -> Value
forall a. ToJSON a => a -> Value
toJSON PGTxErr
e}
            requiredMessage :: Text
requiredMessage =
              Text
"pgcrypto extension is required, but it could not be created;"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" encountered unknown postgres error"
            permissionsMessage :: Text
permissionsMessage =
              Text
"pgcrypto extension is required, but the current user doesn’t have permission to"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" create it. Please grant superuser permission, or setup the initial schema via"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" https://hasura.io/docs/latest/graphql/core/deployment/postgres-permissions.html"

dropHdbCatalogSchema :: (MonadTx m) => m ()
dropHdbCatalogSchema :: m ()
dropHdbCatalogSchema =
  TxE QErr () -> m ()
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr () -> m ()) -> TxE QErr () -> m ()
forall a b. (a -> b) -> a -> b
$
    (PGTxErr -> QErr) -> TxET PGTxErr IO () -> TxE QErr ()
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> TxET e m a -> TxET e' m a
Q.catchE PGTxErr -> QErr
defaultTxErrorHandler (TxET PGTxErr IO () -> TxE QErr ())
-> TxET PGTxErr IO () -> TxE QErr ()
forall a b. (a -> b) -> a -> b
$
      -- This is where
      -- 1. Metadata storage:- Metadata and its stateful information stored
      -- 2. Postgres source:- Table event trigger related stuff & insert permission check function stored
      Query -> () -> Bool -> TxET PGTxErr IO ()
forall (m :: * -> *) r.
(MonadIO m, ToPrepArgs r) =>
Query -> r -> Bool -> TxT m ()
Q.unitQ Query
"DROP SCHEMA IF EXISTS hdb_catalog CASCADE" () Bool
False