smp server: optionally append store log with postgres storage (without loading and compacting, for debugging during migration) (#1480)

* smp server: optionally maintain store log with postgres storage (without loading and compacting, for debugging during migration)

* refactor

* remove comment

src/Simplex/Messaging/Server/Main.hs

@@ -167,7 +167,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               ms <- newJournalMsgStore MQStoreCfg
               readQueueStore True (mkQueue ms) storeLogFile (queueStore ms)
               queues <- readTVarIO $ loadedQueues $ stmQueueStore ms
-              let storeCfg = PostgresStoreCfg {dbOpts = dbOpts {createSchema = True}, confirmMigrations = MCConsole, deletedTTL = iniDeletedTTL ini}
+              let storeCfg = PostgresStoreCfg {dbOpts = dbOpts {createSchema = True}, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = iniDeletedTTL ini}
               ps <- newJournalMsgStore $ PQStoreCfg storeCfg
               qCnt <- batchInsertQueues @(JournalQueue 'QSMemory) True queues $ postgresQueueStore ps
               renameFile storeLogFile $ storeLogFile <> ".bak"
@@ -189,9 +189,9 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               confirmOrExit
                 ("WARNING: PostrgreSQL database schema " <> B.unpack schema <> " (database: " <> B.unpack connstr <> ") will be exported to store log file " <> storeLogFilePath)
                 "Queue records not exported"
-              let storeCfg = PostgresStoreCfg {dbOpts, confirmMigrations = MCConsole, deletedTTL = iniDeletedTTL ini}
+              let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = iniDeletedTTL ini}
               ps <- newJournalMsgStore $ PQStoreCfg storeCfg
-              sl <- openWriteStoreLog storeLogFilePath
+              sl <- openWriteStoreLog False storeLogFilePath
               Sum qCnt <- foldQueueRecs True (postgresQueueStore ps) $ \(rId, qr) -> logCreateQueue sl rId qr $> Sum (1 :: Int)
               putStrLn $ "Export completed: " <> show qCnt <> " queues"
               putStrLn $ case readStoreType ini of
@@ -211,8 +211,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
         True -> readIniFile iniFile >>= either exitError a
         _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
     getRequiredStoreLogFile ini = do
-      let enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
-      case enableStoreLog $> storeLogFilePath of
+      case enableStoreLog' ini $> storeLogFilePath of
         Just storeLogFile -> do
           ifM
             (doesFileExist storeLogFile)
@@ -258,6 +257,8 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
     httpsCertFile = combine cfgPath "web.crt"
     httpsKeyFile = combine cfgPath "web.key"
     defaultStaticPath = combine logPath "www"
+    enableStoreLog' = settingIsOn "STORE_LOG" "enable"
+    enableDbStoreLog' = settingIsOn "STORE_LOG" "db_store_log"
     initializeServer opts@InitOptions {ip, fqdn, sourceCode = src', webStaticPath = sp', disableWeb = noWeb', scripted}
       | scripted = initialize opts
       | otherwise = do
@@ -338,7 +339,9 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                    \store_queues: memory\n\n\
                    \# Database connection settings for PostgreSQL database (`store_queues: database`).\n"
                 <> dbOptsIniContent dbOptions
-                <> "# Time to retain deleted queues in the database, days.\n"
+                <> "# Write database changes to store log file\n\
+                   \# db_store_log: off\n\n\
+                   \# Time to retain deleted queues in the database, days.\n"
                 <> ("db_deleted_ttl: " <> tshow defaultDeletedTTL <> "\n\n")
                 <> "# Message storage mode: `memory` or `journal`.\n\
                    \store_messages: memory\n\n\
@@ -471,14 +474,13 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
           runSMPServer cfg Nothing
       logDebug "Bye"
       where
-        enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
         logStats = settingIsOn "STORE_LOG" "log_stats" ini
         c = combine cfgPath . ($ defaultX509Config)
         restoreMessagesFile path = case iniOnOff "STORE_LOG" "restore_messages" ini of
           Just True -> Just path
           Just False -> Nothing
           -- if the setting is not set, it is enabled when store log is enabled
-          _ -> enableStoreLog $> path
+          _ -> enableStoreLog' ini $> path
         transports = iniTransports ini
         sharedHTTP = any (\(_, _, addHTTP) -> addHTTP) transports
         iniStoreType = either error id $! readStoreType ini
@@ -501,11 +503,12 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               httpCredentials = (\WebHttpsParams {key, cert} -> ServerCredentials {caCertificateFile = Nothing, privateKeyFile = key, certificateFile = cert}) <$> webHttpsParams',
               serverStoreCfg = case iniStoreType of
                 ASType SQSMemory SMSMemory ->
-                  ASSCfg SQSMemory SMSMemory $ SSCMemory $ enableStoreLog $> StorePaths {storeLogFile = storeLogFilePath, storeMsgsFile = restoreMessagesFile storeMsgsFilePath}
+                  ASSCfg SQSMemory SMSMemory $ SSCMemory $ enableStoreLog' ini $> StorePaths {storeLogFile = storeLogFilePath, storeMsgsFile = restoreMessagesFile storeMsgsFilePath}
                 ASType SQSMemory SMSJournal ->
                   ASSCfg SQSMemory SMSJournal $ SSCMemoryJournal {storeLogFile = storeLogFilePath, storeMsgsPath = storeMsgsJournalDir}
                 ASType SQSPostgres SMSJournal ->
-                  let storeCfg = PostgresStoreCfg {dbOpts = iniDBOptions ini, confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini}
+                  let dbStoreLogPath = enableDbStoreLog' ini $> storeLogFilePath
+                      storeCfg = PostgresStoreCfg {dbOpts = iniDBOptions ini, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini}
                    in ASSCfg SQSPostgres SMSJournal $ SSCDatabaseJournal {storeCfg, storeMsgsPath' = storeMsgsJournalDir},
               storeNtfsFile = restoreMessagesFile storeNtfsFilePath,
               -- allow creating new queues by default
@@ -607,16 +610,25 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               SQSPostgres -> do
                 let DBOpts {connstr, schema} = iniDBOptions ini
                 schemaExists <- checkSchemaExists connstr schema
-                if
-                  | storeLogExists && schemaExists -> exitConfigureQueueStore connstr schema
-                  | storeLogExists -> do
-                      putStrLn $ "Error: store_queues is `database` with " <> storeLogFilePath <> " file present."
-                      putStrLn "Set store_queues to `memory` or use `smp-server database import` to migrate."
-                      exitFailure
-                  | not schemaExists -> do
-                      putStrLn $ "Error: store_queues is `database`, create schema " <> B.unpack schema <> " in PostgreSQL database " <> B.unpack connstr
-                      exitFailure
-                  | otherwise -> pure ()
+                case enableDbStoreLog' ini of
+                  Just ()
+                    | not schemaExists -> noDatabaseSchema connstr schema
+                    | not storeLogExists -> do
+                        putStrLn $ "Error: db_store_log is `on`, " <> storeLogFilePath <> " does not exist"
+                        exitFailure
+                    | otherwise -> pure ()
+                  Nothing
+                    | storeLogExists && schemaExists -> exitConfigureQueueStore connstr schema
+                    | storeLogExists -> do
+                        putStrLn $ "Error: store_queues is `database` with " <> storeLogFilePath <> " file present."
+                        putStrLn "Set store_queues to `memory` or use `smp-server database import` to migrate."
+                        exitFailure
+                    | not schemaExists -> noDatabaseSchema connstr schema
+                    | otherwise -> pure ()
+                where
+                  noDatabaseSchema connstr schema = do
+                    putStrLn $ "Error: store_queues is `database`, create schema " <> B.unpack schema <> " in PostgreSQL database " <> B.unpack connstr
+                    exitFailure
         ASType SQSMemory SMSMemory
           | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
           | msgsDirExists -> do