{-# LANGUAGE TemplateHaskell #-}

-- | Migrations for the Hasura catalog.
--
-- To add a new migration:
--
--   1. Bump the catalog version number in @src-rsr/catalog_version.txt@.
--   2. Add a migration script in the @src-rsr/migrations/@ directory with the name
--      @<old version>_to_<new version>.sql@.
--   3. Create a downgrade script in the @src-rsr/migrations/@ directory with the name
--      @<new version>_to_<old version>.sql@.
--   4. If making a new release, add the mapping from application version to catalog
--      schema version in @src-rsr/catalog_versions.txt@.
--   5. If appropriate, add the change to @server/src-rsr/initialise.sql@ for fresh installations
--      of hasura.
--
-- The Template Haskell code in this module will automatically compile the new migration script into
-- the @graphql-engine@ executable.
--
-- 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.Server.Migrate
  ( MigrationResult (..),
    migrateCatalog,
    latestCatalogVersion,
    downgradeCatalog,
  )
where

import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson qualified as J
import Data.FileEmbed (makeRelativeToProject)
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Data.Time.Clock (UTCTime)
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Connection.MonadTx
import Hasura.Backends.Postgres.Execute.Types
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Base.Error
import Hasura.Logging (Hasura, LogLevel (..), ToEngineLog (..))
import Hasura.Prelude
import Hasura.RQL.DDL.Schema
import Hasura.RQL.DDL.Schema.LegacyCatalog
import Hasura.RQL.Types.ApiLimit
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.OpenTelemetry (emptyOpenTelemetryConfig)
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SourceCustomization
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Server.Init (DowngradeOptions (..), databaseUrlOption, _envVar)
import Hasura.Server.Logging (StartupLog (..))
import Hasura.Server.Migrate.Internal
import Hasura.Server.Migrate.LatestVersion
import Hasura.Server.Migrate.Version
import Hasura.Server.Types (MaintenanceMode (..))
import Language.Haskell.TH.Lib qualified as TH
import Language.Haskell.TH.Syntax qualified as TH
import Network.Types.Extended
import System.Directory (doesFileExist)

data MigrationResult
  = MRNothingToDo
  | MRInitialized
  | -- | old catalog version
    MRMigrated Text
  | MRMaintanenceMode
  deriving (Int -> MigrationResult -> ShowS
[MigrationResult] -> ShowS
MigrationResult -> String
(Int -> MigrationResult -> ShowS)
-> (MigrationResult -> String)
-> ([MigrationResult] -> ShowS)
-> Show MigrationResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MigrationResult -> ShowS
showsPrec :: Int -> MigrationResult -> ShowS
$cshow :: MigrationResult -> String
show :: MigrationResult -> String
$cshowList :: [MigrationResult] -> ShowS
showList :: [MigrationResult] -> ShowS
Show, MigrationResult -> MigrationResult -> Bool
(MigrationResult -> MigrationResult -> Bool)
-> (MigrationResult -> MigrationResult -> Bool)
-> Eq MigrationResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MigrationResult -> MigrationResult -> Bool
== :: MigrationResult -> MigrationResult -> Bool
$c/= :: MigrationResult -> MigrationResult -> Bool
/= :: MigrationResult -> MigrationResult -> Bool
Eq)

instance ToEngineLog MigrationResult Hasura where
  toEngineLog :: MigrationResult -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog MigrationResult
result =
    StartupLog -> (LogLevel, EngineLogType Hasura, Value)
forall a impl.
ToEngineLog a impl =>
a -> (LogLevel, EngineLogType impl, Value)
toEngineLog
      (StartupLog -> (LogLevel, EngineLogType Hasura, Value))
-> StartupLog -> (LogLevel, EngineLogType Hasura, Value)
forall a b. (a -> b) -> a -> b
$ StartupLog
        { slLogLevel :: LogLevel
slLogLevel = LogLevel
LevelInfo,
          slKind :: Text
slKind = Text
"catalog_migrate",
          slInfo :: Value
slInfo = Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case MigrationResult
result of
            MigrationResult
MRNothingToDo ->
              Text
"Already at the latest catalog version ("
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
latestCatalogVersionString
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"); nothing to do."
            MigrationResult
MRInitialized ->
              Text
"Successfully initialized the catalog (at version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
latestCatalogVersionString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")."
            MRMigrated Text
oldVersion ->
              Text
"Successfully migrated from catalog version "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
oldVersion
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to version "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
latestCatalogVersionString
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
            MigrationResult
MRMaintanenceMode ->
              Text
"Catalog migrations are skipped because the graphql-engine is in maintenance mode"
        }

-- A migration and (hopefully) also its inverse if we have it.
-- Polymorphic because `m` can be any `MonadTx`, `MonadIO` when
-- used in the `migrations` function below.
data MigrationPair m = MigrationPair
  { forall (m :: * -> *). MigrationPair m -> m ()
mpMigrate :: m (),
    forall (m :: * -> *). MigrationPair m -> Maybe (m ())
mpDown :: Maybe (m ())
  }

migrateCatalog ::
  forall m.
  ( MonadTx m,
    MonadIO m,
    MonadBaseControl IO m
  ) =>
  Maybe (SourceConnConfiguration ('Postgres 'Vanilla)) ->
  ExtensionsSchema ->
  MaintenanceMode () ->
  UTCTime ->
  m (MigrationResult, MetadataWithResourceVersion)
migrateCatalog :: forall (m :: * -> *).
(MonadTx m, MonadIO m, MonadBaseControl IO m) =>
Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
-> ExtensionsSchema
-> MaintenanceMode ()
-> UTCTime
-> m (MigrationResult, MetadataWithResourceVersion)
migrateCatalog Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
maybeDefaultSourceConfig ExtensionsSchema
extensionsSchema MaintenanceMode ()
maintenanceMode UTCTime
migrationTime = do
  Bool
catalogSchemaExists <- SchemaName -> m Bool
forall (m :: * -> *). MonadTx m => SchemaName -> m Bool
doesSchemaExist (Text -> SchemaName
SchemaName Text
"hdb_catalog")
  Bool
versionTableExists <- SchemaName -> TableName -> m Bool
forall (m :: * -> *).
MonadTx m =>
SchemaName -> TableName -> m Bool
doesTableExist (Text -> SchemaName
SchemaName Text
"hdb_catalog") (Text -> TableName
TableName Text
"hdb_version")
  Bool
metadataTableExists <- SchemaName -> TableName -> m Bool
forall (m :: * -> *).
MonadTx m =>
SchemaName -> TableName -> m Bool
doesTableExist (Text -> SchemaName
SchemaName Text
"hdb_catalog") (Text -> TableName
TableName Text
"hdb_metadata")
  MigrationResult
migrationResult <-
    if
      | MaintenanceMode ()
maintenanceMode MaintenanceMode () -> MaintenanceMode () -> Bool
forall a. Eq a => a -> a -> Bool
== (() -> MaintenanceMode ()
forall a. a -> MaintenanceMode a
MaintenanceModeEnabled ()) -> do
          if
            | Bool -> Bool
not Bool
catalogSchemaExists ->
                Text -> m MigrationResult
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"unexpected: hdb_catalog schema not found in maintenance mode"
            | Bool -> Bool
not Bool
versionTableExists ->
                Text -> m MigrationResult
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"unexpected: hdb_catalog.hdb_version table not found in maintenance mode"
            | Bool -> Bool
not Bool
metadataTableExists ->
                Text -> m MigrationResult
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500
                  (Text -> m MigrationResult) -> Text -> m MigrationResult
forall a b. (a -> b) -> a -> b
$ Text
"the \"hdb_catalog.hdb_metadata\" table is expected to exist and contain"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" the metadata of the graphql-engine"
            | Bool
otherwise -> MigrationResult -> m MigrationResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MigrationResult
MRMaintanenceMode
      | Bool
otherwise -> case Bool
catalogSchemaExists of
          Bool
False -> Bool -> m MigrationResult
initialize Bool
True
          Bool
True -> case Bool
versionTableExists of
            Bool
False -> Bool -> m MigrationResult
initialize Bool
False
            Bool
True -> MetadataCatalogVersion -> m MigrationResult
migrateFrom (MetadataCatalogVersion -> m MigrationResult)
-> m MetadataCatalogVersion -> m MigrationResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TxE QErr MetadataCatalogVersion -> m MetadataCatalogVersion
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx TxE QErr MetadataCatalogVersion
getCatalogVersion
  MetadataWithResourceVersion
metadataWithVersion <- TxE QErr MetadataWithResourceVersion
-> m MetadataWithResourceVersion
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx TxE QErr MetadataWithResourceVersion
fetchMetadataAndResourceVersionFromCatalog
  (MigrationResult, MetadataWithResourceVersion)
-> m (MigrationResult, MetadataWithResourceVersion)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MigrationResult
migrationResult, MetadataWithResourceVersion
metadataWithVersion)
  where
    -- initializes the catalog, creating the schema if necessary
    initialize :: Bool -> m MigrationResult
    initialize :: Bool -> m MigrationResult
