smp server: import/export to/from PostgreSQL with one command, deprecation notice for journal storage (#1653)

This commit is contained in:
Evgeny
2025-10-09 13:31:57 +01:00
committed by GitHub
parent 11a4859f8e
commit 318ddf692a
2 changed files with 49 additions and 2 deletions
+4
View File
@@ -567,6 +567,10 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
forM_ storePaths_ $ \StorePaths {storeLogFile = f} -> loadStoreLog (mkQueue ms True) f $ queueStore ms
pure $ StoreMemory ms
SSCMemoryJournal {storeLogFile, storeMsgsPath} -> do
logWarn $
"Journal message store is deprecated and will be removed soon.\n"
<> "Please migrate to in-memory storage using `journal export` command.\n"
<> "After that you can migrate to PostgreSQL using `database import` command."
let qsCfg = MQStoreCfg
cfg = mkJournalStoreConfig qsCfg storeMsgsPath msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval
ms <- newMsgStore cfg
+45 -2
View File
@@ -186,6 +186,26 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
storeLogExists <- doesFileExist storeLogFilePath
msgsFileExists <- doesFileExist storeMsgsFilePath
case (cmd, tables) of
(SCImport, DTAll)
| not schemaExists && storeLogExists && msgsFileExists -> do
storeLogFile <- getRequiredStoreLogFile ini
confirmOrExit
("WARNING: store log file " <> storeLogFile <> " and message log file " <> storeMsgsFilePath <> " will be imported to PostrgreSQL database: " <> B.unpack connstr <> ", schema: " <> B.unpack schema)
"Store logs not imported"
(sCnt, qCnt) <- importStoreLogToDatabase logPath storeLogFile dbOpts
putStrLn $ "Imported: " <> show sCnt <> " services, " <> show qCnt <> " queues"
putStrLn "Importing messages..."
mCnt <- importMessagesToDatabase storeMsgsFilePath dbOpts
putStrLn $ "Import completed: " <> show mCnt <> " messages"
putStrLn $ case readStoreType ini of
Right (ASType SQSPostgres SMSPostgres) -> "store_queues and store_messages set to `database`, start the server."
Right _ -> "set store_queues and store_messages to `database` in INI file"
Left e -> e <> ", configure storage correctly"
| otherwise -> do
when schemaExists $ putStrLn $ "Schema " <> B.unpack schema <> " already exists in PostrgreSQL database: " <> B.unpack connstr
unless storeLogExists $ putStrLn $ storeLogFilePath <> " file does not exist."
unless msgsFileExists $ putStrLn $ storeMsgsFilePath <> " file does not exist."
exitFailure
(SCImport, DTQueues)
| schemaExists && storeLogExists -> exitConfigureQueueStore connstr schema
| schemaExists -> do
@@ -224,8 +244,27 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
putStrLn $ "Import completed: " <> show mCnt <> " messages"
putStrLn $ case readStoreType ini of
Right (ASType SQSPostgres SMSPostgres) -> "store_queues and store_messages set to `database`, start the server."
Right _ -> "set store_queues and store_messages set to `database` in INI file"
Right _ -> "set store_queues and store_messages to `database` in INI file"
Left e -> e <> ", configure storage correctly"
(SCExport, DTAll)
| schemaExists && not storeLogExists && not msgsFileExists -> do
confirmOrExit
("WARNING: PostrgreSQL schema " <> B.unpack schema <> " (database: " <> B.unpack connstr <> ") will be exported to store log file " <> storeLogFilePath <> " and to message log file " <> storeMsgsFilePath)
"Database store not exported"
(sCnt, qCnt) <- exportDatabaseToStoreLog logPath dbOpts storeLogFilePath
putStrLn $ "Exported: " <> show sCnt <> " services, " <> show qCnt <> " queues"
putStrLn "Exporting messages..."
let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
ms <- newMsgStore $ PostgresMsgStoreCfg storeCfg defaultMsgQueueQuota
withFile storeMsgsFilePath WriteMode (try . exportDbMessages True ms) >>= \case
Right mCnt -> putStrLn $ "Export completed: " <> show mCnt <> " messages"
Left (e :: SomeException) -> putStrLn $ "Error exporting messages: " <> show e
closeMsgStore ms
| otherwise -> do
unless schemaExists $ putStrLn $ "Schema " <> B.unpack schema <> " does not exist in PostrgreSQL database: " <> B.unpack connstr
when storeLogExists $ putStrLn $ storeLogFilePath <> " file already exists."
when msgsFileExists $ putStrLn $ storeMsgsFilePath <> " file already exists."
exitFailure
(SCExport, DTQueues)
| schemaExists && storeLogExists -> exitConfigureQueueStore connstr schema
| not schemaExists -> do
@@ -262,6 +301,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
putStrLn $ "Export completed: " <> show mCnt <> " messages"
putStrLn "Export queues with `smp-server database export queues`"
Left (e :: SomeException) -> putStrLn $ "Error exporting messages: " <> show e
closeMsgStore ms
(SCDelete, _)
| not schemaExists -> do
putStrLn $ "Schema " <> B.unpack schema <> " does not exist in PostrgreSQL database: " <> B.unpack connstr
@@ -760,16 +800,18 @@ data CliCommand
data StoreCmd = SCImport | SCExport | SCDelete
data DatabaseTable = DTQueues | DTMessages
data DatabaseTable = DTQueues | DTMessages | DTAll
instance StrEncoding DatabaseTable where
strEncode = \case
DTQueues -> "queues"
DTMessages -> "messages"
DTAll -> "all"
strP =
A.takeTill (== ' ') >>= \case
"queues" -> pure DTQueues
"messages" -> pure DTMessages
"all" -> pure DTAll
_ -> fail "DatabaseTable"
cliCommandP :: FilePath -> FilePath -> FilePath -> Parser CliCommand
@@ -940,6 +982,7 @@ cliCommandP cfgPath logPath iniFile =
( long "table"
<> help "Database tables: queues/messages"
<> metavar "TABLE"
<> value DTAll
)
parseBasicAuth :: ReadM ServerPassword
parseBasicAuth = eitherReader $ fmap ServerPassword . strDecode . B.pack