diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index 0e549d517..1dcc117fa 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -35,6 +35,7 @@ data AgentConfig = AgentConfig tbqSize :: Natural, dbFile :: FilePath, dbPoolSize :: Int, + yesToMigrations :: Bool, smpCfg :: SMPClientConfig, reconnectInterval :: RetryInterval, helloTimeout :: NominalDiffTime, @@ -53,6 +54,7 @@ defaultAgentConfig = tbqSize = 16, dbFile = "smp-agent.db", dbPoolSize = 4, + yesToMigrations = False, smpCfg = smpDefaultConfig, reconnectInterval = RetryInterval @@ -79,9 +81,9 @@ data Env = Env } newSMPAgentEnv :: (MonadUnliftIO m, MonadRandom m) => AgentConfig -> m Env -newSMPAgentEnv cfg = do +newSMPAgentEnv config@AgentConfig {dbFile, dbPoolSize, yesToMigrations} = do idsDrg <- newTVarIO =<< drgNew - store <- liftIO $ createSQLiteStore (dbFile cfg) (dbPoolSize cfg) Migrations.app + store <- liftIO $ createSQLiteStore dbFile dbPoolSize Migrations.app yesToMigrations clientCounter <- newTVarIO 0 randomServer <- newTVarIO =<< liftIO newStdGen - return Env {config = cfg, store, idsDrg, clientCounter, randomServer} + return Env {config, store, idsDrg, clientCounter, randomServer} diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 597eb3148..d4579c8cc 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -76,13 +76,13 @@ data SQLiteStore = SQLiteStore dbNew :: Bool } -createSQLiteStore :: FilePath -> Int -> [Migration] -> IO SQLiteStore -createSQLiteStore dbFilePath poolSize migrations = do +createSQLiteStore :: FilePath -> Int -> [Migration] -> Bool -> IO SQLiteStore +createSQLiteStore dbFilePath poolSize migrations yesToMigrations = do let dbDir = takeDirectory dbFilePath createDirectoryIfMissing False dbDir st <- connectSQLiteStore dbFilePath poolSize checkThreadsafe st - migrateSchema st migrations + migrateSchema st migrations yesToMigrations pure st checkThreadsafe :: SQLiteStore -> IO () @@ -94,15 +94,16 @@ checkThreadsafe st = withConnection st $ \db -> do Nothing -> putStrLn "Warning: SQLite THREADSAFE compile option not found" _ -> return () -migrateSchema :: SQLiteStore -> [Migration] -> IO () -migrateSchema st migrations = withConnection st $ \db -> do +migrateSchema :: SQLiteStore -> [Migration] -> Bool -> IO () +migrateSchema st migrations yesToMigrations = withConnection st $ \db -> do Migrations.initialize db Migrations.get db migrations >>= \case Left e -> confirmOrExit $ "Database error: " <> e Right [] -> pure () Right ms -> do unless (dbNew st) $ do - confirmOrExit "The app has a newer version than the database - it will be backed up and upgraded." + unless yesToMigrations $ + confirmOrExit "The app has a newer version than the database - it will be backed up and upgraded." let f = dbFilePath st copyFile f (f <> ".bak") Migrations.run db ms diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 2c339a118..7cfdd989f 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -51,7 +51,7 @@ createStore = 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 - createSQLiteStore (testDB <> show r) 4 Migrations.app + createSQLiteStore (testDB <> show r) 4 Migrations.app True removeStore :: SQLiteStore -> IO () removeStore store = do