initialize Bool
createSchema = do
      TxE QErr () -> m ()
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx
        (TxE QErr () -> m ()) -> TxE QErr () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> TxE QErr () -> TxE QErr ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
createSchema
        (TxE QErr () -> TxE QErr ()) -> TxE QErr () -> TxE QErr ()
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 ()
PG.unitQE PGTxErr -> QErr
defaultTxErrorHandler Query
"CREATE SCHEMA hdb_catalog" () Bool
False
      ExtensionsSchema -> m ()
forall (m :: * -> *). MonadTx m => ExtensionsSchema -> m ()
enablePgcryptoExtension ExtensionsSchema
extensionsSchema
      Query -> m ()
forall (m :: * -> *). MonadTx m => Query -> m ()
multiQ $(makeRelativeToProject "src-rsr/initialise.sql" >>= PG.sqlFromFile)
      m ()
updateCatalogVersion

      let emptyMetadata' :: Metadata
emptyMetadata' = case Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
maybeDefaultSourceConfig of
            Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
Nothing -> Metadata
emptyMetadata
            Just SourceConnConfiguration ('Postgres 'Vanilla)
defaultSourceConfig ->
              -- insert metadata with default source
              let defaultSourceMetadata :: AnyBackend SourceMetadata
defaultSourceMetadata =
                    SourceMetadata ('Postgres 'Vanilla) -> AnyBackend SourceMetadata
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                      (SourceMetadata ('Postgres 'Vanilla) -> AnyBackend SourceMetadata)
-> SourceMetadata ('Postgres 'Vanilla) -> AnyBackend SourceMetadata
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
SourceName
-> BackendSourceKind b
-> Tables b
-> Functions b
-> NativeQueries b
-> StoredProcedures b
-> LogicalModels b
-> SourceConnConfiguration b
-> Maybe QueryTagsConfig
-> SourceCustomization
-> Maybe (HealthCheckConfig b)
-> SourceMetadata b
SourceMetadata
                        @('Postgres 'Vanilla)
                        SourceName
defaultSource
                        BackendSourceKind ('Postgres 'Vanilla)
PostgresVanillaKind
                        InsOrdHashMap
  (TableName ('Postgres 'Vanilla))
  (TableMetadata ('Postgres 'Vanilla))
InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla))
forall a. Monoid a => a
mempty
                        InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (FunctionMetadata ('Postgres 'Vanilla))
InsOrdHashMap
  QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla))
forall a. Monoid a => a
mempty
                        NativeQueries ('Postgres 'Vanilla)
forall a. Monoid a => a
mempty
                        InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (StoredProcedureMetadata ('Postgres 'Vanilla))
InsOrdHashMap
  QualifiedFunction (StoredProcedureMetadata ('Postgres 'Vanilla))
forall a. Monoid a => a
mempty
                        LogicalModels ('Postgres 'Vanilla)
forall a. Monoid a => a
mempty
                        SourceConnConfiguration ('Postgres 'Vanilla)
defaultSourceConfig
                        Maybe QueryTagsConfig
forall a. Maybe a
Nothing
                        SourceCustomization
emptySourceCustomization
                        Maybe (HealthCheckConfig ('Postgres 'Vanilla))
forall a. Maybe a
Nothing
                  sources :: InsOrdHashMap SourceName BackendSourceMetadata
sources = SourceName
-> BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
InsOrdHashMap.singleton SourceName
defaultSource (BackendSourceMetadata
 -> InsOrdHashMap SourceName BackendSourceMetadata)
-> BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
forall a b. (a -> b) -> a -> b
$ AnyBackend SourceMetadata -> BackendSourceMetadata
BackendSourceMetadata AnyBackend SourceMetadata
defaultSourceMetadata
               in Metadata
emptyMetadata {_metaSources :: InsOrdHashMap SourceName BackendSourceMetadata
_metaSources = InsOrdHashMap SourceName BackendSourceMetadata
sources}

      TxE QErr () -> m ()
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr () -> m ()) -> TxE QErr () -> m ()
forall a b. (a -> b) -> a -> b
$ Metadata -> TxE QErr ()
insertMetadataInCatalog Metadata
emptyMetadata'
      MigrationResult -> m MigrationResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MigrationResult
MRInitialized

    -- migrates an existing catalog to the latest version from an existing verion
    migrateFrom :: MetadataCatalogVersion -> m MigrationResult
    migrateFrom :: MetadataCatalogVersion -> m MigrationResult
migrateFrom MetadataCatalogVersion
previousVersion
      | MetadataCatalogVersion
previousVersion MetadataCatalogVersion -> MetadataCatalogVersion -> Bool
forall a. Eq a => a -> a -> Bool
== MetadataCatalogVersion
latestCatalogVersion = MigrationResult -> m MigrationResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MigrationResult
MRNothingToDo
      | Bool
otherwise = do
          let upMigrations :: [(MetadataCatalogVersion, MigrationPair m)]
upMigrations = Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
-> Bool
-> MaintenanceMode ()
-> [(MetadataCatalogVersion, MigrationPair m)]
forall (m :: * -> *).
(MonadIO m, MonadTx m) =>
Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
-> Bool
-> MaintenanceMode ()
-> [(MetadataCatalogVersion, MigrationPair m)]
migrations Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
maybeDefaultSourceConfig Bool
False MaintenanceMode ()
maintenanceMode
          case MetadataCatalogVersion
-> [(MetadataCatalogVersion, MigrationPair m)]
-> [(MetadataCatalogVersion, MigrationPair m)]
forall {b} {b}. Ord b => b -> [(b, b)] -> [(b, b)]
neededMigrations MetadataCatalogVersion
previousVersion [(MetadataCatalogVersion, MigrationPair m)]
upMigrations of
            [] ->
              Code -> Text -> m MigrationResult
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported
                (Text -> m MigrationResult) -> Text -> m MigrationResult
forall a b. (a -> b) -> a -> b
$ Text
"Cannot use database previously used with a newer version of graphql-engine (expected"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" a catalog version <="
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
latestCatalogVersionString
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but the current version"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MetadataCatalogVersion -> Text
forall a. Show a => a -> Text
tshow MetadataCatalogVersion
previousVersion
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")."
            [(MetadataCatalogVersion, MigrationPair m)]
migrationsToBeApplied -> do
              ((MetadataCatalogVersion, MigrationPair m) -> m ())
-> [(MetadataCatalogVersion, MigrationPair m)] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (MigrationPair m -> m ()
forall (m :: * -> *). MigrationPair m -> m ()
mpMigrate (MigrationPair m -> m ())
-> ((MetadataCatalogVersion, MigrationPair m) -> MigrationPair m)
-> (MetadataCatalogVersion, MigrationPair m)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetadataCatalogVersion, MigrationPair m) -> MigrationPair m
forall a b. (a, b) -> b
snd) [(MetadataCatalogVersion, MigrationPair m)]
migrationsToBeApplied
              m ()
updateCatalogVersion
              MigrationResult -> m MigrationResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MigrationResult -> m MigrationResult)
-> (Text -> MigrationResult) -> Text -> m MigrationResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MigrationResult
MRMigrated (Text -> m MigrationResult) -> Text -> m MigrationResult
forall a b. (a -> b) -> a -> b
$ MetadataCatalogVersion -> Text
forall a. Show a => a -> Text
tshow MetadataCatalogVersion
previousVersion
      where
        neededMigrations :: b -> [(b, b)] -> [(b, b)]
neededMigrations b
prevVersion [(b, b)]
upMigrations =
          ((b, b) -> Bool) -> [(b, b)] -> [(b, b)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
prevVersion) (b -> Bool) -> ((b, b) -> b) -> (b, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, b) -> b
forall a b. (a, b) -> a
fst) [(b, b)]
upMigrations

    updateCatalogVersion :: m ()
updateCatalogVersion = Text -> UTCTime -> m ()
forall (m :: * -> *). MonadTx m => Text -> UTCTime -> m ()
setCatalogVersion Text
latestCatalogVersionString UTCTime
migrationTime

downgradeCatalog ::
  forall m.
  (MonadIO m, MonadTx m) =>
  Maybe (SourceConnConfiguration ('Postgres 'Vanilla)) ->
  DowngradeOptions ->
  UTCTime ->
  m MigrationResult
downgradeCatalog :: forall (m :: * -> *).
(MonadIO m, MonadTx m) =>
Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
-> DowngradeOptions -> UTCTime -> m MigrationResult
downgradeCatalog Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
defaultSourceConfig DowngradeOptions
opts UTCTime
time = do
  MetadataCatalogVersion
currentCatalogVersion <- TxE QErr MetadataCatalogVersion -> m MetadataCatalogVersion
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx TxE QErr MetadataCatalogVersion
getCatalogVersion
  MetadataCatalogVersion
targetVersionFloat :: MetadataCatalogVersion <-
    Either String MetadataCatalogVersion
