{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Postgres DDL Source
--
-- A Source is a connected database. One can have multiple sources of the same
-- kind (e.g. Postgres).
--
-- This module provides ways to fetch, update, and deal with table and function
-- metadata and hdb_catalog migrations for a Postgres Source.
--
--    NOTE: Please have a look at the `server/documentation/migration-guidelines.md`
--       before adding any new migration if you haven't already looked at it.
module Hasura.Backends.Postgres.DDL.Source
  ( ToMetadataFetchQuery,
    FetchTableMetadata (..),
    FetchFunctionMetadata (..),
    prepareCatalog,
    postDropSourceHook,
    resolveDatabaseMetadata,
    resolveSourceConfig,
    logPGSourceCatalogMigrationLockedQueries,
  )
where

import Control.Concurrent.Extended (sleep)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson (ToJSON, toJSON)
import Data.Aeson.TH
import Data.Environment qualified as Env
import Data.FileEmbed (makeRelativeToProject)
import Data.HashMap.Strict qualified as HM
import Data.HashMap.Strict.Extended qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashSet qualified as Set
import Data.List.Extended qualified as LE
import Data.List.NonEmpty qualified as NE
import Data.Time.Clock (UTCTime, getCurrentTime)
import Database.PG.Query qualified as Q
import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.DDL.EventTrigger (dropTriggerQ)
import Hasura.Backends.Postgres.DDL.Source.Version
import Hasura.Backends.Postgres.SQL.Types hiding (FunctionName)
import Hasura.Backends.Postgres.Types.ComputedField
import Hasura.Base.Error
import Hasura.Logging
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.EventTrigger (RecreateEventTriggers (..))
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.Metadata (SourceMetadata (..), TableMetadata (..), _cfmDefinition)
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Hasura.Server.Migrate.Internal
import Hasura.Server.Migrate.Version (MetadataCatalogVersion (..))
import Language.Haskell.TH.Lib qualified as TH
import Language.Haskell.TH.Syntax qualified as TH

-- | We differentiate the handling of metadata between Citus, Cockroach and Vanilla
-- Postgres because Citus imposes limitations on the types of joins that it
-- permits, which then limits the types of relations that we can track.
class ToMetadataFetchQuery (pgKind :: PostgresKind) where
  tableMetadata :: Q.Query

instance ToMetadataFetchQuery 'Vanilla where
  tableMetadata :: Query
tableMetadata = $(makeRelativeToProject "src-rsr/pg_table_metadata.sql" >>= Q.sqlFromFile)

instance ToMetadataFetchQuery 'Citus where
  tableMetadata :: Query
tableMetadata = $(makeRelativeToProject "src-rsr/citus_table_metadata.sql" >>= Q.sqlFromFile)

instance ToMetadataFetchQuery 'Cockroach where
  tableMetadata :: Query
tableMetadata = $(makeRelativeToProject "src-rsr/cockroach_table_metadata.sql" >>= Q.sqlFromFile)

resolveSourceConfig ::
  (MonadIO m, MonadResolveSource m) =>
  Logger Hasura ->
  SourceName ->
  PostgresConnConfiguration ->
  BackendSourceKind ('Postgres pgKind) ->
  BackendConfig ('Postgres pgKind) ->
  Env.Environment ->
  manager ->
  m (Either QErr (SourceConfig ('Postgres pgKind)))
resolveSourceConfig :: Logger Hasura
-> SourceName
-> PostgresConnConfiguration
-> BackendSourceKind ('Postgres pgKind)
-> BackendConfig ('Postgres pgKind)
-> Environment
-> manager
-> m (Either QErr (SourceConfig ('Postgres pgKind)))
resolveSourceConfig Logger Hasura
_logger SourceName
name PostgresConnConfiguration
config BackendSourceKind ('Postgres pgKind)
_backendKind BackendConfig ('Postgres pgKind)
_backendConfig Environment
_env manager
_manager = ExceptT QErr m PGSourceConfig -> m (Either QErr PGSourceConfig)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  SourceName
-> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig)
sourceResolver <- ExceptT
  QErr
  m
  (SourceName
   -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver
  ExceptT QErr m (Either QErr PGSourceConfig)
-> ExceptT QErr m PGSourceConfig
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (ExceptT QErr m (Either QErr PGSourceConfig)
 -> ExceptT QErr m PGSourceConfig)
-> ExceptT QErr m (Either QErr PGSourceConfig)
-> ExceptT QErr m PGSourceConfig
forall a b. (a -> b) -> a -> b
$ IO (Either QErr PGSourceConfig)
-> ExceptT QErr m (Either QErr PGSourceConfig)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either QErr PGSourceConfig)
 -> ExceptT QErr m (Either QErr PGSourceConfig))
-> IO (Either QErr PGSourceConfig)
-> ExceptT QErr m (Either QErr PGSourceConfig)
forall a b. (a -> b) -> a -> b
$ SourceName
-> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig)
sourceResolver SourceName
name PostgresConnConfiguration
config

-- | 'PGSourceLockQuery' is a data type which represents the contents of a single object of the
--   locked queries which are queried from the `pg_stat_activity`. See `logPGSourceCatalogMigrationLockedQueries`.
data PGSourceLockQuery = PGSourceLockQuery
  { PGSourceLockQuery -> Text
_psqaQuery :: Text,
    PGSourceLockQuery -> Maybe Bool
_psqaLockGranted :: Maybe Bool,
    PGSourceLockQuery -> Text
_psqaLockMode :: Text,
    PGSourceLockQuery -> UTCTime
_psqaTransactionStartTime :: UTCTime,
    PGSourceLockQuery -> UTCTime
_psqaQueryStartTime :: UTCTime,
    PGSourceLockQuery -> Text
_psqaWaitEventType :: Text,
    PGSourceLockQuery -> Text
_psqaBlockingQuery :: Text
  }

$(deriveJSON hasuraJSON ''PGSourceLockQuery)

instance ToEngineLog [PGSourceLockQuery] Hasura where
  toEngineLog :: [PGSourceLockQuery] -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog [PGSourceLockQuery]
resp = (LogLevel
LevelInfo, EngineLogType Hasura
sourceCatalogMigrationLogType, [PGSourceLockQuery] -> Value
forall a. ToJSON a => a -> Value
toJSON [PGSourceLockQuery]
resp)

newtype PGSourceLockQueryError = PGSourceLockQueryError QErr
  deriving ([PGSourceLockQueryError] -> Value
[PGSourceLockQueryError] -> Encoding
PGSourceLockQueryError -> Value
PGSourceLockQueryError -> Encoding
(PGSourceLockQueryError -> Value)
-> (PGSourceLockQueryError -> Encoding)
-> ([PGSourceLockQueryError] -> Value)
-> ([PGSourceLockQueryError] -> Encoding)
-> ToJSON PGSourceLockQueryError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PGSourceLockQueryError] -> Encoding
$ctoEncodingList :: [PGSourceLockQueryError] -> Encoding
toJSONList :: [PGSourceLockQueryError] -> Value
$ctoJSONList :: [PGSourceLockQueryError] -> Value
toEncoding :: PGSourceLockQueryError -> Encoding
$ctoEncoding :: PGSourceLockQueryError -> Encoding
toJSON :: PGSourceLockQueryError -> Value
$ctoJSON :: PGSourceLockQueryError -> Value
ToJSON)

instance ToEngineLog PGSourceLockQueryError Hasura where
  toEngineLog :: PGSourceLockQueryError -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog PGSourceLockQueryError
resp = (LogLevel
LevelError, EngineLogType Hasura
sourceCatalogMigrationLogType, PGSourceLockQueryError -> Value
forall a. ToJSON a => a -> Value
toJSON PGSourceLockQueryError
resp)

-- | 'logPGSourceCatalogMigrationLockedQueries' as the name suggests logs
--   the queries which are blocking in the database. This function is called
--   asynchronously from `initCatalogIfNeeded` while the source catalog is being
--   migrated.
--   NOTE: When there are no locking queries present in the database, nothing will be logged.
logPGSourceCatalogMigrationLockedQueries ::
  MonadIO m =>
  Logger Hasura ->
  PGSourceConfig ->
  m Void
logPGSourceCatalogMigrationLockedQueries :: Logger Hasura -> PGSourceConfig -> m Void
logPGSourceCatalogMigrationLockedQueries Logger Hasura
logger PGSourceConfig
sourceConfig = m () -> m Void
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m Void) -> m () -> m Void
forall a b. (a -> b) -> a -> b
$ do
  Either QErr (Maybe [PGSourceLockQuery])
dbStats <- IO (Either QErr (Maybe [PGSourceLockQuery]))
-> m (Either QErr (Maybe [PGSourceLockQuery]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either QErr (Maybe [PGSourceLockQuery]))
 -> m (Either QErr (Maybe [PGSourceLockQuery])))
-> IO (Either QErr (Maybe [PGSourceLockQuery]))
-> m (Either QErr (Maybe [PGSourceLockQuery]))
forall a b. (a -> b) -> a -> b
$ PGSourceConfig
-> TxET QErr IO (Maybe [PGSourceLockQuery])
-> IO (Either QErr (Maybe [PGSourceLockQuery]))
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
PGSourceConfig -> TxET QErr m a -> m (Either QErr a)
runPgSourceReadTx PGSourceConfig
sourceConfig TxET QErr IO (Maybe [PGSourceLockQuery])
fetchLockedQueriesTx
  case Either QErr (Maybe [PGSourceLockQuery])
dbStats of
    Left QErr
err -> Logger Hasura
-> forall a (m :: * -> *).
   (ToEngineLog a Hasura, MonadIO m) =>
   a -> m ()
forall impl.
Logger impl
-> forall a (m :: * -> *).
   (ToEngineLog a impl, MonadIO m) =>
   a -> m ()
unLogger Logger Hasura
logger (PGSourceLockQueryError -> m ()) -> PGSourceLockQueryError -> m ()
forall a b. (a -> b) -> a -> b
$ QErr -> PGSourceLockQueryError
PGSourceLockQueryError QErr
err
    Right (Maybe [PGSourceLockQuery]
val :: (Maybe [PGSourceLockQuery])) ->
      case Maybe [PGSourceLockQuery]
val of
        Maybe [PGSourceLockQuery]
Nothing -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just [] -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just [PGSourceLockQuery]
val' -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> forall a (m :: * -> *).
   (ToEngineLog a Hasura, MonadIO m) =>
   a -> m ()
forall impl.
Logger impl
-> forall a (m :: * -> *).
   (ToEngineLog a impl, MonadIO m) =>
   a -> m ()
unLogger Logger Hasura
logger ([PGSourceLockQuery] -> IO ()) -> [PGSourceLockQuery] -> IO ()
forall a b. (a -> b) -> a -> b
$ [PGSourceLockQuery]
val'
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DiffTime -> IO ()
sleep (DiffTime -> IO ()) -> DiffTime -> IO ()
forall a b. (a -> b) -> a -> b
$ Seconds -> DiffTime
seconds Seconds
5
  where
    -- The blocking query in the below transaction is truncated to the first 20 characters because it may contain
    -- sensitive info.
    fetchLockedQueriesTx :: TxET QErr IO (Maybe [PGSourceLockQuery])
fetchLockedQueriesTx =
      (AltJ (Maybe [PGSourceLockQuery]) -> Maybe [PGSourceLockQuery]
forall a. AltJ a -> a
Q.getAltJ (AltJ (Maybe [PGSourceLockQuery]) -> Maybe [PGSourceLockQuery])
-> (SingleRow (Identity (AltJ (Maybe [PGSourceLockQuery])))
    -> AltJ (Maybe [PGSourceLockQuery]))
-> SingleRow (Identity (AltJ (Maybe [PGSourceLockQuery])))
-> Maybe [PGSourceLockQuery]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (AltJ (Maybe [PGSourceLockQuery]))
-> AltJ (Maybe [PGSourceLockQuery])
forall a. Identity a -> a
runIdentity (Identity (AltJ (Maybe [PGSourceLockQuery]))
 -> AltJ (Maybe [PGSourceLockQuery]))
-> (SingleRow (Identity (AltJ (Maybe [PGSourceLockQuery])))
    -> Identity (AltJ (Maybe [PGSourceLockQuery])))
-> SingleRow (Identity (AltJ (Maybe [PGSourceLockQuery])))
-> AltJ (Maybe [PGSourceLockQuery])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity (AltJ (Maybe [PGSourceLockQuery])))
-> Identity (AltJ (Maybe [PGSourceLockQuery]))
forall a. SingleRow a -> a
Q.getRow)
        (SingleRow (Identity (AltJ (Maybe [PGSourceLockQuery])))
 -> Maybe [PGSourceLockQuery])
-> TxET
     QErr IO (SingleRow (Identity (AltJ (Maybe [PGSourceLockQuery]))))
-> TxET QErr IO (Maybe [PGSourceLockQuery])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> ()
-> Bool
-> TxET
     QErr IO (SingleRow (Identity (AltJ (Maybe [PGSourceLockQuery]))))
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 COALESCE(json_agg(DISTINCT jsonb_build_object('query', psa.query, 'lock_granted', pl.granted, 'lock_mode', pl.mode, 'transaction_start_time', psa.xact_start, 'query_start_time', psa.query_start, 'wait_event_type', psa.wait_event_type, 'blocking_query', (SUBSTRING(blocking.query, 1, 20) || '...') )), '[]'::json)
         FROM     pg_stat_activity psa
         JOIN     pg_stat_activity blocking ON blocking.pid = ANY(pg_blocking_pids(psa.pid))
         LEFT JOIN pg_locks pl ON psa.pid = pl.pid
         WHERE    psa.query ILIKE '%hdb_catalog%' AND psa.wait_event_type IS NOT NULL
         AND      psa.query ILIKE any (array ['%create%', '%drop%', '%alter%']);
       |]
          ()
          Bool
False

resolveDatabaseMetadata ::
  forall pgKind m.
  ( Backend ('Postgres pgKind),
    ToMetadataFetchQuery pgKind,
    FetchFunctionMetadata pgKind,
    FetchTableMetadata pgKind,
    MonadIO m,
    MonadBaseControl IO m
  ) =>
  SourceMetadata ('Postgres pgKind) ->
  SourceConfig ('Postgres pgKind) ->
  SourceTypeCustomization ->
  m (Either QErr (ResolvedSource ('Postgres pgKind)))
resolveDatabaseMetadata :: SourceMetadata ('Postgres pgKind)
-> SourceConfig ('Postgres pgKind)
-> SourceTypeCustomization
-> m (Either QErr (ResolvedSource ('Postgres pgKind)))
resolveDatabaseMetadata SourceMetadata ('Postgres pgKind)
sourceMetadata SourceConfig ('Postgres pgKind)
sourceConfig SourceTypeCustomization
sourceCustomization = ExceptT QErr m (ResolvedSource ('Postgres pgKind))
-> m (Either QErr (ResolvedSource ('Postgres pgKind)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
tablesMeta, HashMap QualifiedFunction [PGRawFunctionInfo]
functionsMeta, HashMap Name PGScalarType
pgScalars) <- PGExecCtx
-> TxAccess
-> TxET
     QErr
     m
     (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)),
      HashMap QualifiedFunction [PGRawFunctionInfo],
      HashMap Name PGScalarType)
-> ExceptT
     QErr
     m
     (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)),
      HashMap QualifiedFunction [PGRawFunctionInfo],
      HashMap Name PGScalarType)
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.ReadOnly (TxET
   QErr
   m
   (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)),
    HashMap QualifiedFunction [PGRawFunctionInfo],
    HashMap Name PGScalarType)
 -> ExceptT
      QErr
      m
      (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)),
       HashMap QualifiedFunction [PGRawFunctionInfo],
       HashMap Name PGScalarType))
-> TxET
     QErr
     m
     (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)),
      HashMap QualifiedFunction [PGRawFunctionInfo],
      HashMap Name PGScalarType)
-> ExceptT
     QErr
     m
     (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)),
      HashMap QualifiedFunction [PGRawFunctionInfo],
      HashMap Name PGScalarType)
forall a b. (a -> b) -> a -> b
$ do
    HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
tablesMeta <- [QualifiedTable]
-> TxET QErr m (DBTablesMetadata ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(FetchTableMetadata pgKind, Backend ('Postgres pgKind),
 ToMetadataFetchQuery pgKind, MonadTx m) =>
[QualifiedTable] -> m (DBTablesMetadata ('Postgres pgKind))
fetchTableMetadata ([QualifiedTable]
 -> TxET QErr m (DBTablesMetadata ('Postgres pgKind)))
-> [QualifiedTable]
-> TxET QErr m (DBTablesMetadata ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap QualifiedTable (TableMetadata ('Postgres pgKind))
-> [QualifiedTable]
forall k v. InsOrdHashMap k v -> [k]
OMap.keys (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres pgKind))
 -> [QualifiedTable])
-> InsOrdHashMap QualifiedTable (TableMetadata ('Postgres pgKind))
-> [QualifiedTable]
forall a b. (a -> b) -> a -> b
$ SourceMetadata ('Postgres pgKind) -> Tables ('Postgres pgKind)
forall (b :: BackendType). SourceMetadata b -> Tables b
_smTables SourceMetadata ('Postgres pgKind)
sourceMetadata
    let allFunctions :: [QualifiedFunction]
allFunctions =
          InsOrdHashMap
  QualifiedFunction (FunctionMetadata ('Postgres pgKind))
-> [QualifiedFunction]
forall k v. InsOrdHashMap k v -> [k]
OMap.keys (SourceMetadata ('Postgres pgKind) -> Functions ('Postgres pgKind)
forall (b :: BackendType). SourceMetadata b -> Functions b
_smFunctions SourceMetadata ('Postgres pgKind)
sourceMetadata) -- Tracked functions
            [QualifiedFunction] -> [QualifiedFunction] -> [QualifiedFunction]
forall a. Semigroup a => a -> a -> a
<> (TableMetadata ('Postgres pgKind) -> [QualifiedFunction])
-> [TableMetadata ('Postgres pgKind)] -> [QualifiedFunction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TableMetadata ('Postgres pgKind)
-> [FunctionName ('Postgres pgKind)]
TableMetadata ('Postgres pgKind) -> [QualifiedFunction]
getComputedFieldFunctionsMetadata (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres pgKind))
-> [TableMetadata ('Postgres pgKind)]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres pgKind))
 -> [TableMetadata ('Postgres pgKind)])
-> InsOrdHashMap QualifiedTable (TableMetadata ('Postgres pgKind))
-> [TableMetadata ('Postgres pgKind)]
forall a b. (a -> b) -> a -> b
$ SourceMetadata ('Postgres pgKind) -> Tables ('Postgres pgKind)
forall (b :: BackendType). SourceMetadata b -> Tables b
_smTables SourceMetadata ('Postgres pgKind)
sourceMetadata) -- Computed field functions
    HashMap QualifiedFunction [PGRawFunctionInfo]
functionsMeta <- [QualifiedFunction]
-> TxET QErr m (DBFunctionsMetadata ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(FetchFunctionMetadata pgKind, MonadTx m) =>
[QualifiedFunction] -> m (DBFunctionsMetadata ('Postgres pgKind))
fetchFunctionMetadata @pgKind [QualifiedFunction]
allFunctions
    HashSet PGScalarType
pgScalars <- TxET QErr m (HashSet PGScalarType)
forall (m :: * -> *). MonadTx m => m (HashSet PGScalarType)
fetchPgScalars
    let scalarsMap :: HashMap Name PGScalarType
scalarsMap = [(Name, PGScalarType)] -> HashMap Name PGScalarType
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList do
          PGScalarType
scalar <- HashSet PGScalarType -> [PGScalarType]
forall a. HashSet a -> [a]
Set.toList HashSet PGScalarType
pgScalars
          Name
name <- forall (f :: * -> *) a.
(Foldable (Either QErr), Alternative f) =>
Either QErr a -> f a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t a -> f a
afold @(Either QErr) (Either QErr Name -> [Name]) -> Either QErr Name -> [Name]
forall a b. (a -> b) -> a -> b
$ PGScalarType -> Either QErr Name
forall (m :: * -> *). MonadError QErr m => PGScalarType -> m Name
mkScalarTypeName PGScalarType
scalar
          (Name, PGScalarType) -> [(Name, PGScalarType)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
name, PGScalarType
scalar)
    (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)),
 HashMap QualifiedFunction [PGRawFunctionInfo],
 HashMap Name PGScalarType)
-> TxET
     QErr
     m
     (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)),
      HashMap QualifiedFunction [PGRawFunctionInfo],
      HashMap Name PGScalarType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
tablesMeta, HashMap QualifiedFunction [PGRawFunctionInfo]
functionsMeta, HashMap Name PGScalarType
scalarsMap)
  ResolvedSource ('Postgres pgKind)
-> ExceptT QErr m (ResolvedSource ('Postgres pgKind))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolvedSource ('Postgres pgKind)
 -> ExceptT QErr m (ResolvedSource ('Postgres pgKind)))
-> ResolvedSource ('Postgres pgKind)
-> ExceptT QErr m (ResolvedSource ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ SourceConfig ('Postgres pgKind)
-> SourceTypeCustomization
-> DBTablesMetadata ('Postgres pgKind)
-> DBFunctionsMetadata ('Postgres pgKind)
-> ScalarMap ('Postgres pgKind)
-> ResolvedSource ('Postgres pgKind)
forall (b :: BackendType).
SourceConfig b
-> SourceTypeCustomization
-> DBTablesMetadata b
-> DBFunctionsMetadata b
-> ScalarMap b
-> ResolvedSource b
ResolvedSource SourceConfig ('Postgres pgKind)
sourceConfig SourceTypeCustomization
sourceCustomization DBTablesMetadata ('Postgres pgKind)
HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
tablesMeta DBFunctionsMetadata ('Postgres pgKind)
HashMap QualifiedFunction [PGRawFunctionInfo]
functionsMeta (HashMap Name (ScalarType ('Postgres pgKind))
-> ScalarMap ('Postgres pgKind)
forall (b :: BackendType).
Backend b =>
HashMap Name (ScalarType b) -> ScalarMap b
ScalarMap HashMap Name (ScalarType ('Postgres pgKind))
HashMap Name PGScalarType
pgScalars)
  where
    -- A helper function to list all functions underpinning computed fields from a table metadata
    getComputedFieldFunctionsMetadata :: TableMetadata ('Postgres pgKind) -> [FunctionName ('Postgres pgKind)]
    getComputedFieldFunctionsMetadata :: TableMetadata ('Postgres pgKind)
-> [FunctionName ('Postgres pgKind)]
getComputedFieldFunctionsMetadata =
      (ComputedFieldMetadata ('Postgres pgKind) -> QualifiedFunction)
-> [ComputedFieldMetadata ('Postgres pgKind)]
-> [QualifiedFunction]
forall a b. (a -> b) -> [a] -> [b]
map (ComputedFieldDefinition -> QualifiedFunction
_cfdFunction (ComputedFieldDefinition -> QualifiedFunction)
-> (ComputedFieldMetadata ('Postgres pgKind)
    -> ComputedFieldDefinition)
-> ComputedFieldMetadata ('Postgres pgKind)
-> QualifiedFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComputedFieldMetadata ('Postgres pgKind) -> ComputedFieldDefinition
forall (b :: BackendType).
ComputedFieldMetadata b -> ComputedFieldDefinition b
_cfmDefinition) ([ComputedFieldMetadata ('Postgres pgKind)] -> [QualifiedFunction])
-> (TableMetadata ('Postgres pgKind)
    -> [ComputedFieldMetadata ('Postgres pgKind)])
-> TableMetadata ('Postgres pgKind)
-> [QualifiedFunction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap
  ComputedFieldName (ComputedFieldMetadata ('Postgres pgKind))
-> [ComputedFieldMetadata ('Postgres pgKind)]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems (InsOrdHashMap
   ComputedFieldName (ComputedFieldMetadata ('Postgres pgKind))
 -> [ComputedFieldMetadata ('Postgres pgKind)])
-> (TableMetadata ('Postgres pgKind)
    -> InsOrdHashMap
         ComputedFieldName (ComputedFieldMetadata ('Postgres pgKind)))
-> TableMetadata ('Postgres pgKind)
-> [ComputedFieldMetadata ('Postgres pgKind)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableMetadata ('Postgres pgKind)
-> InsOrdHashMap
     ComputedFieldName (ComputedFieldMetadata ('Postgres pgKind))
forall (b :: BackendType). TableMetadata b -> ComputedFields b
_tmComputedFields

-- | Initialise catalog tables for a source, including those required by the event delivery subsystem.
prepareCatalog ::
  (MonadIO m, MonadBaseControl IO m) =>
  SourceConfig ('Postgres pgKind) ->
  ExceptT QErr m RecreateEventTriggers
prepareCatalog :: SourceConfig ('Postgres pgKind)
-> ExceptT QErr m RecreateEventTriggers
prepareCatalog SourceConfig ('Postgres pgKind)
sourceConfig = PGExecCtx
-> TxAccess
-> TxET QErr m RecreateEventTriggers
-> ExceptT QErr m RecreateEventTriggers
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 do
  Bool
hdbCatalogExist <- SchemaName -> TxET QErr m Bool
forall (m :: * -> *). MonadTx m => SchemaName -> m Bool
doesSchemaExist SchemaName
"hdb_catalog"
  Bool
eventLogTableExist <- SchemaName -> TableName -> TxET QErr m Bool
forall (m :: * -> *).
MonadTx m =>
SchemaName -> TableName -> m Bool
doesTableExist SchemaName
"hdb_catalog" TableName
"event_log"
  Bool
sourceVersionTableExist <- SchemaName -> TableName -> TxET QErr m Bool
forall (m :: * -> *).
MonadTx m =>
SchemaName -> TableName -> m Bool
doesTableExist SchemaName
"hdb_catalog" TableName
"hdb_source_catalog_version"
  if
      -- Fresh database
      | Bool -> Bool
not Bool
hdbCatalogExist -> TxE QErr RecreateEventTriggers -> TxET QErr m RecreateEventTriggers
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx do
        (PGTxErr -> QErr) -> Query -> () -> Bool -> TxET QErr IO ()
forall (m :: * -> *) r e.
(MonadIO m, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m ()
Q.unitQE PGTxErr -> QErr
defaultTxErrorHandler Query
"CREATE SCHEMA hdb_catalog" () Bool
False
        ExtensionsSchema -> TxET QErr IO ()
forall (m :: * -> *). MonadTx m => ExtensionsSchema -> m ()
enablePgcryptoExtension (ExtensionsSchema -> TxET QErr IO ())
-> ExtensionsSchema -> TxET QErr IO ()
forall a b. (a -> b) -> a -> b
$ PGSourceConfig -> ExtensionsSchema
_pscExtensionsSchema PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig
        TxET QErr IO ()
initPgSourceCatalog
        RecreateEventTriggers -> TxE QErr RecreateEventTriggers
forall (m :: * -> *) a. Monad m => a -> m a
return RecreateEventTriggers
RETDoNothing
      -- Only 'hdb_catalog' schema defined
      | Bool -> Bool
not (Bool
sourceVersionTableExist Bool -> Bool -> Bool
|| Bool
eventLogTableExist) -> do
        TxET QErr IO () -> TxET QErr m ()
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx TxET QErr IO ()
initPgSourceCatalog
        RecreateEventTriggers -> TxET QErr m RecreateEventTriggers
forall (m :: * -> *) a. Monad m => a -> m a
return RecreateEventTriggers
RETDoNothing
      -- Source is initialised by pre multisource support servers
      | Bool -> Bool
not Bool
sourceVersionTableExist Bool -> Bool -> Bool
&& Bool
eventLogTableExist -> do
        -- Update the Source Catalog to v43 to include the new migration
        -- changes. Skipping this step will result in errors.
        MetadataCatalogVersion
currMetadataCatalogVersion <- TxE QErr MetadataCatalogVersion
-> TxET QErr m MetadataCatalogVersion
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx TxE QErr MetadataCatalogVersion
getCatalogVersion
        -- we migrate to the 43 version, which is the migration where
        -- metadata separation is introduced
        MetadataCatalogVersion -> TxET QErr m ()
forall (m :: * -> *).
(MonadIO m, MonadTx m) =>
MetadataCatalogVersion -> m ()
migrateTo43MetadataCatalog MetadataCatalogVersion
currMetadataCatalogVersion
        TxET QErr IO () -> TxET QErr m ()
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx TxET QErr IO ()
createVersionTable
        -- Migrate the catalog from initial version i.e '0'
        SourceCatalogVersion Any -> TxET QErr m RecreateEventTriggers
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadTx m =>
SourceCatalogVersion pgKind -> m RecreateEventTriggers
migrateSourceCatalogFrom SourceCatalogVersion Any
forall (pgKind :: PostgresKind). SourceCatalogVersion pgKind
initialSourceCatalogVersion
      | Bool
otherwise -> TxET QErr m RecreateEventTriggers
forall (m :: * -> *). MonadTx m => m RecreateEventTriggers
migrateSourceCatalog
  where
    initPgSourceCatalog :: TxET QErr IO ()
initPgSourceCatalog = do
      () <- (PGTxErr -> QErr) -> Query -> TxET QErr IO ()
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> TxET e m a
Q.multiQE PGTxErr -> QErr
defaultTxErrorHandler $(makeRelativeToProject "src-rsr/init_pg_source.sql" >>= Q.sqlFromFile)
      TxET QErr IO ()
forall (m :: * -> *). MonadTx m => m ()
setSourceCatalogVersion

    createVersionTable :: TxET QErr IO ()
createVersionTable = do
      () <-
        (PGTxErr -> QErr) -> Query -> TxET QErr IO ()
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> TxET e m a
Q.multiQE
          PGTxErr -> QErr
defaultTxErrorHandler
          [Q.sql|
           CREATE TABLE hdb_catalog.hdb_source_catalog_version(
             version TEXT NOT NULL,
             upgraded_on TIMESTAMPTZ NOT NULL
           );

           CREATE UNIQUE INDEX hdb_source_catalog_version_one_row
           ON hdb_catalog.hdb_source_catalog_version((version IS NOT NULL));
        |]
      () -> TxET QErr IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    migrateTo43MetadataCatalog :: MetadataCatalogVersion -> m ()
migrateTo43MetadataCatalog MetadataCatalogVersion
prevVersion = do
      let neededMigrations :: [(MetadataCatalogVersion, TxET QErr IO ())]
neededMigrations = ((MetadataCatalogVersion, TxET QErr IO ()) -> Bool)
-> [(MetadataCatalogVersion, TxET QErr IO ())]
-> [(MetadataCatalogVersion, TxET QErr IO ())]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((MetadataCatalogVersion -> MetadataCatalogVersion -> Bool
forall a. Ord a => a -> a -> Bool
< MetadataCatalogVersion
prevVersion) (MetadataCatalogVersion -> Bool)
-> ((MetadataCatalogVersion, TxET QErr IO ())
    -> MetadataCatalogVersion)
-> (MetadataCatalogVersion, TxET QErr IO ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetadataCatalogVersion, TxET QErr IO ()) -> MetadataCatalogVersion
forall a b. (a, b) -> a
fst) [(MetadataCatalogVersion, TxET QErr IO ())]
upMigrationsUntil43
      case [(MetadataCatalogVersion, TxET QErr IO ())]
-> Maybe (NonEmpty (MetadataCatalogVersion, TxET QErr IO ()))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [(MetadataCatalogVersion, TxET QErr IO ())]
neededMigrations of
        Just NonEmpty (MetadataCatalogVersion, TxET QErr IO ())
nonEmptyNeededMigrations -> do
          -- Migrations aren't empty. We need to update the catalog version after migrations
          UTCTime
migrationTime <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
          TxET QErr IO () -> m ()
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxET QErr IO () -> m ()) -> TxET QErr IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ((MetadataCatalogVersion, TxET QErr IO ()) -> TxET QErr IO ())
-> NonEmpty (MetadataCatalogVersion, TxET QErr IO ())
-> TxET QErr IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (MetadataCatalogVersion, TxET QErr IO ()) -> TxET QErr IO ()
forall a b. (a, b) -> b
snd NonEmpty (MetadataCatalogVersion, TxET QErr IO ())
nonEmptyNeededMigrations
          Text -> UTCTime -> m ()
forall (m :: * -> *). MonadTx m => Text -> UTCTime -> m ()
setCatalogVersion Text
"43" UTCTime
migrationTime
        Maybe (NonEmpty (MetadataCatalogVersion, TxET QErr IO ()))
Nothing ->
          -- No migrations exists, implies the database is migrated to latest metadata catalog version
          () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- NOTE (rakesh):
-- Down migrations for postgres sources is not supported in this PR. We need an
-- exhaustive discussion to make a call as I think, as of now, it is not
-- trivial. For metadata catalog migrations, we have a separate downgrade
-- command in the graphql-engine exe.
--
-- I can think of two ways:
--
--  - Just like downgrade, we need to have a new command path for downgrading
--  pg sources (command design should support other backends too,
--  graphql-engine source-downgrade postgres --to-catalog-version 1 --
--  downgrade all available pg sources to 1)
--  - Have an online documentation with necessary SQLs to help users to
--  downgrade pg sources themselves. Improve error message by referring the URL
--  to the documentation.

migrateSourceCatalog :: MonadTx m => m RecreateEventTriggers
migrateSourceCatalog :: m RecreateEventTriggers
migrateSourceCatalog =
  m (SourceCatalogVersion Any)
forall (m :: * -> *) (postgres :: PostgresKind).
MonadTx m =>
m (SourceCatalogVersion postgres)
getSourceCatalogVersion m (SourceCatalogVersion Any)
-> (SourceCatalogVersion Any -> m RecreateEventTriggers)
-> m RecreateEventTriggers
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SourceCatalogVersion Any -> m RecreateEventTriggers
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadTx m =>
SourceCatalogVersion pgKind -> m RecreateEventTriggers
migrateSourceCatalogFrom

-- | `migrateSourceCatalogFrom` migrates the catalog from a lower to a higher version.
--    When there are any changes in the source catalog, then re-create the existing event
--    triggers in the metadata. This is done so that the event triggers be compatible with the
--    changes introduced in the newly added source catalog migrations. When the source is already
--    in the latest catalog version, we do nothing because nothing has changed w.r.t the source catalog
--    so recreating the event triggers will only be extraneous.
migrateSourceCatalogFrom :: (MonadTx m) => SourceCatalogVersion pgKind -> m RecreateEventTriggers
migrateSourceCatalogFrom :: SourceCatalogVersion pgKind -> m RecreateEventTriggers
migrateSourceCatalogFrom SourceCatalogVersion pgKind
prevVersion
  | SourceCatalogVersion pgKind
prevVersion SourceCatalogVersion pgKind -> SourceCatalogVersion pgKind -> Bool
forall a. Eq a => a -> a -> Bool
== SourceCatalogVersion pgKind
forall (pgKind :: PostgresKind). SourceCatalogVersion pgKind
latestSourceCatalogVersion = RecreateEventTriggers -> m RecreateEventTriggers
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecreateEventTriggers
RETDoNothing
  | [] <- [(SourceCatalogVersion pgKind, TxET QErr IO ())]
neededMigrations =
    Code -> Text -> m RecreateEventTriggers
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> m RecreateEventTriggers)
-> Text -> m RecreateEventTriggers
forall a b. (a -> b) -> a -> b
$
      Text
"Expected source catalog version <= "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceCatalogVersion Any -> Text
forall a. Show a => a -> Text
tshow SourceCatalogVersion Any
forall (pgKind :: PostgresKind). SourceCatalogVersion pgKind
latestSourceCatalogVersion
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but the current version is "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceCatalogVersion pgKind -> Text
forall a. Show a => a -> Text
tshow SourceCatalogVersion pgKind
prevVersion
  | Bool
otherwise = do
    TxET QErr IO () -> m ()
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxET QErr IO () -> m ()) -> TxET QErr IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ((SourceCatalogVersion pgKind, TxET QErr IO ()) -> TxET QErr IO ())
-> [(SourceCatalogVersion pgKind, TxET QErr IO ())]
-> TxET QErr IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (SourceCatalogVersion pgKind, TxET QErr IO ()) -> TxET QErr IO ()
forall a b. (a, b) -> b
snd [(SourceCatalogVersion pgKind, TxET QErr IO ())]
neededMigrations
    m ()
forall (m :: * -> *). MonadTx m => m ()
setSourceCatalogVersion
    RecreateEventTriggers -> m RecreateEventTriggers
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecreateEventTriggers
RETRecreate
  where
    neededMigrations :: [(SourceCatalogVersion pgKind, TxET QErr IO ())]
neededMigrations =
      ((SourceCatalogVersion pgKind, TxET QErr IO ()) -> Bool)
-> [(SourceCatalogVersion pgKind, TxET QErr IO ())]
-> [(SourceCatalogVersion pgKind, TxET QErr IO ())]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((SourceCatalogVersion pgKind -> SourceCatalogVersion pgKind -> Bool
forall a. Eq a => a -> a -> Bool
/= SourceCatalogVersion pgKind
prevVersion) (SourceCatalogVersion pgKind -> Bool)
-> ((SourceCatalogVersion pgKind, TxET QErr IO ())
    -> SourceCatalogVersion pgKind)
-> (SourceCatalogVersion pgKind, TxET QErr IO ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceCatalogVersion pgKind, TxET QErr IO ())
-> SourceCatalogVersion pgKind
forall a b. (a, b) -> a
fst) [(SourceCatalogVersion pgKind, TxET QErr IO ())]
forall (pgKind :: PostgresKind).
[(SourceCatalogVersion pgKind, TxET QErr IO ())]
sourceMigrations

sourceMigrations :: [(SourceCatalogVersion pgKind, Q.TxE QErr ())]
sourceMigrations :: [(SourceCatalogVersion pgKind, TxET QErr IO ())]
sourceMigrations =
  $( let migrationFromFile from =
           let to = succ from
               path = "src-rsr/pg_source_migrations/" <> show from <> "_to_" <> show to <> ".sql"
            in [|Q.multiQE defaultTxErrorHandler $(makeRelativeToProject path >>= Q.sqlFromFile)|]

         migrationsFromFile = map $ \from ->
           [|($(TH.lift from), $(migrationFromFile from))|]
      in TH.listE $ migrationsFromFile previousSourceCatalogVersions
   )

-- Upgrade the hdb_catalog schema to v43 (Metadata catalog)
upMigrationsUntil43 :: [(MetadataCatalogVersion, Q.TxE QErr ())]
upMigrationsUntil43 :: [(MetadataCatalogVersion, TxET QErr IO ())]
upMigrationsUntil43 =
  $( let migrationFromFile from to =
           let path = "src-rsr/migrations/" <> from <> "_to_" <> to <> ".sql"
            in [|Q.multiQE defaultTxErrorHandler $(makeRelativeToProject path >>= Q.sqlFromFile)|]

         migrationsFromFile = map $ \(to :: Int) ->
           let from = pred to
            in [|
                 ( $(TH.lift (MetadataCatalogVersion from)),
                   $(migrationFromFile (show from) (show to))
                 )
                 |]
      in TH.listE
         -- version 0.8 is the only non-integral catalog version
         -- The 41st migration which included only source catalog migration
         -- was introduced before metadata separation changes were introduced
         -- in the graphql-engine. Now the earlier 41st migration has been
         -- moved to source catalog migrations and the 41st up migration is removed
         -- entirely.
         $
           [|(MetadataCatalogVersion08, $(migrationFromFile "08" "1"))|] :
           migrationsFromFile [2 .. 3]
             ++ [|(MetadataCatalogVersion 3, from3To4)|] :
           (migrationsFromFile [5 .. 40]) ++ migrationsFromFile [42 .. 43]
   )

-- | We differentiate for CockroachDB and other PG implementations
-- as our CockroachDB table fetching SQL does not require table information,
-- and fails if it receives unused prepared arguments
-- this distinction should no longer be necessary if this issue is resolved:
-- https://github.com/cockroachdb/cockroach/issues/86375
class FetchTableMetadata (pgKind :: PostgresKind) where
  fetchTableMetadata ::
    forall m.
    ( Backend ('Postgres pgKind),
      ToMetadataFetchQuery pgKind,
      MonadTx m
    ) =>
    [QualifiedTable] ->
    m (DBTablesMetadata ('Postgres pgKind))

instance FetchTableMetadata 'Vanilla where
  fetchTableMetadata :: [QualifiedTable] -> m (DBTablesMetadata ('Postgres 'Vanilla))
fetchTableMetadata = [QualifiedTable] -> m (DBTablesMetadata ('Postgres 'Vanilla))
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), ToMetadataFetchQuery pgKind,
 MonadTx m) =>
[QualifiedTable] -> m (DBTablesMetadata ('Postgres pgKind))
pgFetchTableMetadata

instance FetchTableMetadata 'Citus where
  fetchTableMetadata :: [QualifiedTable] -> m (DBTablesMetadata ('Postgres 'Citus))
fetchTableMetadata = [QualifiedTable] -> m (DBTablesMetadata ('Postgres 'Citus))
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), ToMetadataFetchQuery pgKind,
 MonadTx m) =>
[QualifiedTable] -> m (DBTablesMetadata ('Postgres pgKind))
pgFetchTableMetadata

instance FetchTableMetadata 'Cockroach where
  fetchTableMetadata :: [QualifiedTable] -> m (DBTablesMetadata ('Postgres 'Cockroach))
fetchTableMetadata = [QualifiedTable] -> m (DBTablesMetadata ('Postgres 'Cockroach))
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), ToMetadataFetchQuery pgKind,
 MonadTx m) =>
[QualifiedTable] -> m (DBTablesMetadata ('Postgres pgKind))
cockroachFetchTableMetadata

-- | Fetch Postgres metadata of all user tables
pgFetchTableMetadata ::
  forall pgKind m.
  (Backend ('Postgres pgKind), ToMetadataFetchQuery pgKind, MonadTx m) =>
  [QualifiedTable] ->
  m (DBTablesMetadata ('Postgres pgKind))
pgFetchTableMetadata :: [QualifiedTable] -> m (DBTablesMetadata ('Postgres pgKind))
pgFetchTableMetadata [QualifiedTable]
tables = do
  [(SchemaName, TableName,
  AltJ (DBTableMetadata ('Postgres pgKind)))]
results <-
    TxE
  QErr
  [(SchemaName, TableName,
    AltJ (DBTableMetadata ('Postgres pgKind)))]
-> m [(SchemaName, TableName,
       AltJ (DBTableMetadata ('Postgres pgKind)))]
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE
   QErr
   [(SchemaName, TableName,
     AltJ (DBTableMetadata ('Postgres pgKind)))]
 -> m [(SchemaName, TableName,
        AltJ (DBTableMetadata ('Postgres pgKind)))])
-> TxE
     QErr
     [(SchemaName, TableName,
       AltJ (DBTableMetadata ('Postgres pgKind)))]
-> m [(SchemaName, TableName,
       AltJ (DBTableMetadata ('Postgres pgKind)))]
forall a b. (a -> b) -> a -> b
$
      (PGTxErr -> QErr)
-> Query
-> [AltJ [QualifiedTable]]
-> Bool
-> TxE
     QErr
     [(SchemaName, TableName,
       AltJ (DBTableMetadata ('Postgres pgKind)))]
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
        (ToMetadataFetchQuery pgKind => Query
forall (pgKind :: PostgresKind).
ToMetadataFetchQuery pgKind =>
Query
tableMetadata @pgKind)
        [[QualifiedTable] -> AltJ [QualifiedTable]
forall a. a -> AltJ a
Q.AltJ ([QualifiedTable] -> AltJ [QualifiedTable])
-> [QualifiedTable] -> AltJ [QualifiedTable]
forall a b. (a -> b) -> a -> b
$ [QualifiedTable] -> [QualifiedTable]
forall a. Ord a => [a] -> [a]
LE.uniques [QualifiedTable]
tables]
        Bool
True
  HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
-> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
 -> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))))
-> HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
-> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$
    [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
-> HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
 -> HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
-> HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$
      (((SchemaName, TableName,
   AltJ (DBTableMetadata ('Postgres pgKind)))
  -> (QualifiedTable, DBTableMetadata ('Postgres pgKind)))
 -> [(SchemaName, TableName,
      AltJ (DBTableMetadata ('Postgres pgKind)))]
 -> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))])
-> [(SchemaName, TableName,
     AltJ (DBTableMetadata ('Postgres pgKind)))]
-> ((SchemaName, TableName,
     AltJ (DBTableMetadata ('Postgres pgKind)))
    -> (QualifiedTable, DBTableMetadata ('Postgres pgKind)))
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((SchemaName, TableName, AltJ (DBTableMetadata ('Postgres pgKind)))
 -> (QualifiedTable, DBTableMetadata ('Postgres pgKind)))
-> [(SchemaName, TableName,
     AltJ (DBTableMetadata ('Postgres pgKind)))]
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
forall a b. (a -> b) -> [a] -> [b]
map [(SchemaName, TableName,
  AltJ (DBTableMetadata ('Postgres pgKind)))]
results (((SchemaName, TableName,
   AltJ (DBTableMetadata ('Postgres pgKind)))
  -> (QualifiedTable, DBTableMetadata ('Postgres pgKind)))
 -> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))])
-> ((SchemaName, TableName,
     AltJ (DBTableMetadata ('Postgres pgKind)))
    -> (QualifiedTable, DBTableMetadata ('Postgres pgKind)))
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
forall a b. (a -> b) -> a -> b
$
        \(SchemaName
schema, TableName
table, Q.AltJ DBTableMetadata ('Postgres pgKind)
info) -> (SchemaName -> TableName -> QualifiedTable
forall a. SchemaName -> a -> QualifiedObject a
QualifiedObject SchemaName
schema TableName
table, DBTableMetadata ('Postgres pgKind)
info)

-- | Fetch Cockroach metadata of all user tables
cockroachFetchTableMetadata ::
  forall pgKind m.
  (Backend ('Postgres pgKind), ToMetadataFetchQuery pgKind, MonadTx m) =>
  [QualifiedTable] ->
  m (DBTablesMetadata ('Postgres pgKind))
cockroachFetchTableMetadata :: [QualifiedTable] -> m (DBTablesMetadata ('Postgres pgKind))
cockroachFetchTableMetadata [QualifiedTable]
_tables = do
  [(SchemaName, TableName,
  AltJ (DBTableMetadata ('Postgres pgKind)))]
results <-
    TxE
  QErr
  [(SchemaName, TableName,
    AltJ (DBTableMetadata ('Postgres pgKind)))]
-> m [(SchemaName, TableName,
       AltJ (DBTableMetadata ('Postgres pgKind)))]
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE
   QErr
   [(SchemaName, TableName,
     AltJ (DBTableMetadata ('Postgres pgKind)))]
 -> m [(SchemaName, TableName,
        AltJ (DBTableMetadata ('Postgres pgKind)))])
-> TxE
     QErr
     [(SchemaName, TableName,
       AltJ (DBTableMetadata ('Postgres pgKind)))]
-> m [(SchemaName, TableName,
       AltJ (DBTableMetadata ('Postgres pgKind)))]
forall a b. (a -> b) -> a -> b
$
      (PGTxErr -> QErr)
-> Query
-> [PrepArg]
-> Bool
-> TxE
     QErr
     [(SchemaName, TableName,
       AltJ (DBTableMetadata ('Postgres pgKind)))]
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> [PrepArg] -> Bool -> TxET e m a
Q.rawQE
        PGTxErr -> QErr
defaultTxErrorHandler
        (ToMetadataFetchQuery pgKind => Query
forall (pgKind :: PostgresKind).
ToMetadataFetchQuery pgKind =>
Query
tableMetadata @pgKind)
        []
        Bool
True
  HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
-> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
 -> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))))
-> HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
-> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$
    [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
-> HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
 -> HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
-> HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$
      (((SchemaName, TableName,
   AltJ (DBTableMetadata ('Postgres pgKind)))
  -> (QualifiedTable, DBTableMetadata ('Postgres pgKind)))
 -> [(SchemaName, TableName,
      AltJ (DBTableMetadata ('Postgres pgKind)))]
 -> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))])
-> [(SchemaName, TableName,
     AltJ (DBTableMetadata ('Postgres pgKind)))]
-> ((SchemaName, TableName,
     AltJ (DBTableMetadata ('Postgres pgKind)))
    -> (QualifiedTable, DBTableMetadata ('Postgres pgKind)))
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((SchemaName, TableName, AltJ (DBTableMetadata ('Postgres pgKind)))
 -> (QualifiedTable, DBTableMetadata ('Postgres pgKind)))
-> [(SchemaName, TableName,
     AltJ (DBTableMetadata ('Postgres pgKind)))]
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
forall a b. (a -> b) -> [a] -> [b]
map [(SchemaName, TableName,
  AltJ (DBTableMetadata ('Postgres pgKind)))]
results (((SchemaName, TableName,
   AltJ (DBTableMetadata ('Postgres pgKind)))
  -> (QualifiedTable, DBTableMetadata ('Postgres pgKind)))
 -> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))])
-> ((SchemaName, TableName,
     AltJ (DBTableMetadata ('Postgres pgKind)))
    -> (QualifiedTable, DBTableMetadata ('Postgres pgKind)))
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
forall a b. (a -> b) -> a -> b
$
        \(SchemaName
schema, TableName
table, Q.AltJ DBTableMetadata ('Postgres pgKind)
info) -> (SchemaName -> TableName -> QualifiedTable
forall a. SchemaName -> a -> QualifiedObject a
QualifiedObject SchemaName
schema TableName
table, DBTableMetadata ('Postgres pgKind)
info)

class FetchFunctionMetadata (pgKind :: PostgresKind) where
  fetchFunctionMetadata ::
    (MonadTx m) =>
    [QualifiedFunction] ->
    m (DBFunctionsMetadata ('Postgres pgKind))

instance FetchFunctionMetadata 'Vanilla where
  fetchFunctionMetadata :: [QualifiedFunction] -> m (DBFunctionsMetadata ('Postgres 'Vanilla))
fetchFunctionMetadata = [QualifiedFunction] -> m (DBFunctionsMetadata ('Postgres 'Vanilla))
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadTx m =>
[QualifiedFunction] -> m (DBFunctionsMetadata ('Postgres pgKind))
pgFetchFunctionMetadata

instance FetchFunctionMetadata 'Citus where
  fetchFunctionMetadata :: [QualifiedFunction] -> m (DBFunctionsMetadata ('Postgres 'Citus))
fetchFunctionMetadata = [QualifiedFunction] -> m (DBFunctionsMetadata ('Postgres 'Citus))
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadTx m =>
[QualifiedFunction] -> m (DBFunctionsMetadata ('Postgres pgKind))
pgFetchFunctionMetadata

instance FetchFunctionMetadata 'Cockroach where
  fetchFunctionMetadata :: [QualifiedFunction]
-> m (DBFunctionsMetadata ('Postgres 'Cockroach))
fetchFunctionMetadata [QualifiedFunction]
_ = HashMap QualifiedFunction [PGRawFunctionInfo]
-> m (HashMap QualifiedFunction [PGRawFunctionInfo])
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap QualifiedFunction [PGRawFunctionInfo]
forall a. Monoid a => a
mempty

-- | Fetch Postgres metadata for all user functions
pgFetchFunctionMetadata :: (MonadTx m) => [QualifiedFunction] -> m (DBFunctionsMetadata ('Postgres pgKind))
pgFetchFunctionMetadata :: [QualifiedFunction] -> m (DBFunctionsMetadata ('Postgres pgKind))
pgFetchFunctionMetadata [QualifiedFunction]
functions = do
  [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])]
results <-
    TxE QErr [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])]
-> m [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])]
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])]
 -> m [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])])
-> TxE QErr [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])]
-> m [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])]
forall a b. (a -> b) -> a -> b
$
      (PGTxErr -> QErr)
-> Query
-> [AltJ [QualifiedFunction]]
-> Bool
-> TxE QErr [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])]
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
        $(makeRelativeToProject "src-rsr/pg_function_metadata.sql" >>= Q.sqlFromFile)
        [[QualifiedFunction] -> AltJ [QualifiedFunction]
forall a. a -> AltJ a
Q.AltJ ([QualifiedFunction] -> AltJ [QualifiedFunction])
-> [QualifiedFunction] -> AltJ [QualifiedFunction]
forall a b. (a -> b) -> a -> b
$ [QualifiedFunction] -> [QualifiedFunction]
forall a. Ord a => [a] -> [a]
LE.uniques [QualifiedFunction]
functions]
        Bool
True
  HashMap QualifiedFunction [PGRawFunctionInfo]
-> m (HashMap QualifiedFunction [PGRawFunctionInfo])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap QualifiedFunction [PGRawFunctionInfo]
 -> m (HashMap QualifiedFunction [PGRawFunctionInfo]))
-> HashMap QualifiedFunction [PGRawFunctionInfo]
-> m (HashMap QualifiedFunction [PGRawFunctionInfo])
forall a b. (a -> b) -> a -> b
$
    [(QualifiedFunction, [PGRawFunctionInfo])]
-> HashMap QualifiedFunction [PGRawFunctionInfo]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(QualifiedFunction, [PGRawFunctionInfo])]
 -> HashMap QualifiedFunction [PGRawFunctionInfo])
-> [(QualifiedFunction, [PGRawFunctionInfo])]
-> HashMap QualifiedFunction [PGRawFunctionInfo]
forall a b. (a -> b) -> a -> b
$
      (((SchemaName, FunctionName, AltJ [PGRawFunctionInfo])
  -> (QualifiedFunction, [PGRawFunctionInfo]))
 -> [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])]
 -> [(QualifiedFunction, [PGRawFunctionInfo])])
-> [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])]
-> ((SchemaName, FunctionName, AltJ [PGRawFunctionInfo])
    -> (QualifiedFunction, [PGRawFunctionInfo]))
-> [(QualifiedFunction, [PGRawFunctionInfo])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((SchemaName, FunctionName, AltJ [PGRawFunctionInfo])
 -> (QualifiedFunction, [PGRawFunctionInfo]))
-> [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])]
-> [(QualifiedFunction, [PGRawFunctionInfo])]
forall a b. (a -> b) -> [a] -> [b]
map [(SchemaName, FunctionName, AltJ [PGRawFunctionInfo])]
results (((SchemaName, FunctionName, AltJ [PGRawFunctionInfo])
  -> (QualifiedFunction, [PGRawFunctionInfo]))
 -> [(QualifiedFunction, [PGRawFunctionInfo])])
-> ((SchemaName, FunctionName, AltJ [PGRawFunctionInfo])
    -> (QualifiedFunction, [PGRawFunctionInfo]))
-> [(QualifiedFunction, [PGRawFunctionInfo])]
forall a b. (a -> b) -> a -> b
$
        \(SchemaName
schema, FunctionName
table, Q.AltJ [PGRawFunctionInfo]
infos) -> (SchemaName -> FunctionName -> QualifiedFunction
forall a. SchemaName -> a -> QualifiedObject a
QualifiedObject SchemaName
schema FunctionName
table, [PGRawFunctionInfo]
infos)

-- | Fetch all scalar types from Postgres
fetchPgScalars :: MonadTx m => m (HashSet PGScalarType)
fetchPgScalars :: m (HashSet PGScalarType)
fetchPgScalars =
  TxE QErr (HashSet PGScalarType) -> m (HashSet PGScalarType)
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr (HashSet PGScalarType) -> m (HashSet PGScalarType))
-> TxE QErr (HashSet PGScalarType) -> m (HashSet PGScalarType)
forall a b. (a -> b) -> a -> b
$
    AltJ (HashSet PGScalarType) -> HashSet PGScalarType
forall a. AltJ a -> a
Q.getAltJ (AltJ (HashSet PGScalarType) -> HashSet PGScalarType)
-> (SingleRow (Identity (AltJ (HashSet PGScalarType)))
    -> AltJ (HashSet PGScalarType))
-> SingleRow (Identity (AltJ (HashSet PGScalarType)))
-> HashSet PGScalarType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (AltJ (HashSet PGScalarType))
-> AltJ (HashSet PGScalarType)
forall a. Identity a -> a
runIdentity (Identity (AltJ (HashSet PGScalarType))
 -> AltJ (HashSet PGScalarType))
-> (SingleRow (Identity (AltJ (HashSet PGScalarType)))
    -> Identity (AltJ (HashSet PGScalarType)))
-> SingleRow (Identity (AltJ (HashSet PGScalarType)))
-> AltJ (HashSet PGScalarType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity (AltJ (HashSet PGScalarType)))
-> Identity (AltJ (HashSet PGScalarType))
forall a. SingleRow a -> a
Q.getRow
      (SingleRow (Identity (AltJ (HashSet PGScalarType)))
 -> HashSet PGScalarType)
-> TxET
     QErr IO (SingleRow (Identity (AltJ (HashSet PGScalarType))))
-> TxE QErr (HashSet PGScalarType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> ()
-> Bool
-> TxET
     QErr IO (SingleRow (Identity (AltJ (HashSet PGScalarType))))
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 coalesce(json_agg(typname), '[]')
    FROM pg_catalog.pg_type where typtype = 'b'
   |]
        ()
        Bool
True

-- | Clean source database after dropping in metadata
postDropSourceHook ::
  (MonadIO m, MonadError QErr m, MonadBaseControl IO m) =>
  SourceConfig ('Postgres pgKind) ->
  TableEventTriggers ('Postgres pgKind) ->
  m ()
postDropSourceHook :: SourceConfig ('Postgres pgKind)
-> TableEventTriggers ('Postgres pgKind) -> m ()
postDropSourceHook SourceConfig ('Postgres pgKind)
sourceConfig TableEventTriggers ('Postgres pgKind)
tableTriggersMap = do
  -- Clean traces of Hasura in source database
  --
  -- There are three type of database we have to consider here, which we
  -- refer to as types 1, 2, and 3 below:
  --   1. default postgres source (no separate metadata database)
  --   In this case, we want to only drop source-related tables ("event_log",
  --   "hdb_source_catalog_version", etc), leaving the rest of the schema
  --   intact.
  --
  --   2. dedicated metadata database
  --   Ideally a dedicated metadata database won't have any source related
  --   tables. But if it does, then drop only source-related tables, leaving the
  --   rest of schema intact.
  --
  --   3. non-default postgres source (necessarily without metadata tables)
  --   In this case, we want to drop the entire "hdb_catalog" schema.
  m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$
    PGSourceConfig -> TxET QErr m () -> m (Either QErr ())
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
PGSourceConfig -> TxET QErr m a -> m (Either QErr a)
runPgSourceWriteTx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig (TxET QErr m () -> m (Either QErr ()))
-> TxET QErr m () -> m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ do
      Bool
hdbMetadataTableExist <- SchemaName -> TableName -> TxET QErr m Bool
forall (m :: * -> *).
MonadTx m =>
SchemaName -> TableName -> m Bool
doesTableExist SchemaName
"hdb_catalog" TableName
"hdb_metadata"
      if
          -- If "hdb_metadata" exists, we have one of two possible cases:
          --   * this is a metadata database (type 2)
          --   * this is a default database (type 1)
          --
          -- Both of the possible cases might have source-related tables. And in
          -- both the cases we only want to drop the source-related tables
          -- leaving rest of the schema intact.
          --
          -- To adhere to the spec described above, we use DROP IF EXISTS
          -- statements for all source-related tables. The IF EXISTS lets us
          -- handle both cases uniformly, doing "ideally" nothing in the type 2
          -- database, and for default databases, we drop only source-related
          -- tables from the database's "hdb_catalog" schema.
          | Bool
hdbMetadataTableExist -> do
            -- drop the event trigger functions from the table for default sources
            [(QualifiedTable, [TriggerName])]
-> ((QualifiedTable, [TriggerName]) -> TxET QErr m ())
-> TxET QErr m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (HashMap QualifiedTable [TriggerName]
-> [(QualifiedTable, [TriggerName])]
forall k v. HashMap k v -> [(k, v)]
HM.toList TableEventTriggers ('Postgres pgKind)
HashMap QualifiedTable [TriggerName]
tableTriggersMap) (((QualifiedTable, [TriggerName]) -> TxET QErr m ())
 -> TxET QErr m ())
-> ((QualifiedTable, [TriggerName]) -> TxET QErr m ())
-> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$ \(QualifiedTable
_table, [TriggerName]
triggers) ->
              [TriggerName] -> (TriggerName -> TxET QErr m ()) -> TxET QErr m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [TriggerName]
triggers ((TriggerName -> TxET QErr m ()) -> TxET QErr m ())
-> (TriggerName -> TxET QErr m ()) -> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$ \TriggerName
triggerName ->
                TxET QErr IO () -> TxET QErr m ()
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxET QErr IO () -> TxET QErr m ())
-> TxET QErr IO () -> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$ TriggerName -> TxET QErr IO ()
dropTriggerQ TriggerName
triggerName
            (PGTxErr -> QErr) -> Query -> TxET QErr m ()
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> TxET e m a
Q.multiQE
              PGTxErr -> QErr
defaultTxErrorHandler
              $(makeRelativeToProject "src-rsr/drop_pg_source.sql" >>= Q.sqlFromFile)
          -- Otherwise, we have a non-default postgres source, which has no metadata tables.
          -- We drop the entire "hdb_catalog" schema as discussed above.
          | Bool
otherwise ->
            TxET QErr m ()
forall (m :: * -> *). MonadTx m => m ()
dropHdbCatalogSchema

  -- Destory postgres source connection
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PGExecCtx -> IO ()
_pecDestroyConn (PGExecCtx -> IO ()) -> PGExecCtx -> IO ()
forall a b. (a -> b) -> a -> b
$ PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig

  -- Run other drop hooks configured at source creation time
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PGSourceConfig -> IO ()
_pscPostDropHook PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig