diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index 393f07a93..e15ffa48c 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -64,7 +64,7 @@ import Simplex.Messaging.Agent.RetryInterval import Simplex.Messaging.Agent.Store (createStore) import Simplex.Messaging.Agent.Store.Common (DBStore) import Simplex.Messaging.Agent.Store.Interface (DBOpts) -import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError (..)) +import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..)) import Simplex.Messaging.Client import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet (VersionRangeE2E, supportedE2EEncryptVRange) @@ -266,7 +266,7 @@ newSMPAgentEnv config store = do multicastSubscribers <- newTMVarIO 0 pure Env {config, store, random, randomServer, ntfSupervisor, xftpAgent, multicastSubscribers} -createAgentStore :: DBOpts -> MigrationConfirmation -> IO (Either MigrationError DBStore) +createAgentStore :: DBOpts -> MigrationConfig -> IO (Either MigrationError DBStore) createAgentStore = createStore data NtfSupervisor = NtfSupervisor diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 8dee07037..a0b6bb1d6 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -33,7 +33,7 @@ import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Agent.Store.Common import Simplex.Messaging.Agent.Store.Interface (createDBStore) import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations) -import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError (..)) +import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet (MsgEncryptKeyX448, PQEncryption, PQSupport, RatchetX448) import Simplex.Messaging.Encoding.String @@ -55,7 +55,7 @@ import Simplex.Messaging.Protocol import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.Util (AnyError (..), bshow) -createStore :: DBOpts -> MigrationConfirmation -> IO (Either MigrationError DBStore) +createStore :: DBOpts -> MigrationConfig -> IO (Either MigrationError DBStore) createStore dbOpts = createDBStore dbOpts appMigrations -- * Queue types diff --git a/src/Simplex/Messaging/Agent/Store/Migrations.hs b/src/Simplex/Messaging/Agent/Store/Migrations.hs index f6b6c2df3..27c35b790 100644 --- a/src/Simplex/Messaging/Agent/Store/Migrations.hs +++ b/src/Simplex/Messaging/Agent/Store/Migrations.hs @@ -15,7 +15,7 @@ where import Control.Monad import Data.Char (toLower) import Data.Functor (($>)) -import Data.Maybe (isNothing, mapMaybe) +import Data.Maybe (isJust, isNothing, mapMaybe) import Simplex.Messaging.Agent.Store.Shared import System.Exit (exitFailure) import System.IO (hFlush, stdout) @@ -37,7 +37,7 @@ data DBMigrate = DBMigrate { initialize :: IO (), getCurrent :: IO [Migration], run :: MigrationsToRun -> IO (), - backup :: IO () + backup :: Maybe (IO ()) } sharedMigrateSchema :: DBMigrate -> Bool -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError ()) @@ -54,20 +54,20 @@ sharedMigrateSchema dbm dbNew' migrations confirmMigrations = do | otherwise -> case confirmMigrations of MCYesUp -> runWithBackup ms MCYesUpDown -> runWithBackup ms - MCConsole -> confirm err >> runWithBackup ms + MCConsole -> confirm' err >> runWithBackup ms MCError -> pure $ Left err where err = MEUpgrade $ map upMigration ums -- "The app has a newer version than the database.\nConfirm to back up and upgrade using these migrations: " <> intercalate ", " (map name ums) Right ms@(MTRDown dms) -> case confirmMigrations of MCYesUpDown -> runWithBackup ms - MCConsole -> confirm err >> runWithBackup ms + MCConsole -> confirm' err >> runWithBackup ms MCYesUp -> pure $ Left err MCError -> pure $ Left err where err = MEDowngrade $ map downName dms where - runWithBackup ms = backup dbm >> run dbm ms $> Right () - confirm err = confirmOrExit $ migrationErrorDescription err + runWithBackup ms = sequence (backup dbm) >> run dbm ms $> Right () + confirm' err = confirmOrExit $ migrationErrorDescription (isJust $ backup dbm) err confirmOrExit :: String -> IO () confirmOrExit s = do diff --git a/src/Simplex/Messaging/Agent/Store/Postgres.hs b/src/Simplex/Messaging/Agent/Store/Postgres.hs index 075e4be48..f9fd42442 100644 --- a/src/Simplex/Messaging/Agent/Store/Postgres.hs +++ b/src/Simplex/Messaging/Agent/Store/Postgres.hs @@ -30,15 +30,15 @@ import Simplex.Messaging.Agent.Store.Migrations (DBMigrate (..), sharedMigrateSc import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations import Simplex.Messaging.Agent.Store.Postgres.Common import qualified Simplex.Messaging.Agent.Store.Postgres.DB as DB -import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationError (..)) +import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..), MigrationError (..)) import Simplex.Messaging.Util (ifM, safeDecodeUtf8) import System.Exit (exitFailure) -- | Create a new Postgres DBStore with the given connection string, schema name and migrations. -- If passed schema does not exist in connectInfo database, it will be created. -- Applies necessary migrations to schema. -createDBStore :: DBOpts -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore) -createDBStore opts migrations confirmMigrations = do +createDBStore :: DBOpts -> [Migration] -> MigrationConfig -> IO (Either MigrationError DBStore) +createDBStore opts migrations MigrationConfig {confirm} = do st <- connectPostgresStore opts r <- migrateSchema st `onException` closeDBStore st case r of @@ -48,8 +48,8 @@ createDBStore opts migrations confirmMigrations = do migrateSchema st = let initialize = Migrations.initialize st getCurrent = withTransaction st Migrations.getCurrentMigrations - dbm = DBMigrate {initialize, getCurrent, run = Migrations.run st, backup = pure ()} - in sharedMigrateSchema dbm (dbNew st) migrations confirmMigrations + dbm = DBMigrate {initialize, getCurrent, run = Migrations.run st, backup = Nothing} + in sharedMigrateSchema dbm (dbNew st) migrations confirm connectPostgresStore :: DBOpts -> IO DBStore connectPostgresStore DBOpts {connstr, schema, poolSize, createSchema} = do diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index c724c031b..6203357fc 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -57,18 +57,18 @@ import Simplex.Messaging.Agent.Store.Migrations (DBMigrate (..), sharedMigrateSc import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations import Simplex.Messaging.Agent.Store.SQLite.Common import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB -import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationError (..)) +import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..), MigrationError (..)) import Simplex.Messaging.Util (ifM, safeDecodeUtf8) import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist) -import System.FilePath (takeDirectory) +import System.FilePath (takeDirectory, takeFileName, ()) import UnliftIO.Exception (bracketOnError, onException) import UnliftIO.MVar import UnliftIO.STM -- * SQLite Store implementation -createDBStore :: DBOpts -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore) -createDBStore DBOpts {dbFilePath, dbKey, keepKey, track, vacuum} migrations confirmMigrations = do +createDBStore :: DBOpts -> [Migration] -> MigrationConfig -> IO (Either MigrationError DBStore) +createDBStore DBOpts {dbFilePath, dbKey, keepKey, track, vacuum} migrations MigrationConfig {confirm, backupPath} = do let dbDir = takeDirectory dbFilePath createDirectoryIfMissing True dbDir st <- connectSQLiteStore dbFilePath dbKey keepKey track @@ -81,9 +81,12 @@ createDBStore DBOpts {dbFilePath, dbKey, keepKey, track, vacuum} migrations conf let initialize = Migrations.initialize st getCurrent = withTransaction st Migrations.getCurrentMigrations run = Migrations.run st vacuum - backup = copyFile dbFilePath (dbFilePath <> ".bak") + backup = mkBackup <$> backupPath + mkBackup bp = + let f = if null bp then dbFilePath else bp takeFileName dbFilePath + in copyFile dbFilePath $ f <> ".bak" dbm = DBMigrate {initialize, getCurrent, run, backup} - in sharedMigrateSchema dbm (dbNew st) migrations confirmMigrations + in sharedMigrateSchema dbm (dbNew st) migrations confirm connectSQLiteStore :: FilePath -> ScrubbedBytes -> Bool -> DB.TrackQueries -> IO DBStore connectSQLiteStore dbFilePath key keepKey track = do diff --git a/src/Simplex/Messaging/Agent/Store/Shared.hs b/src/Simplex/Messaging/Agent/Store/Shared.hs index 3921bf586..67edbb42b 100644 --- a/src/Simplex/Messaging/Agent/Store/Shared.hs +++ b/src/Simplex/Messaging/Agent/Store/Shared.hs @@ -9,6 +9,7 @@ module Simplex.Messaging.Agent.Store.Shared DownMigration (..), MTRError (..), mtrErrorDescription, + MigrationConfig (..), MigrationConfirmation (..), MigrationError (..), UpMigration (..), @@ -55,13 +56,15 @@ data MigrationError | MigrationError {mtrError :: MTRError} deriving (Eq, Show) -migrationErrorDescription :: MigrationError -> String -migrationErrorDescription = \case +migrationErrorDescription :: Bool -> MigrationError -> String +migrationErrorDescription withBackup = \case MEUpgrade ums -> - "The app has a newer version than the database.\nConfirm to back up and upgrade using these migrations: " <> intercalate ", " (map upName ums) + "The app has a newer version than the database.\nConfirm to " <> backupStr <> "upgrade using these migrations: " <> intercalate ", " (map upName ums) MEDowngrade dms -> - "Database version is newer than the app.\nConfirm to back up and downgrade using these migrations: " <> intercalate ", " dms + "Database version is newer than the app.\nConfirm to " <> backupStr <> "downgrade using these migrations: " <> intercalate ", " dms MigrationError err -> mtrErrorDescription err + where + backupStr = if withBackup then "back up and " else "" data UpMigration = UpMigration {upName :: String, withDown :: Bool} deriving (Eq, Show) @@ -69,6 +72,11 @@ data UpMigration = UpMigration {upName :: String, withDown :: Bool} upMigration :: Migration -> UpMigration upMigration Migration {name, down} = UpMigration name $ isJust down +data MigrationConfig = MigrationConfig + { confirm :: MigrationConfirmation, + backupPath :: Maybe FilePath -- Nothing - no backup, empty string - the same folder + } + data MigrationConfirmation = MCYesUp | MCYesUpDown | MCConsole | MCError deriving (Eq, Show) diff --git a/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs b/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs index b6f23047f..e1ae09cad 100644 --- a/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs +++ b/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs @@ -55,6 +55,7 @@ import Simplex.Messaging.Agent.Store.AgentStore () import Simplex.Messaging.Agent.Store.Postgres (closeDBStore, createDBStore) import Simplex.Messaging.Agent.Store.Postgres.Common import Simplex.Messaging.Agent.Store.Postgres.DB (blobFieldDecoder, fromTextField_) +import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..)) import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import qualified Simplex.Messaging.Crypto as C @@ -98,7 +99,7 @@ data NtfEntityRec (e :: NtfEntity) where newNtfDbStore :: PostgresStoreCfg -> IO NtfPostgresStore newNtfDbStore PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations, deletedTTL} = do - dbStore <- either err pure =<< createDBStore dbOpts ntfServerMigrations confirmMigrations + dbStore <- either err pure =<< createDBStore dbOpts ntfServerMigrations (MigrationConfig confirmMigrations Nothing) dbStoreLog <- mapM (openWriteStoreLog True) dbStoreLogPath pure NtfPostgresStore {dbStore, dbStoreLog, deletedTTL} where diff --git a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs index 5ed0754ec..50bcdfe3c 100644 --- a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs +++ b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs @@ -70,6 +70,7 @@ import Simplex.Messaging.Agent.Store.AgentStore () import Simplex.Messaging.Agent.Store.Postgres (createDBStore, closeDBStore) import Simplex.Messaging.Agent.Store.Postgres.Common import Simplex.Messaging.Agent.Store.Postgres.DB (blobFieldDecoder, fromTextField_) +import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding import Simplex.Messaging.Parsers (parseAll) @@ -112,7 +113,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where newQueueStore :: PostgresStoreCfg -> IO (PostgresQueueStore q) newQueueStore PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations, deletedTTL} = do - dbStore <- either err pure =<< createDBStore dbOpts serverMigrations confirmMigrations + dbStore <- either err pure =<< createDBStore dbOpts serverMigrations (MigrationConfig confirmMigrations Nothing) dbStoreLog <- mapM (openWriteStoreLog True) dbStoreLogPath queues <- TM.emptyIO senders <- TM.emptyIO diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index d1d0eb344..7f09928cc 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -90,7 +90,7 @@ import qualified Simplex.Messaging.Agent.Protocol as A import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction) import Simplex.Messaging.Agent.Store.Interface import qualified Simplex.Messaging.Agent.Store.DB as DB -import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError (..)) +import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationConfirmation (..), MigrationError (..)) import Simplex.Messaging.Client (pattern NRMInteractive, NetworkConfig (..), ProtocolClientConfig (..), TransportSessionMode (..), defaultClientConfig) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) @@ -3619,13 +3619,13 @@ getSMPAgentClient' clientId cfg' initServers dbPath = do #if defined(dbPostgres) createStore :: String -> IO (Either MigrationError DBStore) -createStore schema = createAgentStore (DBOpts testDBConnstr (B.pack schema) 1 True) MCError +createStore schema = createAgentStore (DBOpts testDBConnstr (B.pack schema) 1 True) (MigrationConfig MCError Nothing) insertUser :: DBStore -> IO () insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users DEFAULT VALUES") #else createStore :: String -> IO (Either MigrationError DBStore) -createStore dbPath = createAgentStore (DBOpts dbPath "" False True DB.TQOff) MCError +createStore dbPath = createAgentStore (DBOpts dbPath "" False True DB.TQOff) (MigrationConfig MCError Nothing) insertUser :: DBStore -> IO () insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users (user_id) VALUES (1)") diff --git a/tests/AgentTests/MigrationTests.hs b/tests/AgentTests/MigrationTests.hs index 56bf4e128..e4de45c7a 100644 --- a/tests/AgentTests/MigrationTests.hs +++ b/tests/AgentTests/MigrationTests.hs @@ -235,7 +235,7 @@ createStore randSuffix migrations confirmMigrations = do vacuum = True, track = DB.TQOff } - createDBStore dbOpts migrations confirmMigrations + createDBStore dbOpts migrations (MigrationConfig confirmMigrations Nothing) cleanup :: Word32 -> IO () cleanup randSuffix = removeFile (testDB randSuffix) diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 056dc5dd3..257c3f90f 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -46,7 +46,7 @@ import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations) import Simplex.Messaging.Agent.Store.SQLite import Simplex.Messaging.Agent.Store.SQLite.Common (DBStore (..), withTransaction') import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB -import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..)) +import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationConfirmation (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..)) import Simplex.Messaging.Crypto.Ratchet (pattern IKPQOn) @@ -83,7 +83,7 @@ createEncryptedStore key keepKey = do -- Randomize DB file name to avoid SQLite IO errors supposedly caused by asynchronous -- IO operations on multiple similarly named files; error seems to be environment specific r <- randomIO :: IO Word32 - Right st <- createDBStore (DBOpts (testDB <> show r) key keepKey True DB.TQOff) appMigrations MCError + Right st <- createDBStore (DBOpts (testDB <> show r) key keepKey True DB.TQOff) appMigrations (MigrationConfig MCError Nothing) withTransaction' st (`SQL.execute_` "INSERT INTO users (user_id) VALUES (1);") pure st diff --git a/tests/AgentTests/SchemaDump.hs b/tests/AgentTests/SchemaDump.hs index b64e2ec81..fdb172883 100644 --- a/tests/AgentTests/SchemaDump.hs +++ b/tests/AgentTests/SchemaDump.hs @@ -14,7 +14,7 @@ import Simplex.Messaging.Agent.Store.SQLite import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction') import Simplex.Messaging.Agent.Store.SQLite.DB (TrackQueries (..)) import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations -import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration) +import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration) import Simplex.Messaging.Util (ifM) import System.Directory (doesFileExist, removeFile) import System.Process (readCreateProcess, shell) @@ -51,7 +51,7 @@ testVerifySchemaDump :: IO () testVerifySchemaDump = do savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "") savedSchema `deepseq` pure () - void $ createDBStore (DBOpts testDB "" False True TQOff) appMigrations MCConsole + void $ createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCConsole Nothing) getSchema testDB appSchema `shouldReturn` savedSchema removeFile testDB @@ -59,14 +59,14 @@ testVerifyLintFKeyIndexes :: IO () testVerifyLintFKeyIndexes = do savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "") savedLint `deepseq` pure () - void $ createDBStore (DBOpts testDB "" False True TQOff) appMigrations MCConsole + void $ createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCConsole Nothing) getLintFKeyIndexes testDB "tests/tmp/agent_lint.sql" `shouldReturn` savedLint removeFile testDB testSchemaMigrations :: IO () testSchemaMigrations = do let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) appMigrations - Right st <- createDBStore (DBOpts testDB "" False True TQOff) noDownMigrations MCError + Right st <- createDBStore (DBOpts testDB "" False True TQOff) noDownMigrations (MigrationConfig MCError Nothing) mapM_ (testDownMigration st) $ drop (length noDownMigrations) appMigrations closeDBStore st removeFile testDB @@ -89,7 +89,7 @@ testSchemaMigrations = do testUsersMigrationNew :: IO () testUsersMigrationNew = do - Right st <- createDBStore (DBOpts testDB "" False True TQOff) appMigrations MCError + Right st <- createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCError Nothing) withTransaction' st (`SQL.query_` "SELECT user_id FROM users;") `shouldReturn` ([] :: [Only Int]) closeDBStore st @@ -97,11 +97,11 @@ testUsersMigrationNew = do testUsersMigrationOld :: IO () testUsersMigrationOld = do let beforeUsers = takeWhile (("m20230110_users" /=) . name) appMigrations - Right st <- createDBStore (DBOpts testDB "" False True TQOff) beforeUsers MCError + Right st <- createDBStore (DBOpts testDB "" False True TQOff) beforeUsers (MigrationConfig MCError Nothing) withTransaction' st (`SQL.query_` "SELECT name FROM sqlite_master WHERE type = 'table' AND name = 'users';") `shouldReturn` ([] :: [Only String]) closeDBStore st - Right st' <- createDBStore (DBOpts testDB "" False True TQOff) appMigrations MCYesUp + Right st' <- createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCYesUp Nothing) withTransaction' st' (`SQL.query_` "SELECT user_id FROM users;") `shouldReturn` ([Only (1 :: Int)]) closeDBStore st' diff --git a/tests/PostgresSchemaDump.hs b/tests/PostgresSchemaDump.hs index 77cc08fea..e9b54d540 100644 --- a/tests/PostgresSchemaDump.hs +++ b/tests/PostgresSchemaDump.hs @@ -12,7 +12,7 @@ import Data.Maybe (fromJust, isJust) import Simplex.Messaging.Agent.Store.Postgres (closeDBStore, createDBStore) import Simplex.Messaging.Agent.Store.Postgres.Common (DBOpts (..)) import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations -import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration) +import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration) import Simplex.Messaging.Util (ifM, whenM) import System.Directory (doesFileExist, removeFile) import System.Process (readCreateProcess, shell) @@ -30,12 +30,12 @@ postgresSchemaDumpTest migrations skipComparisonForDownMigrations testDBOpts@DBO testVerifySchemaDump = do savedSchema <- ifM (doesFileExist srcSchemaPath) (readFile srcSchemaPath) (pure "") savedSchema `deepseq` pure () - void $ createDBStore testDBOpts migrations MCConsole + void $ createDBStore testDBOpts migrations (MigrationConfig MCConsole Nothing) getSchema srcSchemaPath `shouldReturn` savedSchema testSchemaMigrations = do let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) migrations - Right st <- createDBStore testDBOpts noDownMigrations MCError + Right st <- createDBStore testDBOpts noDownMigrations (MigrationConfig MCError Nothing) mapM_ (testDownMigration st) $ drop (length noDownMigrations) migrations closeDBStore st whenM (doesFileExist testSchemaPath) $ removeFile testSchemaPath