-> (String -> m MetadataCatalogVersion) -> m MetadataCatalogVersion
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft (String -> Either String MetadataCatalogVersion
forall a. Read a => String -> Either String a
readEither (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ DowngradeOptions -> Text
dgoTargetVersion DowngradeOptions
opts)) ((String -> m MetadataCatalogVersion) -> m MetadataCatalogVersion)
-> (String -> m MetadataCatalogVersion) -> m MetadataCatalogVersion
forall a b. (a -> b) -> a -> b
$ \String
err ->
      Text -> m MetadataCatalogVersion
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m MetadataCatalogVersion)
-> Text -> m MetadataCatalogVersion
forall a b. (a -> b) -> a -> b
$ Text
"Unexpected: couldn't convert " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DowngradeOptions -> Text
dgoTargetVersion DowngradeOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to a float, error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
tshow String
err
  MetadataCatalogVersion
-> MetadataCatalogVersion -> m MigrationResult
downgradeFrom MetadataCatalogVersion
currentCatalogVersion MetadataCatalogVersion
targetVersionFloat
  where
    -- downgrades an existing catalog to the specified version
    downgradeFrom :: MetadataCatalogVersion -> MetadataCatalogVersion -> m MigrationResult
    downgradeFrom :: MetadataCatalogVersion
-> MetadataCatalogVersion -> m MigrationResult
downgradeFrom MetadataCatalogVersion
previousVersion MetadataCatalogVersion
targetVersion
      | MetadataCatalogVersion
previousVersion MetadataCatalogVersion -> MetadataCatalogVersion -> Bool
forall a. Eq a => a -> a -> Bool
== MetadataCatalogVersion
targetVersion = MigrationResult -> m MigrationResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MigrationResult
MRNothingToDo
      | Bool
otherwise =
          case MetadataCatalogVersion -> Either Text [m ()]
neededDownMigrations MetadataCatalogVersion
targetVersion of
            Left Text
reason ->
              Code -> Text -> m MigrationResult
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported
                (Text -> m MigrationResult) -> Text -> m MigrationResult
forall a b. (a -> b) -> a -> b
$ Text
"This downgrade path (from "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MetadataCatalogVersion -> Text
forall a. Show a => a -> Text
tshow MetadataCatalogVersion
previousVersion
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DowngradeOptions -> Text
dgoTargetVersion DowngradeOptions
opts
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") is not supported, because "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reason
            Right [m ()]
path -> do
              [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [m ()]
path
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DowngradeOptions -> Bool
dgoDryRun DowngradeOptions
opts) do
                Text -> UTCTime -> m ()
forall (m :: * -> *). MonadTx m => Text -> UTCTime -> m ()
setCatalogVersion (DowngradeOptions -> Text
dgoTargetVersion DowngradeOptions
opts) UTCTime
time
              MigrationResult -> m MigrationResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> MigrationResult
MRMigrated (DowngradeOptions -> Text
dgoTargetVersion DowngradeOptions
opts))
      where
        neededDownMigrations :: MetadataCatalogVersion -> Either Text [m ()]
neededDownMigrations MetadataCatalogVersion
newVersion =
          MetadataCatalogVersion
-> MetadataCatalogVersion
-> [(MetadataCatalogVersion, MigrationPair m)]
-> Either Text [m ()]
downgrade
            MetadataCatalogVersion
previousVersion
            MetadataCatalogVersion
newVersion
            ([(MetadataCatalogVersion, MigrationPair m)]
-> [(MetadataCatalogVersion, MigrationPair m)]
forall a. [a] -> [a]
reverse (Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
-> Bool
-> MaintenanceMode ()
-> [(MetadataCatalogVersion, MigrationPair m)]
forall (m :: * -> *).
(MonadIO m, MonadTx m) =>
Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
-> Bool
-> MaintenanceMode ()
-> [(MetadataCatalogVersion, MigrationPair m)]
migrations Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
defaultSourceConfig (DowngradeOptions -> Bool
dgoDryRun DowngradeOptions
opts) MaintenanceMode ()
forall a. MaintenanceMode a
MaintenanceModeDisabled))

        downgrade ::
          MetadataCatalogVersion ->
          MetadataCatalogVersion ->
          [(MetadataCatalogVersion, MigrationPair m)] ->
          Either Text [m ()]
        downgrade :: MetadataCatalogVersion
-> MetadataCatalogVersion
-> [(MetadataCatalogVersion, MigrationPair m)]
-> Either Text [m ()]
downgrade MetadataCatalogVersion
lower MetadataCatalogVersion
upper = [(MetadataCatalogVersion, MigrationPair m)] -> Either Text [m ()]
skipFutureDowngrades
          where
            -- We find the list of downgrade scripts to run by first
            -- dropping any downgrades which correspond to newer versions
            -- of the schema than the one we're running currently.
            -- Then we take migrations as needed until we reach the target
            -- version, dropping any remaining migrations from the end of the
            -- (reversed) list.
            skipFutureDowngrades, dropOlderDowngrades :: [(MetadataCatalogVersion, MigrationPair m)] -> Either Text [m ()]
            skipFutureDowngrades :: [(MetadataCatalogVersion, MigrationPair m)] -> Either Text [m ()]
skipFutureDowngrades [(MetadataCatalogVersion, MigrationPair m)]
xs | MetadataCatalogVersion
previousVersion MetadataCatalogVersion -> MetadataCatalogVersion -> Bool
forall a. Eq a => a -> a -> Bool
== MetadataCatalogVersion
lower = [(MetadataCatalogVersion, MigrationPair m)] -> Either Text [m ()]
dropOlderDowngrades [(MetadataCatalogVersion, MigrationPair m)]
xs
            skipFutureDowngrades [] = Text -> Either Text [m ()]
forall a b. a -> Either a b
Left Text
"the starting version is unrecognized."
            skipFutureDowngrades ((MetadataCatalogVersion
x, MigrationPair m
_) : [(MetadataCatalogVersion, MigrationPair m)]
xs)
              | MetadataCatalogVersion
x MetadataCatalogVersion -> MetadataCatalogVersion -> Bool
forall a. Eq a => a -> a -> Bool
== MetadataCatalogVersion
lower = [(MetadataCatalogVersion, MigrationPair m)] -> Either Text [m ()]
dropOlderDowngrades [(MetadataCatalogVersion, MigrationPair m)]
xs
              | Bool
