smp server: faster export (#1626)

* smp server: faster export

* flush

* export messages with PostgreSQL database

* remove flush

* batch message writes

* Revert "batch message writes"

This reverts commit 61fb3c3b9e.

* remove $!

* fast journal export

* another approach

* Revert "smp server: remove dependency of message size on the version (#1627)"

This reverts commit 8fea15245a.

* style

* faster?

* cleanup

* cleanup

* refactor

* refactor

* concurrent read messages

* Revert "concurrent read messages"

This reverts commit 05a32e6491.

* concurrent read/write

* parameter to export to/import from another message log file

* Revert "parameter to export to/import from another message log file"

This reverts commit 4e88b035c4.

* Revert "concurrent read/write"

This reverts commit a8eab1f7e3.
This commit is contained in:
Evgeny
2025-09-10 18:22:58 +01:00
committed by GitHub
parent 23aff6b0b1
commit 0c1030cf02
8 changed files with 138 additions and 57 deletions
@@ -25,6 +25,7 @@ module Simplex.Messaging.Server.QueueStore.Postgres
batchInsertQueues,
foldServiceRecs,
foldQueueRecs,
foldRecentQueueRecs,
handleDuplicate,
withLog_,
withDB',
@@ -545,8 +546,28 @@ foldServiceRecs st f =
DB.fold_ db "SELECT service_id, service_role, service_cert, service_cert_hash, created_at FROM services" mempty $
\ !acc -> fmap (acc <>) . f . rowToServiceRec
foldQueueRecs :: forall a q. Monoid a => Bool -> Bool -> PostgresQueueStore q -> Maybe Int64 -> ((RecipientId, QueueRec) -> IO a) -> IO a
foldQueueRecs tty withData st skipOld_ f = do
foldQueueRecs :: Monoid a => Bool -> Bool -> PostgresQueueStore q -> ((RecipientId, QueueRec) -> IO a) -> IO a
foldQueueRecs withData = foldQueueRecs_ foldRecs
where
foldRecs db acc f'
| withData = DB.fold_ db (queueRecQueryWithData <> cond) acc $ \acc' -> f' acc' . rowToQueueRecWithData
| otherwise = DB.fold_ db (queueRecQuery <> cond) acc $ \acc' -> f' acc' . rowToQueueRec
cond = " WHERE deleted_at IS NULL ORDER BY recipient_id ASC"
foldRecentQueueRecs :: Monoid a => Int64 -> Bool -> PostgresQueueStore q -> ((RecipientId, QueueRec) -> IO a) -> IO a
foldRecentQueueRecs old = foldQueueRecs_ foldRecs
where
foldRecs db acc f' = DB.fold db (queueRecQuery <> cond) (Only old) acc $ \acc' -> f' acc' . rowToQueueRec
cond = " WHERE deleted_at IS NULL AND updated_at > ? ORDER BY recipient_id ASC"
foldQueueRecs_ ::
Monoid a =>
(DB.Connection -> (Int, a) -> ((Int, a) -> (RecipientId, QueueRec) -> IO (Int, a)) -> IO (Int, a)) ->
Bool ->
PostgresQueueStore q ->
((RecipientId, QueueRec) -> IO a) ->
IO a
foldQueueRecs_ foldRecs tty st f = do
(n, r) <- withTransaction (dbStore st) $ \db ->
foldRecs db (0 :: Int, mempty) $ \(i, acc) qr -> do
r <- f qr
@@ -557,13 +578,6 @@ foldQueueRecs tty withData st skipOld_ f = do
when tty $ putStrLn $ progress n
pure r
where
foldRecs db acc f' = case skipOld_ of
Nothing
| withData -> DB.fold_ db (queueRecQueryWithData <> " WHERE deleted_at IS NULL") acc $ \acc' -> f' acc' . rowToQueueRecWithData
| otherwise -> DB.fold_ db (queueRecQuery <> " WHERE deleted_at IS NULL") acc $ \acc' -> f' acc' . rowToQueueRec
Just old
| withData -> DB.fold db (queueRecQueryWithData <> " WHERE deleted_at IS NULL AND updated_at > ?") (Only old) acc $ \acc' -> f' acc' . rowToQueueRecWithData
| otherwise -> DB.fold db (queueRecQuery <> " WHERE deleted_at IS NULL AND updated_at > ?") (Only old) acc $ \acc' -> f' acc' . rowToQueueRec
progress i = "Processed: " <> show i <> " records"
queueRecQuery :: Query