agent: option to enable/disable vacuum after SQLite migration (#1429)

src/Simplex/Messaging/Agent/Env/SQLite.hs

@@ -281,7 +281,7 @@ newSMPAgentEnv config store = do
 createAgentStore :: ConnectInfo -> String -> MigrationConfirmation -> IO (Either MigrationError DBStore)
 createAgentStore = createStore
 #else
-createAgentStore :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> IO (Either MigrationError DBStore)
+createAgentStore :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> Bool -> IO (Either MigrationError DBStore)
 createAgentStore = createStore
 #endif
 

src/Simplex/Messaging/Agent/Store.hs

@@ -56,25 +56,25 @@ import Simplex.Messaging.Protocol
 import qualified Simplex.Messaging.Protocol as SMP
 #if defined(dbPostgres)
 import Database.PostgreSQL.Simple (ConnectInfo (..))
-import qualified Simplex.Messaging.Agent.Store.Postgres as StoreFunctions
+import qualified Simplex.Messaging.Agent.Store.Postgres as Store
 #else
 import Data.ByteArray (ScrubbedBytes)
-import qualified Simplex.Messaging.Agent.Store.SQLite as StoreFunctions
+import qualified Simplex.Messaging.Agent.Store.SQLite as Store
 #endif
 
 #if defined(dbPostgres)
 createStore :: ConnectInfo -> String -> MigrationConfirmation -> IO (Either MigrationError DBStore)
-createStore connectInfo schema = StoreFunctions.createDBStore connectInfo schema Migrations.app
+createStore connectInfo schema = Store.createDBStore connectInfo schema Migrations.app
 #else
-createStore :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> IO (Either MigrationError DBStore)
-createStore dbFilePath dbKey keepKey = StoreFunctions.createDBStore dbFilePath dbKey keepKey Migrations.app
+createStore :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> Bool -> IO (Either MigrationError DBStore)
+createStore dbFilePath dbKey keepKey = Store.createDBStore dbFilePath dbKey keepKey Migrations.app
 #endif
 
 closeStore :: DBStore -> IO ()
-closeStore = StoreFunctions.closeDBStore
+closeStore = Store.closeDBStore
 
 execSQL :: DB.Connection -> Text -> IO [Text]
-execSQL = StoreFunctions.execSQL
+execSQL = Store.execSQL
 
 -- * Queue types
 

src/Simplex/Messaging/Agent/Store/Migrations.hs

@@ -48,8 +48,8 @@ migrationsToRun (a : as) (d : ds)
   | name a == name d = migrationsToRun as ds
   | otherwise = Left $ MTREDifferent (name a) (name d)
 
-migrateSchema :: DBStore -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError ())
-migrateSchema st migrations confirmMigrations = do
+migrateSchema :: DBStore -> [Migration] -> MigrationConfirmation -> Bool -> IO (Either MigrationError ())
+migrateSchema st migrations confirmMigrations vacuum = do
   Migrations.initialize st
   get st migrations >>= \case
     Left e -> do
@@ -57,17 +57,17 @@ migrateSchema st migrations confirmMigrations = do
       pure . Left $ MigrationError e
     Right MTRNone -> pure $ Right ()
     Right ms@(MTRUp ums)
-      | dbNew st -> Migrations.run st ms $> Right ()
+      | dbNew st -> Migrations.run st vacuum ms $> Right ()
       | otherwise -> case confirmMigrations of
-          MCYesUp -> runWithBackup st ms
-          MCYesUpDown -> runWithBackup st ms
-          MCConsole -> confirm err >> runWithBackup st ms
+          MCYesUp -> runWithBackup st vacuum ms
+          MCYesUpDown -> runWithBackup st vacuum ms
+          MCConsole -> confirm err >> runWithBackup st vacuum 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 st ms
-      MCConsole -> confirm err >> runWithBackup st ms
+      MCYesUpDown -> runWithBackup st vacuum ms
+      MCConsole -> confirm err >> runWithBackup st vacuum ms
       MCYesUp -> pure $ Left err
       MCError -> pure $ Left err
       where