otherwise = [(MetadataCatalogVersion, MigrationPair m)] -> Either Text [m ()]
skipFutureDowngrades [(MetadataCatalogVersion, MigrationPair m)]
xs

            dropOlderDowngrades :: [(MetadataCatalogVersion, MigrationPair m)] -> Either Text [m ()]
dropOlderDowngrades [] = Text -> Either Text [m ()]
forall a b. a -> Either a b
Left Text
"the target version is unrecognized."
            dropOlderDowngrades ((MetadataCatalogVersion
x, MigrationPair {mpDown :: forall (m :: * -> *). MigrationPair m -> Maybe (m ())
mpDown = Maybe (m ())
Nothing}) : [(MetadataCatalogVersion, MigrationPair m)]
_) =
              Text -> Either Text [m ()]
forall a b. a -> Either a b
Left (Text -> Either Text [m ()]) -> Text -> Either Text [m ()]
forall a b. (a -> b) -> a -> b
$ Text
"there is no available migration back to version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MetadataCatalogVersion -> Text
forall a. Show a => a -> Text
tshow MetadataCatalogVersion
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
            dropOlderDowngrades ((MetadataCatalogVersion
x, MigrationPair {mpDown :: forall (m :: * -> *). MigrationPair m -> Maybe (m ())
mpDown = Just m ()
y}) : [(MetadataCatalogVersion, MigrationPair m)]
xs)
              | MetadataCatalogVersion
x MetadataCatalogVersion -> MetadataCatalogVersion -> Bool
forall a. Eq a => a -> a -> Bool
== MetadataCatalogVersion
upper = [m ()] -> Either Text [m ()]
forall a b. b -> Either a b
Right [m ()
y]
              | Bool
otherwise = (m ()
y m () -> [m ()] -> [m ()]
forall a. a -> [a] -> [a]
:) ([m ()] -> [m ()]) -> Either Text [m ()] -> Either Text [m ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(MetadataCatalogVersion, MigrationPair m)] -> Either Text [m ()]
dropOlderDowngrades [(MetadataCatalogVersion, MigrationPair m)]
xs

migrations ::
  forall m.
  (MonadIO m, MonadTx m) =>
  Maybe (SourceConnConfiguration ('Postgres 'Vanilla)) ->
  Bool ->
  MaintenanceMode () ->
  [(MetadataCatalogVersion, MigrationPair m)]
migrations :: forall (m :: * -> *).
(MonadIO m, MonadTx m) =>
Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
-> Bool
-> MaintenanceMode ()
-> [(MetadataCatalogVersion, MigrationPair m)]
migrations Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
maybeDefaultSourceConfig Bool
dryRun MaintenanceMode ()
maintenanceMode =
  -- We need to build the list of migrations at compile-time so that we can compile the SQL
  -- directly into the executable using `Q.sqlFromFile`. The GHC stage restriction makes
  -- doing this a little bit awkward (we can’t use any definitions in this module at
  -- compile-time), but putting a `let` inside the splice itself is allowed.
  $( let migrationFromFile from to =
           let path = "src-rsr/migrations/" <> from <> "_to_" <> to <> ".sql"
            in [|runTxOrPrint $(makeRelativeToProject path >>= PG.sqlFromFile)|]
         migrationFromFileMaybe from to = do
           path <- makeRelativeToProject $ "src-rsr/migrations/" <> from <> "_to_" <> to <> ".sql"
           exists <- TH.runIO (doesFileExist path)
           if exists
             then [|Just (runTxOrPrint $(PG.sqlFromFile path))|]
             else [|Nothing|]

         migrationsFromFile = map $ \(to :: MetadataCatalogVersion) ->
           let from = pred to
            in [|
                 ( $(TH.lift from),
                   MigrationPair
                     $(migrationFromFile (show from) (show to))
                     $(migrationFromFileMaybe (show to) (show from))
                 )
                 |]
      in TH.listE
           -- version 0.8 is the only non-integral catalog version
           -- The 40_to_41 migration is consciously omitted from below because its contents
           -- have been moved to the `0_to_1.sql` because the `40_to_41` migration only contained
           -- source catalog changes and we'd like to keep source catalog migrations in a different
           -- path than metadata catalog migrations.
           $ [|(MetadataCatalogVersion08, MigrationPair $(migrationFromFile "08" "1") Nothing)|]
           : migrationsFromFile [MetadataCatalogVersion 2 .. MetadataCatalogVersion 3]
             ++ [|(MetadataCatalogVersion 3, MigrationPair from3To4 Nothing)|]
           : (migrationsFromFile [MetadataCatalogVersion 5 .. MetadataCatalogVersion 40] ++ migrationsFromFile [MetadataCatalogVersion 42])
             ++ [|(MetadataCatalogVersion 42, MigrationPair from42To43 (Just from43To42))|]
           : migrationsFromFile [MetadataCatalogVersion 44 .. latestCatalogVersion]
   )
  where
    runTxOrPrint :: PG.Query -> m ()
    runTxOrPrint :: Query -> m ()
runTxOrPrint
      | Bool
dryRun =
          IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Query -> IO ()) -> Query -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> (Query -> Text) -> Query -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Text
PG.getQueryText
      | Bool
otherwise = Query -> m ()
forall (m :: * -> *). MonadTx m => Query -> m ()
multiQ

    from42To43 :: m ()
from42To43 = do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MaintenanceMode ()
maintenanceMode MaintenanceMode () -> MaintenanceMode () -> Bool
forall a. Eq a => a -> a -> Bool
== () -> MaintenanceMode ()
forall a. a -> MaintenanceMode a
MaintenanceModeEnabled ())
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"cannot migrate to catalog version 43 in maintenance mode"
      let query :: Query
query = $(makeRelativeToProject "src-rsr/migrations/42_to_43.sql" >>= PG.sqlFromFile)
      if Bool
dryRun
        then (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Query -> IO ()) -> Query -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> (Query -> Text) -> Query -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Text
PG.getQueryText) Query
query
        else do
          MetadataNoSources
