Skip to content

Commit 4bdb1e3

Browse files
epoberezkinepoberezkin
committed
Merge branch 'master' into rcv-services
2 parents db4b27e + ca26c69 commit 4bdb1e3

33 files changed

+861
-356
lines changed

‎simplexmq.cabal‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
cabal-version: 1.12
22

33
name: simplexmq
4-
version: 6.5.0.6
4+
version: 6.5.0.7
55
synopsis: SimpleXMQ message broker
66
description: This package includes <./docs/Simplex-Messaging-Server.html server>,
77
<./docs/Simplex-Messaging-Client.html client> and
@@ -167,7 +167,8 @@ library
167167
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete
168168
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251009_queue_to_subscribe
169169
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251010_client_notices
170-
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251020_service_certs
170+
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251230_strict_tables
171+
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260115_service_certs
171172
else
172173
exposed-modules:
173174
Simplex.Messaging.Agent.Store.SQLite
@@ -217,7 +218,8 @@ library
217218
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete
218219
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251009_queue_to_subscribe
219220
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251010_client_notices
220-
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251020_service_certs
221+
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251230_strict_tables
222+
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260115_service_certs
221223
Simplex.Messaging.Agent.Store.SQLite.Util
222224
if flag(client_postgres) || flag(server_postgres)
223225
exposed-modules:

‎src/Simplex/FileTransfer/Agent.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -223,6 +223,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
223223
agentXFTPDownloadChunk c userId digest replica chunkSpec
224224
liftIO $ waitUntilForeground c
225225
(entityId, complete, progress) <- withStore c $ \db -> runExceptT $ do
226+
liftIO $ lockRcvFileForUpdate db rcvFileId
226227
liftIO $ updateRcvFileChunkReceived db (rcvChunkReplicaId replica) rcvChunkId relChunkPath
227228
RcvFile {size = FileSize currentSize, chunks, redirect} <- ExceptT $ getRcvFile db rcvFileId
228229
let rcvd = receivedSize chunks
@@ -413,6 +414,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
413414
withStore' c $ \db -> updateSndFileStatus db sndFileId SFSEncrypting
414415
(digest, chunkSpecsDigests) <- encryptFileForUpload sndFile fsEncPath
415416
withStore c $ \db -> do
417+
lockSndFileForUpdate db sndFileId
416418
updateSndFileEncrypted db sndFileId digest chunkSpecsDigests
417419
getSndFile db sndFileId
418420
else pure sndFile
@@ -530,6 +532,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
530532
agentXFTPUploadChunk c userId chunkDigest replica' chunkSpec'
531533
liftIO $ waitUntilForeground c
532534
sf@SndFile {sndFileEntityId, prefixPath, chunks} <- withStore c $ \db -> do
535+
lockSndFileForUpdate db sndFileId
533536
updateSndChunkReplicaStatus db sndChunkReplicaId SFRSUploaded
534537
getSndFile db sndFileId
535538
let uploaded = uploadedSize chunks

‎src/Simplex/Messaging/Agent.hs‎

Lines changed: 41 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -50,6 +50,7 @@ module Simplex.Messaging.Agent
5050
setUserService,
5151
connRequestPQSupport,
5252
createConnectionAsync,
53+
setConnShortLinkAsync,
5354
joinConnectionAsync,
5455
allowConnectionAsync,
5556
acceptContactAsync,
@@ -356,6 +357,11 @@ createConnectionAsync :: ConnectionModeI c => AgentClient -> UserId -> ACorrId -
356357
createConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:. newConnAsync c userId aCorrId enableNtfs
357358
{-# INLINE createConnectionAsync #-}
358359

360+
-- | Create or update user's contact connection short link (LSET command) asynchronously, no synchronous response
361+
setConnShortLinkAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE ()
362+
setConnShortLinkAsync c = withAgentEnv c .::. setConnShortLinkAsync' c
363+
{-# INLINE setConnShortLinkAsync #-}
364+
359365
-- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id
360366
joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
361367
joinConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId enableNtfs
@@ -926,6 +932,16 @@ checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAu
926932
when (maybe True (ts <) expires_) $
927933
throwError NOTICE {server = safeDecodeUtf8 $ strEncode $ L.head host, preset = isNothing srvKey, expiresAt = roundedToUTCTime <$> expires_}
928934

935+
setConnShortLinkAsync' :: forall c. ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM ()
936+
setConnShortLinkAsync' c corrId connId cMode userLinkData clientData =
937+
withConnLock c connId "setConnShortLinkAsync" $ do
938+
SomeConn _ conn <- withStore c (`getConn` connId)
939+
srv <- case (conn, cMode, userLinkData) of
940+
(ContactConnection _ RcvQueue {server}, SCMContact, UserContactLinkData {}) -> pure server
941+
(RcvConnection _ RcvQueue {server}, SCMInvitation, UserInvLinkData {}) -> pure server
942+
_ -> throwE $ CMD PROHIBITED "setConnShortLinkAsync: invalid connection or mode"
943+
enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET (AUCLD cMode userLinkData) clientData
944+
929945
setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM (ConnShortLink c)
930946
setConnShortLink' c nm connId cMode userLinkData clientData =
931947
withConnLock c connId "setConnShortLink" $ do
@@ -1169,7 +1185,8 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
11691185
let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
11701186
case sq_ of
11711187
Just sq@SndQueue {e2ePubKey = Just _k} -> do
1172-
e2eSndParams <- withStore c $ \db ->
1188+
e2eSndParams <- withStore c $ \db -> do
1189+
lockConnForUpdate db connId
11731190
getSndRatchet db connId v >>= \case
11741191
Right r -> pure $ Right $ snd r
11751192
Left e -> do
@@ -1183,6 +1200,7 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
11831200
sndKey_ = snd <$> invLink_
11841201
(q, _) <- lift $ newSndQueue userId "" qInfo sndKey_
11851202
withStore c $ \db -> runExceptT $ do
1203+
liftIO $ lockConnForUpdate db connId
11861204
e2eSndParams <- createRatchet_ db g maxSupported pqSupport e2eRcvParams
11871205
sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_
11881206
pure (cData, sq', e2eSndParams, lnkId_)
@@ -1261,7 +1279,8 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup su
12611279
AgentConfig {smpClientVRange = vr, smpAgentVRange, e2eEncryptVRange = e2eVR} <- asks config
12621280
let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMMessaging}
12631281
crData = ConnReqUriData SSSimplex smpAgentVRange [qUri] Nothing
1264-
e2eRcvParams <- withStore' c $ \db ->
1282+
e2eRcvParams <- withStore' c $ \db -> do
1283+
lockConnForUpdate db connId
12651284
getRatchetX3dhKeys db connId >>= \case
12661285
Right keys -> pure $ CR.mkRcvE2ERatchetParams (maxVersion e2eVR) keys
12671286
Left e -> do
@@ -1727,6 +1746,10 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
17271746
tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do
17281747
CCLink cReq _ <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv
17291748
notify $ INV (ACR cMode cReq)
1749+
LSET auData@(AUCLD cMode userLinkData) clientData ->
1750+
withServer' . tryCommand $ do
1751+
link <- setConnShortLink' c NRMBackground connId cMode userLinkData clientData
1752+
notify $ LINK (ACSL cMode link) auData
17301753
JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do
17311754
triedHosts <- newTVarIO S.empty
17321755
tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
@@ -2007,7 +2030,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} sq@SndQueue {userId, connId, server,
20072030
withRetryLock2 ri' qLock $ \riState loop -> do
20082031
liftIO $ waitWhileSuspended c
20092032
liftIO $ waitForUserNetwork c
2010-
resp <- tryError $ case msgType of
2033+
resp <- tryAllErrors $ case msgType of
20112034
AM_CONN_INFO -> sendConfirmation c NRMBackground sq msgBody
20122035
AM_CONN_INFO_REPLY -> sendConfirmation c NRMBackground sq msgBody
20132036
_ -> case pendingMsgPrepData_ of
@@ -2147,10 +2170,12 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} sq@SndQueue {userId, connId, server,
21472170
notifyDelMsgs :: InternalId -> AgentErrorType -> UTCTime -> AM ()
21482171
notifyDelMsgs msgId err expireTs = do
21492172
notifyDel msgId $ MERR (unId msgId) err
2150-
msgIds_ <- withStore' c $ \db -> getExpiredSndMessages db connId sq expireTs
2173+
msgIds_ <- withStore' c $ \db -> do
2174+
msgIds_ <- getExpiredSndMessages db connId sq expireTs
2175+
forM_ msgIds_ $ \msgId' -> deleteSndMsgDelivery db connId sq msgId' False `catchAll_` pure ()
2176+
pure msgIds_
21512177
forM_ (L.nonEmpty msgIds_) $ \msgIds -> do
21522178
notify $ MERRS (L.map unId msgIds) err
2153-
withStore' c $ \db -> forM_ msgIds $ \msgId' -> deleteSndMsgDelivery db connId sq msgId' False `catchAll_` pure ()
21542179
atomically $ incSMPServerStat' c userId server sentExpiredErrs (length msgIds_ + 1)
21552180
delMsg :: InternalId -> AM ()
21562181
delMsg = delMsgKeep False
@@ -2798,15 +2823,14 @@ subscriber c@AgentClient {msgQ} = forever $ do
27982823

27992824
cleanupManager :: AgentClient -> AM' ()
28002825
cleanupManager c@AgentClient {subQ} = do
2801-
delay <- asks (initialCleanupDelay . config)
2802-
liftIO $ threadDelay' delay
2803-
int <- asks (cleanupInterval . config)
2804-
ttl <- asks $ storedMsgDataTTL . config
2826+
AgentConfig {initialCleanupDelay, cleanupInterval = int, storedMsgDataTTL = ttl, cleanupBatchSize = limit} <-
2827+
asks config
2828+
liftIO $ threadDelay' initialCleanupDelay
28052829
forever $ waitActive $ do
28062830
run ERR deleteConns
2807-
run ERR $ withStore' c (`deleteRcvMsgHashesExpired` ttl)
2808-
run ERR $ withStore' c (`deleteSndMsgsExpired` ttl)
2809-
run ERR $ withStore' c (`deleteRatchetKeyHashesExpired` ttl)
2831+
run ERR $ withStore' c $ \db -> deleteRcvMsgHashesExpired db ttl limit
2832+
run ERR $ withStore' c $ \db -> deleteSndMsgsExpired db ttl limit
2833+
run ERR $ withStore' c $ \db -> deleteRatchetKeyHashesExpired db ttl limit
28102834
run ERR $ withStore' c (`deleteExpiredNtfTokensToDelete` ttl)
28112835
run RFERR deleteRcvFilesExpired
28122836
run RFERR deleteRcvFilesDeleted
@@ -3084,7 +3108,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
30843108
throwE e
30853109
agentClientMsg :: TVar ChaChaDRG -> ByteString -> AM (Maybe (InternalId, MsgMeta, AMessage, CR.RatchetX448))
30863110
agentClientMsg g encryptedMsgHash = withStore c $ \db -> runExceptT $ do
3087-
rc <- ExceptT $ getRatchet db connId -- ratchet state pre-decryption - required for processing EREADY
3111+
liftIO $ lockConnForUpdate db connId
3112+
rc <- ExceptT $ getRatchetForUpdate db connId -- ratchet state pre-decryption - required for processing EREADY
30883113
(agentMsgBody, pqEncryption) <- agentRatchetDecrypt' g db connId rc encAgentMessage
30893114
liftEither (parse smpP (SEAgentError $ AGENT A_MESSAGE) agentMsgBody) >>= \case
30903115
agentMsg@(AgentMessage APrivHeader {sndMsgId, prevMsgHash} aMessage) -> do
@@ -3331,6 +3356,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
33313356
Just sqs' -> do
33323357
(sq_@SndQueue {sndPrivateKey}, dhPublicKey) <- lift $ newSndQueue userId connId qInfo Nothing
33333358
sq2 <- withStore c $ \db -> do
3359+
lockConnForUpdate db connId
33343360
liftIO $ mapM_ (deleteConnSndQueue db connId) delSqs
33353361
addConnSndQueue db connId (sq_ :: NewSndQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
33363362
logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret' srvMsgId <> " " <> logSecret (senderId queueAddress)
@@ -3635,7 +3661,7 @@ agentRatchetEncrypt db cData msg getPaddedLen pqEnc_ currentE2EVersion = do
36353661

36363662
agentRatchetEncryptHeader :: DB.Connection -> ConnData -> (VersionSMPA -> PQSupport -> Int) -> Maybe PQEncryption -> CR.VersionE2E -> ExceptT StoreError IO (CR.MsgEncryptKeyX448, Int, PQEncryption)
36373663
agentRatchetEncryptHeader db ConnData {connId, connAgentVersion = v, pqSupport} getPaddedLen pqEnc_ currentE2EVersion = do
3638-
rc <- ExceptT $ getRatchet db connId
3664+
rc <- ExceptT $ getRatchetForUpdate db connId
36393665
let paddedLen = getPaddedLen v pqSupport
36403666
(mek, rc') <- withExceptT (SEAgentError . cryptoError) $ CR.rcEncryptHeader rc pqEnc_ currentE2EVersion
36413667
liftIO $ updateRatchet db connId rc' CR.SMDNoChange
@@ -3644,7 +3670,7 @@ agentRatchetEncryptHeader db ConnData {connId, connAgentVersion = v, pqSupport}
36443670
-- encoded EncAgentMessage -> encoded AgentMessage
36453671
agentRatchetDecrypt :: TVar ChaChaDRG -> DB.Connection -> ConnId -> ByteString -> ExceptT StoreError IO (ByteString, PQEncryption)
36463672
agentRatchetDecrypt g db connId encAgentMsg = do
3647-
rc <- ExceptT $ getRatchet db connId
3673+
rc <- ExceptT $ getRatchetForUpdate db connId
36483674
agentRatchetDecrypt' g db connId rc encAgentMsg
36493675

36503676
agentRatchetDecrypt' :: TVar ChaChaDRG -> DB.Connection -> ConnId -> CR.RatchetX448 -> ByteString -> ExceptT StoreError IO (ByteString, PQEncryption)

‎src/Simplex/Messaging/Agent/Client.hs‎

Lines changed: 34 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -244,6 +244,7 @@ import Simplex.Messaging.Agent.Stats
244244
import Simplex.Messaging.Agent.Store
245245
import Simplex.Messaging.Agent.Store.AgentStore
246246
import Simplex.Messaging.Agent.Store.Common (DBStore)
247+
import Simplex.Messaging.Agent.Store.DB (SQLError)
247248
import qualified Simplex.Messaging.Agent.Store.DB as DB
248249
import Simplex.Messaging.Agent.Store.Entity
249250
import Simplex.Messaging.Agent.TSessionSubs (TSessionSubs)
@@ -2231,39 +2232,46 @@ withWork :: AgentClient -> TMVar () -> (DB.Connection -> IO (Either StoreError (
22312232
withWork c doWork = withWork_ c doWork . withStore' c
22322233
{-# INLINE withWork #-}
22332234

2235+
-- setting doWork flag to "no work" before getWork rather than after prevents race condition when flag is set to "has work" by another thread after getWork call.
22342236
withWork_ :: (AnyStoreError e', MonadIO m) => AgentClient -> TMVar () -> ExceptT e m (Either e' (Maybe a)) -> (a -> ExceptT e m ()) -> ExceptT e m ()
22352237
withWork_ c doWork getWork action =
2236-
getWork >>= \case
2237-
Right (Just r) -> action r
2238-
Right Nothing -> noWork
2239-
-- worker is stopped here (noWork) because the next iteration is likely to produce the same result
2238+
noWork >> getWork >>= \case
2239+
Right (Just r) -> hasWork >> action r
2240+
Right Nothing -> pure ()
22402241
Left e
2241-
| isWorkItemError e -> noWork >> notifyErr (CRITICAL False) e
2242-
| otherwise -> notifyErr INTERNAL e
2242+
| isWorkItemError e -> notifyErr (CRITICAL False) e -- worker remains stopped here because the next iteration is likely to produce the same result
2243+
| otherwise -> hasWork >> notifyErr INTERNAL e
22432244
where
2245+
hasWork = atomically $ hasWorkToDo' doWork
22442246
noWork = liftIO $ noWorkToDo doWork
2245-
notifyErr err e = atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
2247+
notifyErr err e = do
2248+
logError $ "withWork_ error: " <> tshow e
2249+
atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
22462250

22472251
withWorkItems :: (AnyStoreError e', MonadIO m) => AgentClient -> TMVar () -> ExceptT e m (Either e' [Either e' a]) -> (NonEmpty a -> ExceptT e m ()) -> ExceptT e m ()
22482252
withWorkItems c doWork getWork action = do
2249-
getWork >>= \case
2250-
Right [] -> noWork
2253+
noWork >> getWork >>= \case
2254+
Right [] -> pure ()
22512255
Right rs -> do
22522256
let (errs, items) = partitionEithers rs
22532257
case L.nonEmpty items of
2254-
Just items' -> action items'
2258+
Just items' -> hasWork >> action items'
22552259
Nothing -> do
2256-
let criticalErr = find isWorkItemError errs
2257-
forM_ criticalErr $ \err -> do
2258-
notifyErr (CRITICAL False) err
2259-
when (all isWorkItemError errs) noWork
2260+
case find isWorkItemError errs of
2261+
Nothing -> hasWork
2262+
Just err -> do
2263+
notifyErr (CRITICAL False) err
2264+
unless (all isWorkItemError errs) hasWork
22602265
forM_ (L.nonEmpty errs) $ notifySub c . ERRS . L.map (\e -> ("", INTERNAL $ show e))
22612266
Left e
2262-
| isWorkItemError e -> noWork >> notifyErr (CRITICAL False) e
2263-
| otherwise -> notifyErr INTERNAL e
2267+
| isWorkItemError e -> notifyErr (CRITICAL False) e
2268+
| otherwise -> hasWork >> notifyErr INTERNAL e
22642269
where
2270+
hasWork = atomically $ hasWorkToDo' doWork
22652271
noWork = liftIO $ noWorkToDo doWork
2266-
notifyErr err e = atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
2272+
notifyErr err e = do
2273+
logError $ "withWorkItems error: " <> tshow e
2274+
atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
22672275

22682276
noWorkToDo :: TMVar () -> IO ()
22692277
noWorkToDo = void . atomically . tryTakeTMVar
@@ -2361,25 +2369,19 @@ withStore :: AgentClient -> (DB.Connection -> IO (Either StoreError a)) -> AM a
23612369
withStore c action = do
23622370
st <- asks store
23632371
withExceptT storeError . ExceptT . liftIO . agentOperationBracket c AODatabase (\_ -> pure ()) $
2364-
withTransaction st action `E.catches` handleDBErrors
2372+
withTransaction st action `E.catch` handleDBErrors
23652373
where
2374+
handleDBErrors :: E.SomeException -> IO (Either StoreError a)
2375+
handleDBErrors e = pure $ Left $ case E.fromException e of
2376+
Just (e' :: SQLError) ->
23662377
#if defined(dbPostgres)
2367-
-- TODO [postgres] postgres specific error handling
2368-
handleDBErrors :: [E.Handler IO (Either StoreError a)]
2369-
handleDBErrors =
2370-
[ E.Handler $ \(E.SomeException e) -> pure . Left $ SEInternal $ bshow e
2371-
]
2378+
SEInternal $ bshow e'
23722379
#else
2373-
handleDBErrors :: [E.Handler IO (Either StoreError a)]
2374-
handleDBErrors =
2375-
[ E.Handler $ \(e :: SQL.SQLError) ->
2376-
let se = SQL.sqlError e
2377-
busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked
2378-
err = tshow se <> ": " <> SQL.sqlErrorDetails e <> ", " <> SQL.sqlErrorContext e
2379-
in pure . Left . (if busy then SEDatabaseBusy else SEInternal) $ encodeUtf8 err,
2380-
E.Handler $ \(E.SomeException e) -> pure . Left $ SEInternal $ bshow e
2381-
]
2380+
let se = SQL.sqlError e'
2381+
busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked
2382+
in (if busy then SEDatabaseBusy else SEInternal) $ bshow e'
23822383
#endif
2384+
Nothing -> SEInternal $ bshow e
23832385

23842386
unsafeWithStore :: AgentClient -> (DB.Connection -> IO a) -> AM' a
23852387
unsafeWithStore c action = do

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

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -154,6 +154,7 @@ data AgentConfig = AgentConfig
154154
persistErrorInterval :: NominalDiffTime,
155155
initialCleanupDelay :: Int64,
156156
cleanupInterval :: Int64,
157+
cleanupBatchSize :: Int,
157158
initialLogStatsDelay :: Int64,
158159
logStatsInterval :: Int64,
159160
cleanupStepInterval :: Int,
@@ -225,7 +226,8 @@ defaultAgentConfig =
225226
quotaExceededTimeout = 7 * nominalDay,
226227
persistErrorInterval = 3, -- seconds
227228
initialCleanupDelay = 30 * 1000000, -- 30 seconds
228-
cleanupInterval = 30 * 60 * 1000000, -- 30 minutes
229+
cleanupInterval = 5 * 60 * 1000000, -- 5 minutes
230+
cleanupBatchSize = 10000,
229231
initialLogStatsDelay = 10 * 1000000, -- 10 seconds
230232
logStatsInterval = 10 * 1000000, -- 10 seconds
231233
cleanupStepInterval = 200000, -- 200ms

0 commit comments

Comments
 (0)