@@ -75,14 +75,14 @@ migrateSchema st migrations confirmMigrations = do
   where
     confirm err = confirmOrExit $ migrationErrorDescription err
 
-runWithBackup :: DBStore -> MigrationsToRun -> IO (Either a ())
+runWithBackup :: DBStore -> Bool -> MigrationsToRun -> IO (Either a ())
 #if defined(dbPostgres)
-runWithBackup st ms = Migrations.run st ms $> Right ()
+runWithBackup st vacuum ms = Migrations.run st vacuum ms $> Right ()
 #else
-runWithBackup st ms = do
+runWithBackup st vacuum ms = do
   let f = dbFilePath st
   copyFile f (f <> ".bak")
-  Migrations.run st ms
+  Migrations.run st vacuum ms
   pure $ Right ()
 #endif
 

src/Simplex/Messaging/Agent/Store/Postgres.hs

@@ -46,7 +46,7 @@ createDBStore :: ConnectInfo -> String -> [Migration] -> MigrationConfirmation -
 createDBStore connectInfo schema migrations confirmMigrations = do
   createDBAndUserIfNotExists connectInfo
   st <- connectPostgresStore connectInfo schema
-  r <- migrateSchema st migrations confirmMigrations `onException` closeDBStore st
+  r <- migrateSchema st migrations confirmMigrations True `onException` closeDBStore st
   case r of
     Right () -> pure $ Right st
     Left e -> closeDBStore st $> Left e

src/Simplex/Messaging/Agent/Store/Postgres/Migrations.hs

@@ -53,8 +53,8 @@ initialize st = withTransaction' st $ \db ->
       )
     |]
 
-run :: DBStore -> MigrationsToRun -> IO ()
-run st = \case
+run :: DBStore -> Bool -> MigrationsToRun -> IO ()
+run st _vacuum = \case
   MTRUp [] -> pure ()
   MTRUp ms -> mapM_ runUp ms
   MTRDown ms -> mapM_ runDown $ reverse ms

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -65,12 +65,12 @@ import UnliftIO.STM
 
 -- * SQLite Store implementation
 
-createDBStore :: FilePath -> ScrubbedBytes -> Bool -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore)
-createDBStore dbFilePath dbKey keepKey migrations confirmMigrations = do
+createDBStore :: FilePath -> ScrubbedBytes -> Bool -> [Migration] -> MigrationConfirmation -> Bool -> IO (Either MigrationError DBStore)
+createDBStore dbFilePath dbKey keepKey migrations confirmMigrations vacuum = do
   let dbDir = takeDirectory dbFilePath
   createDirectoryIfMissing True dbDir
   st <- connectSQLiteStore dbFilePath dbKey keepKey
-  r <- migrateSchema st migrations confirmMigrations `onException` closeDBStore st
+  r <- migrateSchema st migrations confirmMigrations vacuum `onException` closeDBStore st
   case r of
     Right () -> pure $ Right st
     Left e -> closeDBStore st $> Left e

src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs

@@ -122,10 +122,12 @@ getCurrent DB.Connection {DB.conn} = map toMigration <$> SQL.query_ conn "SELECT
   where
     toMigration (name, down) = Migration {name, up = "", down}
 
-run :: DBStore -> MigrationsToRun -> IO ()
-run st = \case
+run :: DBStore -> Bool -> MigrationsToRun -> IO ()
+run st vacuum = \case
   MTRUp [] -> pure ()
-  MTRUp ms -> mapM_ runUp ms >> withConnection' st (`execSQL` "VACUUM;")
+  MTRUp ms -> do
+    mapM_ runUp ms
+    when vacuum $ withConnection' st (`execSQL` "VACUUM;")
   MTRDown ms -> mapM_ runDown $ reverse ms
   MTRNone -> pure ()
   where