metadataV2 <- m MetadataNoSources
forall (m :: * -> *). MonadTx m => m MetadataNoSources
fetchMetadataFromHdbTables
          Query -> m ()
forall (m :: * -> *). MonadTx m => Query -> m ()
multiQ Query
query
          PostgresConnConfiguration
defaultSourceConfig <-
            Maybe PostgresConnConfiguration
-> m PostgresConnConfiguration -> m PostgresConnConfiguration
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
Maybe PostgresConnConfiguration
maybeDefaultSourceConfig
              (m PostgresConnConfiguration -> m PostgresConnConfiguration)
-> m PostgresConnConfiguration -> m PostgresConnConfiguration
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m PostgresConnConfiguration
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported
              (Text -> m PostgresConnConfiguration)
-> Text -> m PostgresConnConfiguration
forall a b. (a -> b) -> a -> b
$ Text
"cannot migrate to catalog version 43 without --database-url or env var "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
tshow (Option () -> String
forall def. Option def -> String
_envVar Option ()
databaseUrlOption)
          let metadataV3 :: Metadata
metadataV3 =
                let MetadataNoSources {QueryCollections
MetadataAllowlist
RemoteSchemas
InsOrdHashMap
  (TableName ('Postgres 'Vanilla))
  (TableMetadata ('Postgres 'Vanilla))
InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (FunctionMetadata ('Postgres 'Vanilla))
CronTriggers
Actions
CustomTypes
_mnsTables :: InsOrdHashMap
  (TableName ('Postgres 'Vanilla))
  (TableMetadata ('Postgres 'Vanilla))
_mnsFunctions :: InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (FunctionMetadata ('Postgres 'Vanilla))
_mnsRemoteSchemas :: RemoteSchemas
_mnsQueryCollections :: QueryCollections
_mnsAllowlist :: MetadataAllowlist
_mnsCustomTypes :: CustomTypes
_mnsActions :: Actions
_mnsCronTriggers :: CronTriggers
_mnsTables :: MetadataNoSources
-> InsOrdHashMap
     (TableName ('Postgres 'Vanilla))
     (TableMetadata ('Postgres 'Vanilla))
_mnsFunctions :: MetadataNoSources
-> InsOrdHashMap
     (FunctionName ('Postgres 'Vanilla))
     (FunctionMetadata ('Postgres 'Vanilla))
_mnsRemoteSchemas :: MetadataNoSources -> RemoteSchemas
_mnsQueryCollections :: MetadataNoSources -> QueryCollections
_mnsAllowlist :: MetadataNoSources -> MetadataAllowlist
_mnsCustomTypes :: MetadataNoSources -> CustomTypes
_mnsActions :: MetadataNoSources -> Actions
_mnsCronTriggers :: MetadataNoSources -> CronTriggers
..} = MetadataNoSources
metadataV2
                    defaultSourceMetadata :: BackendSourceMetadata
defaultSourceMetadata =
                      AnyBackend SourceMetadata -> BackendSourceMetadata
BackendSourceMetadata
                        (AnyBackend SourceMetadata -> BackendSourceMetadata)
-> AnyBackend SourceMetadata -> BackendSourceMetadata
forall a b. (a -> b) -> a -> b
$ SourceMetadata ('Postgres 'Vanilla) -> AnyBackend SourceMetadata
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                        (SourceMetadata ('Postgres 'Vanilla) -> AnyBackend SourceMetadata)
-> SourceMetadata ('Postgres 'Vanilla) -> AnyBackend SourceMetadata
forall a b. (a -> b) -> a -> b
$ SourceName
-> BackendSourceKind ('Postgres 'Vanilla)
-> InsOrdHashMap
     (TableName ('Postgres 'Vanilla))
     (TableMetadata ('Postgres 'Vanilla))
-> InsOrdHashMap
     (FunctionName ('Postgres 'Vanilla))
     (FunctionMetadata ('Postgres 'Vanilla))
-> NativeQueries ('Postgres 'Vanilla)
-> InsOrdHashMap
     (FunctionName ('Postgres 'Vanilla))
     (StoredProcedureMetadata ('Postgres 'Vanilla))
-> LogicalModels ('Postgres 'Vanilla)
-> SourceConnConfiguration ('Postgres 'Vanilla)
-> Maybe QueryTagsConfig
-> SourceCustomization
-> Maybe (HealthCheckConfig ('Postgres 'Vanilla))
-> SourceMetadata ('Postgres 'Vanilla)
forall (b :: BackendType).
SourceName
-> BackendSourceKind b
-> Tables b
-> Functions b
-> NativeQueries b
-> StoredProcedures b
-> LogicalModels b
-> SourceConnConfiguration b
-> Maybe QueryTagsConfig
-> SourceCustomization
-> Maybe (HealthCheckConfig b)
-> SourceMetadata b
SourceMetadata SourceName
defaultSource BackendSourceKind ('Postgres 'Vanilla)
PostgresVanillaKind InsOrdHashMap
  (TableName ('Postgres 'Vanilla))
  (TableMetadata ('Postgres 'Vanilla))
_mnsTables InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (FunctionMetadata ('Postgres 'Vanilla))
_mnsFunctions NativeQueries ('Postgres 'Vanilla)
forall a. Monoid a => a
mempty InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (StoredProcedureMetadata ('Postgres 'Vanilla))
InsOrdHashMap
  QualifiedFunction (StoredProcedureMetadata ('Postgres 'Vanilla))
forall a. Monoid a => a
mempty LogicalModels ('Postgres 'Vanilla)
forall a. Monoid a => a
mempty SourceConnConfiguration ('Postgres 'Vanilla)
PostgresConnConfiguration
defaultSourceConfig Maybe QueryTagsConfig
forall a. Maybe a
Nothing SourceCustomization
emptySourceCustomization Maybe (HealthCheckConfig ('Postgres 'Vanilla))
forall a. Maybe a
Nothing
                 in InsOrdHashMap SourceName BackendSourceMetadata
-> RemoteSchemas
-> QueryCollections
-> MetadataAllowlist
-> CustomTypes
-> Actions
-> CronTriggers
-> Endpoints
-> ApiLimit
-> MetricsConfig
-> InheritedRoles
-> SetGraphqlIntrospectionOptions
-> Network
-> BackendMap BackendConfigWrapper
-> OpenTelemetryConfig
-> Metadata
Metadata
                      (SourceName
-> BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
InsOrdHashMap.singleton SourceName
defaultSource BackendSourceMetadata
defaultSourceMetadata)
                      RemoteSchemas
_mnsRemoteSchemas
                      QueryCollections
_mnsQueryCollections
                      MetadataAllowlist
_mnsAllowlist
                      CustomTypes
_mnsCustomTypes
                      Actions
_mnsActions
                      CronTriggers
_mnsCronTriggers
                      Endpoints
forall a. Monoid a => a
mempty
                      ApiLimit
emptyApiLimit
                      MetricsConfig
emptyMetricsConfig
                      InheritedRoles
forall a. Monoid a => a
mempty
                      SetGraphqlIntrospectionOptions
forall a. Monoid a => a
mempty
                      Network
emptyNetwork
                      BackendMap BackendConfigWrapper
forall a. Monoid a => a
mempty
                      OpenTelemetryConfig
emptyOpenTelemetryConfig
          TxE QErr () -> m ()
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr () -> m ()) -> TxE QErr () -> m ()
forall a b. (a -> b) -> a -> b
$ Metadata -> TxE QErr ()
insertMetadataInCatalog Metadata
metadataV3

    from43To42 :: m ()
from43To42 = do
      let query :: Query
query = $(makeRelativeToProject "src-rsr/migrations/43_to_42.sql" >>= PG.sqlFromFile)
      if Bool
dryRun
        then (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Query -> IO ()) -> Query -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> (Query -> Text) -> Query -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Text
PG.getQueryText) Query
query
        else do
          Metadata {Network
QueryCollections
MetadataAllowlist
Endpoints
InheritedRoles
InsOrdHashMap SourceName BackendSourceMetadata
RemoteSchemas
CronTriggers
Actions
OpenTelemetryConfig
SetGraphqlIntrospectionOptions
MetricsConfig
ApiLimit
BackendMap BackendConfigWrapper
CustomTypes
_metaSources :: Metadata -> InsOrdHashMap SourceName BackendSourceMetadata
_metaSources :: InsOrdHashMap SourceName BackendSourceMetadata
_metaRemoteSchemas :: RemoteSchemas
_metaQueryCollections :: QueryCollections
_metaAllowlist :: MetadataAllowlist
_metaCustomTypes :: CustomTypes
_metaActions :: Actions
_metaCronTriggers :: CronTriggers
_metaRestEndpoints :: Endpoints
_metaApiLimits :: ApiLimit
_metaMetricsConfig :: MetricsConfig
_metaInheritedRoles :: InheritedRoles
_metaSetGraphqlIntrospectionOptions :: SetGraphqlIntrospectionOptions
_metaNetwork :: Network
_metaBackendConfigs :: BackendMap BackendConfigWrapper
_metaOpenTelemetryConfig :: OpenTelemetryConfig
_metaRemoteSchemas :: Metadata -> RemoteSchemas
_metaQueryCollections :: Metadata -> QueryCollections
_metaAllowlist :: Metadata -> MetadataAllowlist
_metaCustomTypes :: Metadata -> CustomTypes
_metaActions :: Metadata -> Actions
_metaCronTriggers :: Metadata -> CronTriggers
_metaRestEndpoints :: Metadata -> Endpoints
_metaApiLimits :: Metadata -> ApiLimit
_metaMetricsConfig :: Metadata -> MetricsConfig
_metaInheritedRoles :: Metadata -> InheritedRoles
_metaSetGraphqlIntrospectionOptions :: Metadata -> SetGraphqlIntrospectionOptions
_metaNetwork :: Metadata -> Network
_metaBackendConfigs :: Metadata -> BackendMap BackendConfigWrapper
_metaOpenTelemetryConfig :: Metadata -> OpenTelemetryConfig
..} <- TxE QErr Metadata -> m Metadata
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx TxE QErr Metadata
fetchMetadataFromCatalog
          Query -> m ()
forall (m :: * -> *). MonadTx m => Query -> m ()
multiQ Query
query
          let emptyMetadataNoSources :: MetadataNoSources
emptyMetadataNoSources =
                InsOrdHashMap
  (TableName ('Postgres 'Vanilla))
  (TableMetadata ('Postgres 'Vanilla))
-> InsOrdHashMap
     (FunctionName ('Postgres 'Vanilla))
     (FunctionMetadata ('Postgres 'Vanilla))
-> RemoteSchemas
-> QueryCollections
-> MetadataAllowlist
-> CustomTypes
-> Actions
-> CronTriggers
-> MetadataNoSources
MetadataNoSources InsOrdHashMap
  (TableName ('Postgres 'Vanilla))
  (TableMetadata ('Postgres 'Vanilla))
InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla))
forall a. Monoid a => a
mempty InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (FunctionMetadata ('Postgres 'Vanilla))
InsOrdHashMap
  QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla))
forall a. Monoid a => a
mempty RemoteSchemas
forall a. Monoid a => a
mempty QueryCollections
forall a. Monoid a => a
mempty MetadataAllowlist
forall a. Monoid a => a
mempty CustomTypes
emptyCustomTypes Actions
forall a. Monoid a => a
mempty CronTriggers
forall a. Monoid a => a
mempty
          MetadataNoSources
metadataV2 <- case InsOrdHashMap SourceName BackendSourceMetadata
-> [(SourceName, BackendSourceMetadata)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList InsOrdHashMap SourceName BackendSourceMetadata
_metaSources of
            [] -> MetadataNoSources -> m MetadataNoSources
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetadataNoSources
emptyMetadataNoSources
            [(SourceName
_, BackendSourceMetadata AnyBackend SourceMetadata
exists)] ->
              MetadataNoSources -> m MetadataNoSources
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataNoSources -> m MetadataNoSources)
-> MetadataNoSources -> m MetadataNoSources
forall a b. (a -> b) -> a -> b
$ case AnyBackend SourceMetadata
-> Maybe (SourceMetadata ('Postgres 'Vanilla))
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend AnyBackend SourceMetadata
exists of
                Maybe (SourceMetadata ('Postgres 'Vanilla))
Nothing -> MetadataNoSources
emptyMetadataNoSources
                Just SourceMetadata {Maybe QueryTagsConfig
Maybe (HealthCheckConfig ('Postgres 'Vanilla))
InsOrdHashMap
  (TableName ('Postgres 'Vanilla))
  (TableMetadata ('Postgres 'Vanilla))
InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (FunctionMetadata ('Postgres 'Vanilla))
InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (StoredProcedureMetadata ('Postgres 'Vanilla))
LogicalModels ('Postgres 'Vanilla)
NativeQueries ('Postgres 'Vanilla)
BackendSourceKind ('Postgres 'Vanilla)
SourceName
SourceConnConfiguration ('Postgres 'Vanilla)
SourceCustomization
_smName :: SourceName
_smKind :: BackendSourceKind ('Postgres 'Vanilla)
_smTables :: InsOrdHashMap
  (TableName ('Postgres 'Vanilla))
  (TableMetadata ('Postgres 'Vanilla))
_smFunctions :: InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (FunctionMetadata ('Postgres 'Vanilla))
_smNativeQueries :: NativeQueries ('Postgres 'Vanilla)
_smStoredProcedures :: InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (StoredProcedureMetadata ('Postgres 'Vanilla))
_smLogicalModels :: LogicalModels ('Postgres 'Vanilla)
_smConfiguration :: SourceConnConfiguration ('Postgres 'Vanilla)
_smQueryTags :: Maybe QueryTagsConfig
_smCustomization :: SourceCustomization
_smHealthCheckConfig :: Maybe (HealthCheckConfig ('Postgres 'Vanilla))
_smName :: forall (b :: BackendType). SourceMetadata b -> SourceName
_smKind :: forall (b :: BackendType). SourceMetadata b -> BackendSourceKind b
_smTables :: forall (b :: BackendType). SourceMetadata b -> Tables b
_smFunctions :: forall (b :: BackendType). SourceMetadata b -> Functions b
_smNativeQueries :: forall (b :: BackendType). SourceMetadata b -> NativeQueries b
_smStoredProcedures :: forall (b :: BackendType). SourceMetadata b -> StoredProcedures b
_smLogicalModels :: forall (b :: BackendType). SourceMetadata b -> LogicalModels b
_smConfiguration :: forall (b :: BackendType).
SourceMetadata b -> SourceConnConfiguration b
_smQueryTags :: forall (b :: BackendType).
SourceMetadata b -> Maybe QueryTagsConfig
_smCustomization :: forall (b :: BackendType). SourceMetadata b -> SourceCustomization
_smHealthCheckConfig :: forall (b :: BackendType).
SourceMetadata b -> Maybe (HealthCheckConfig b)
..} ->
                  InsOrdHashMap
  (TableName ('Postgres 'Vanilla))
  (TableMetadata ('Postgres 'Vanilla))
-> InsOrdHashMap
     (FunctionName ('Postgres 'Vanilla))
     (FunctionMetadata ('Postgres 'Vanilla))
-> RemoteSchemas
-> QueryCollections
-> MetadataAllowlist
-> CustomTypes
-> Actions
-> CronTriggers
-> MetadataNoSources
MetadataNoSources
                    InsOrdHashMap
  (TableName ('Postgres 'Vanilla))
  (TableMetadata ('Postgres 'Vanilla))
_smTables
                    InsOrdHashMap
  (FunctionName ('Postgres 'Vanilla))
  (FunctionMetadata ('Postgres 'Vanilla))
_smFunctions
                    RemoteSchemas
_metaRemoteSchemas
                    QueryCollections
_metaQueryCollections
                    MetadataAllowlist
_metaAllowlist
                    CustomTypes
_metaCustomTypes
                    Actions
_metaActions
                    CronTriggers
_metaCronTriggers
            [(SourceName, BackendSourceMetadata)]
_ -> Code -> Text -> m MetadataNoSources
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Cannot downgrade since there are more than one source"
          TxE QErr () -> m ()
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr () -> m ()) -> TxE QErr () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            (ReaderT SystemDefined (TxET QErr IO) ()
 -> SystemDefined -> TxE QErr ())
-> SystemDefined
-> ReaderT SystemDefined (TxET QErr IO) ()
-> TxE QErr ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT SystemDefined (TxET QErr IO) ()
-> SystemDefined -> TxE QErr ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Bool -> SystemDefined
SystemDefined Bool
False) (ReaderT SystemDefined (TxET QErr IO) () -> TxE QErr ())
-> ReaderT SystemDefined (TxET QErr IO) () -> TxE QErr ()
forall a b. (a -> b) -> a -> b
$ MetadataNoSources -> ReaderT SystemDefined (TxET QErr IO) ()
forall (m :: * -> *).
(MonadTx m, MonadReader SystemDefined m) =>
MetadataNoSources -> m ()
saveMetadataToHdbTables MetadataNoSources
metadataV2
            -- when the graphql-engine is migrated from v1 to v2, we drop the foreign key
            -- constraint of the `hdb_catalog.hdb_cron_event` table because the cron triggers
            -- in v2 are saved in the `hdb_catalog.hdb_metadata` table. So, when a downgrade
            -- happens, we need to delay adding the foreign key constraint until the
            -- cron triggers are added in the `hdb_catalog.hdb_cron_triggers`
            TxE QErr ()
forall (m :: * -> *). MonadTx m => m ()
addCronTriggerForeignKeyConstraint
          m ()
forall (m :: * -> *). MonadTx m => m ()
recreateSystemMetadata

multiQ :: (MonadTx m) => PG.Query -> m ()
multiQ :: forall (m :: * -> *). MonadTx m => Query -> m ()
multiQ = TxE QErr () -> m ()
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr () -> m ()) -> (Query -> TxE QErr ()) -> Query -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGTxErr -> QErr) -> Query -> TxE QErr ()
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> TxET e m a
PG.multiQE PGTxErr -> QErr
defaultTxErrorHandler