5.2.1 (ntf 1.5.1, xftp 1.0.1) (#799 )

resubscribe in batches in Client.Agent (#798 )
* resubscribe in batches in Client.Agent * fix test
2026-08-30 09:48:23 +00:00 · 2023-07-13 19:23:06 +01:00 · 2023-07-12 07:35:38 +01:00 · 2023-07-11 19:43:31 +01:00 · 2023-07-11 18:54:14 +01:00 · 2023-07-11 20:19:20 +04:00
51 changed files with 2445 additions and 823 deletions
@@ -1,3 +1,47 @@
+# 5.2.0 (NTF server 1.5.0)
+
+Agent:
+- treat agent INACTIVE error as temporary - fixes failed message delivery in some race conditions.
+- restore connection confirmations after client restart - fixes failed connections.
+- ratchet resynchronization protocol and API.
+- increase connection version to mutually supported by both peers on each received message.
+
+Client:
+- make timeout for batched functions dependent on the number of batches - fixes expiry on large batches.
+
+Servers:
+- add timeout in case of sending TCP traffic and in case of partial delivery of requested blocks to avoid resource leaks.
+
+# 5.1.2, 5.1.3 (NTF server 1.4.1, 1.4.2)
+
+Agent:
+- ACK message on decryption error (fixes stuck message delivery bug)
+- more robust connection switching logic, API to abort switching the address
+
+Notification server:
+- batch subscriptions to SMP servers
+
+# 5.1.1 (NTF server 1.4.0)
+
+Agent:
+- store and check hashes of previous encrypted messages to differentiate between duplicates and decryption errors
+
+Server:
+- larger processing queues
+- expire messages when restoring them
+
+# 5.1.0
+
+XFTP client:
+- check encrypted file exists when uploading
+- remove user ID from deletion API
+
+Agent:
+- vacuum database on migrations
+
+SMP server:
+- configure message expiration time in INI file
+
 # 5.0.0

 SimpleX File Transfer Protocol (XFTP):
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 5.1.2
+version: 5.2.1
 synopsis: SimpleXMQ message broker
 description: |
  This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -0,0 +1,366 @@
+# Re-sync encryption ratchets
+
+## Problem
+
+See https://github.com/simplex-chat/simplexmq/pull/743/files for problem and high-level solution.
+
+## Implementation
+
+### Diagnosing ratchet de-synchronization
+
+Message decryption happens in `agentClientMsg`, in `agentRatchetDecrypt`, which can return decryption result or error. Decryption error can be differentiated in `agentClientMsg` result pattern match, in Left cases, where we already differentiate duplicate error (`AGENT A_DUPLICATE`).
+
+Question: Which decryption errors can be diagnosed as ratchet de-synchronization?
+
+Possibly any `AGENT A_CRYPTO` error. Definitely on `RATCHET_HEADER`, TBC other. See `cryptoError :: C.CryptoError -> AgentErrorType` for conversion from decryption errors to `A_CRYPTO` or other agent errors. We're only interested in crypto errors, as other are either other client implementation errors, internal errors, or already processed duplicate error.
+
+Proposed classification of crypto errors, based on `AgentCryptoError`:
+
+`DECRYPT_AES` -> re-sync allowed (recommended/required?)
+
+`DECRYPT_CB` -> re-sync allowed (recommended/required?)
+
+`RATCHET_HEADER` -> **re-sync required**
+
+`RATCHET_EARLIER` -> re-sync allowed
+
+`RATCHET_SKIPPED` -> **re-sync required**
+
+Ratchet re-synchronization could be started automatically on diagnosing de-synchronization, based on these errors. As a potentially dangerous feature (e.g., implementation error could lead to infinite re-sync loop causing large traffic consumption), initially it will be available via agent functional api for client to call. Ratchet de-synchronization will instead produce an event prompting client to re-synchronize.
+
+Diagnosing possible ratchet de-synchronization also will be recorded as connection state - `ratchet_desync_state` field in `connections` table. Client should be prohibited to start ratchet re-synchronization unless `ratchet_desync_state` is set.
+
+Event should not be repeated for following received messages that can't be decrypted - based on `ratchet_desync_state`. If a received message can be decrypted, `ratchet_desync_state` should be set to NULL and a new event sent, indicating ratchet has healed.
+
+New event - `RDESYNC :: RatchetDesyncState -> ConnectionStats -> ACommand Agent AEConn`
+
+```haskell
+data RatchetDesyncState
+  = RDResyncAllowed
+  | RDResyncRequired
+  | RDHealed
+```
+
+New field should be added to `ConnectionStats` - `ratchetDesyncState :: Maybe RatchetDesyncState`, based on `ratchet_desync_state`.
+
+> On `RDESYNC` events chat should create chat item, prompting ratchet re-synchronization or notifying it has healed.
+> If connection has diagnosed ratchet de-sync, chat item should have a button to start ratchet re-sync.
+> We'd have to get `ConnectionStats` on chat level for this instead of chat info.
+> This wouldn't work for groups. One option is to add `ConnectionStats` to `GroupMember` type and update on events.
+> Same could be done for `Contact` then.
+
+To consider - allow to start ratchet re-synchronization at any time regardless of this field as an experimental feature. In chat it could be behind "Developer tools" + additional "Experimental" toggle. Agent api would have `force :: Bool` as parameter, allowing to bypass `ratchet_desync_state`. Should `ratchet_resync_state` (see below) still be honored in this case?
+
+### Re-synchronization process
+
+\*\*\*\*\*
+
+Basic idea is the following:
+
+Both agents send new ratchet keys and compute a new shared secret. Agent that starts re-synchronization should record this fact in the connection state. Agent that receives a new key should respond with a key of its own, unless it has recorded that it itself started re-synchronization in the connection state.
+
+It can happen that both agents start re-synchronizing simultaneously. In this case they both would record it in the connection state and would not respond with a new message - instead they would use each other's already sent keys.
+
+Agent has both keys if:
+
+- It initiates with the first key, and then receives the second key;
+- It receives the first key and then generates its own in response.
+
+After agent has both keys, it initiates new ratchet depending on keys ordering. The agent that sent the lower key should use `initRcvRatchet` function, the agent that sent the greater key should use `initSndRatchet` (or vice versa - but they should deterministically choose different sides).
+
+\*\*\*\*\*
+
+State whether the ratchet re-synchronization is in progress should be tracked in database via `connections` table new `ratchet_resync_state` field.
+
+New functional api:
+
+```haskell
+resyncConnectionRatchet :: AgentErrorMonad m => AgentClient -> ConnId -> m ConnectionStats
+```
+
+or if we want to allow re-synchronizing ratchet at any time even if de-synchronization wasn't diagnosed:
+
+```haskell
+resyncConnectionRatchet :: AgentErrorMonad m => AgentClient -> ConnId -> Bool -> m ConnectionStats
+resyncConnectionRatchet c connId force = ...
+```
+
+Possibly client command?
+
+``` haskell
+data ACommand (p :: AParty) (e :: AEntity) where
+  ...
+  RESYNC_RATCHET :: Bool -> ACommand Client AEConn
+```
+
+New event - `RRESYNC :: RatchetResyncState -> ConnectionStats -> ACommand Agent AEConn`
+
+```haskell
+data RatchetResyncState
+  = RRStarted
+  | RRAgreedSnd
+  | RRAgreedRcv
+  | RRComplete
+```
+
+New `ConnectionStats` field - `ratchetResyncState :: Maybe RatchetResyncState`.
+
+When called, it should:
+
+- Generate new keys.
+- Update database connection state.
+  - Set `ratchet_desync_state` to NULL.
+  - Set `ratchet_resync_state` to `RRStarted`.
+  - Delete old ratchet from `ratchets` (is it safe?), create new ratchet.
+- Send `AgentRatchetKey` message.
+- Return updated `ConnectionStats` to client.
+
+> On `RRESYNC` events chat should create chat item, and reset connection verification.
+> Parameterized `RRESYNC` allows to distinguish: start and end of re-synchronization for initiating party; chat item direction - `RRESYNC RRStarted` is snd, `RRESYNC RRAgreedSnd/Rcv` and `RRESYNC RRComplete` are rcv (`RRESYNC RRAgreedSnd/Rcv` chat item could be omitted).
+
+AgentRatchetKey is a new message on the level of AgentMsgEnvelope - encrypted with queue level e2e encryption, but not with connection level e2e encryption (since ratchet de-synchronized).
+
+```haskell
+data AgentMsgEnvelope
+  = ...
+  | AgentRatchetKey
+      { agentVersion :: Version,
+        e2eEncryption :: E2ERatchetParams 'C.X448,
+        info :: ByteString -- for extension
+      }
+```
+
+On receiving `AgentRatchetKey`, if the receiving client hasn't started the ratchet re-synchronization itself (check `ratchet_resync_state`), it should:
+
+- Generate new keys and compute new shared secret, initializing ratchet based on keys comparison.
+- Update database connection state.
+  - Set `ratchet_resync_state` to `RRAgreedSnd/Rcv` (depending on whether ratchet was initialized as sending or receiving).
+  - Delete old ratchet from `ratchets`, create new ratchet.
+- Reply with its own `AgentRatchetKey`.
+- Notify client with `RRESYNC RRAgreedSnd/Rcv`.
+- If ratchet was initialized as sending, send `EREADY` message, notifying other agent ratchet is re-synced.
+
+New agent message:
+
+```haskell
+data AMessage
+  = ...
+  | -- ratchet re-synchronization is complete, with last decrypted sender message id
+    EREADY PrevExternalSndId
+```
+
+On receiving `AgentRatchetKey`, if the receiving client started re-sync:
+
+- Compute new shared secret, initializing ratchet based on keys comparison.
+- Update database connection state.
+  - Set `ratchet_resync_state` to `RRAgreedSnd/Rcv` (depending on whether ratchet was initialized as sending or receiving).
+  - Update ratchet.
+- Notify client with `RRESYNC RRAgreedSnd/Rcv`.
+- If ratchet was initialized as sending, send `EREADY` message.
+
+After agent receives `EREADY` (or any other message that successfully decrypts):
+
+- Reset `ratchet_resync_state` to NULL.
+- Notify client with `RRESYNC RRComplete`.
+- If ratchet was initialized as receiving, send reply `EREADY` message.
+
+### State transitions
+
+For initiating party:
+
+```
+    +------------+
+    | Ratchet ok |
+    +------------+
+          |
+          | message received, decryption error
+   * ---->|-----------------------------------+
+          |                                   |
+          V          new (clarifying)         V
+  +-----------------+     error      +------------------+
+  | Re-sync allowed |--------------->| Re-sync required |
+  +-----------------+                +------------------+
+          |                                   |
+          |-----------------------------------|
+          |                                   | alternative - message received,
+          | re-sync started by client         | successfully decrypted
+          V                                   V
+  +-----------------+                   +------------+
+  | Re-sync started |                   | Ratchet ok |
+  +-----------------+                   +------------+
+          |
+          | other party replied with new ratchet key
+          V
+  +----------------+
+  | Re-sync agreed |----> * message received, decryption error
+  |   snd / rcv    |        (should remember agreed state for reply EREADY?)
+  +----------------+
+          |
+          | message received, successfully decrypted
+          | (can be, but not necessarily, EREADY)
+          V
+    +------------+
+    | Ratchet ok |
+    +------------+
+```
+
+For replying party:
+
+```
+    +------------+
+    | Ratchet ok |
+    +------------+
+          |
+          | other party sent new ratchet key
+          V
+  +----------------+
+  | Re-sync agreed |
+  |   snd / rcv    |
+  +----------------+
+          |
+          | message received, successfully decrypted
+          | (can be, but not necessarily, EREADY)
+          V
+    +------------+
+    | Ratchet ok |
+    +------------+
+```
+
+### Ratchet state model
+
+#### 2 state variables
+
+Above we considered model with separate de-sync and re-sync state.
+
+| Desync \ Resync      | Nothing | RRStarted | RRAgreedSnd | RRAgreedRcv |
+| ---                  |  :---:  |   :---:   |    :---:    |    :---:    |
+| **Nothing**          | 1       | 3         | 4           | 4           |
+| **RDResyncAllowed**  | 2       |           | 5           | 5           |
+| **RDResyncRequired** | 2       |           | 5           | 5           |
+
+1: Ratchet is ok.
+
+2: Re-sync diagnosed, not in progress.
+
+3: Rs-sync started, diagnosing de-sync is prohibited.
+
+4: Re-sync agreed.
+
+5: Re-sync agreed, new de-sync is diagnosed.
+
+Combination 5 is possible in case de-sync was diagnosed before message that could be decrypted is received, for example if `EREADY` failed to deliver and no other decryptable message followed. We shouldn't prohibit diagnosing de-sync in this case, because agent may never exit "Agreed" state (if new decryptable message is never received). We also shouldn't overwrite/forget state of re-sync, even if we diagnose new possible de-sync, because if the decryptable `EREADY` is received and ratchet is in `RRAgreedRcv` state, it should respond with reply `EREADY`.
+
+Some combinations should be impossible:
+
+  - `RDResyncAllowed` with `RRStarted`.
+
+  - `RDResyncRequired` with `RRStarted`.
+
+`RDHealed` is equivalent to `Nothing` and only used for `RDESYNC` event, `Maybe RatchetDesyncState` can be replaced with `RatchetDesyncState`, with single new constructor `RDNoDesync` replacing `Nothing` and `RDHealed`.
+
+`RRComplete` is equivalent to `Nothing` and only used for `RRESYNC` event, `Maybe RatchetResyncState` can be replaced with `RatchetResyncState`, with single new constructor `RDNoResync` replacing `Nothing` and `RRComplete`.
+
+#### Single state variable
+
+Another option is two have a single state variable describing ratchet.
+
+```haskell
+data RatchetState
+  = RSOk
+  | RSResyncAllowed
+  | RSResyncRequired
+  | RSResyncStarted
+  | RRResyncAgreedSnd
+  | RRResyncAgreedRcv
+
+-- When `resyncConnectionRatchet` is not prohibited. Can override with `force`.
+-- Currently we check:`(isJust ratchetDesyncState || force) && ratchetResyncState /= Just RRStarted`.
+resyncConnectionRatchetAllowed :: RatchetState -> Bool
+resyncConnectionRatchetAllowed = \case
+  RSOk -> False
+  RSResyncAllowed -> True
+  RSResyncRequired -> True
+  RSResyncStarted -> False -- `force` shouldn't override
+  RRResyncAgreedSnd -> False
+  RRResyncAgreedRcv -> False
+
+-- When we register and notify about ratchet de-synchronization.
+-- Currently we check: `(isNothing ratchetDesyncState && ratchetResyncState /= Just RRStarted)`.
+-- We should also allow to update from Allowed to Required.
+shouldNotifyRDESYNC :: RatchetState -> Bool
+shouldNotifyRDESYNC = \case
+  RSOk -> True
+  RSResyncAllowed -> False -- only if new error implies Required
+  RSResyncRequired -> False
+  RSResyncStarted -> False
+  RRResyncAgreedSnd -> True
+  RRResyncAgreedRcv -> True
+
+-- When we prohibit connection switch, for `checkRatchetDesync`.
+-- Currently we check: `(ratchetDesyncState == Just RDResyncRequired || ratchetResyncState == Just RRStarted)`
+-- Also use in `runSmpQueueMsgDelivery` to pause delivery?
+ratchetDesynced :: RatchetState -> Bool
+ratchetDesynced = \case
+  RSOk -> False
+  RSResyncAllowed -> False
+  RSResyncRequired -> True
+  RSResyncStarted -> True
+  RRResyncAgreedSnd -> False
+  RRResyncAgreedRcv -> False
+```
+
+Having a single state variable limits differentiation described for combination 5 in matrix. It also limits possible differentiations in client between events when ratchet is healed on its own, and when ratchet re-sync is completed after agents negotiation. Overall, since matrix is not very sparse and allows for more fine-grained decision-making, having separate state variables for de-sync and re-sync seems preferred.
+
+#### Single state variable simplified (final version)
+
+```haskell
+data RatchetSyncState
+  = RSOk
+  | RSAllowed
+  | RSRequired
+  | RSStarted
+  | RSAgreed
+
+-- event
+RSYNC :: RatchetSyncState -> ConnectionStats -> ACommand Agent AEConn`
+
+-- ConnectionStats field
+ratchetSyncState :: RatchetSyncState
+```
+
+Updated design decisions:
+
+1. Single constructor for "Agreed" state. Differentiating `RRResyncAgreedSnd` and `RRResyncAgreedRcv` allowed for easier processing of `EREADY` by helping to determine whether reply `EREADY` has to be sent. However, it duplicated information already present in ratchet's state, and can be instead worked around by remembering and analyzing ratchet state pre decryption.
+
+2. Prohibit transition from "Agreed" state to "Desync" states. This would make possible edge-cases that leave ratchet in de-synchronized state without ability to progress (e.g. failed delivery of `AgentRatchetKey`), but would simplify state machine by removing dedicated "Desync" variable. Besides, there's still a recovery way with a `force` option.
+
+3. Treat "Agreed" as unfinished state - prohibit new messages to be enqueued, etc. Reception of any decryptable message transitions ratchet to "Ok" state.
+
+Possible improvements:
+
+- Repeatedly triggering re-synchronization while in "Started"/"Agreed" state re-sends same keys and EREADY.
+- Cooldown period, during which repeat re-synchronization is prohibited.
+
+### Skipped messages
+
+Options:
+
+1. Ignore skipped messages.
+2. Stop sending new messages while connection re-synchronizes (can use `ratchet_resync_state`).
+
+- Initiator shouldn't send new messages until receives `AgentRatchetKey` from second party.
+- Second party knows new shared secret immediately after processing first `AgentRatchetKey`, so it's not necessary to limit?
+
+3. 2 + Re-send skipped messages first.
+
+- Add `last_external_snd_msg_id` to `AgentRatchetKey`? + see link above
+
+4. Re-send only messages after the latest ratchet step. \*
+
+It may be okay to ignore skipped messages, or at most implement option 2, as ratchet de-synchronization is usually caused by misuse (human error) - the most common cause of ratchet de-sync seems to be sending and receiving messages after running agent with old database backup. In this case user has already seen most skipped messages, and it can be expected to not have them after switching to an old backup. So in this case the only "really skipped" messages are those that were sent during the latest ratchet step and failed to decrypt, triggering ratchet re-sync (\* another option is to only re-send those).
+
+Besides, depending on time of backup there may be an arbitrary large number of skipped messages, which may consume a lot of traffic and may halt delivery of up-to-date messages for some time.
+
+It may be better to have request for repeat delivery as a separate feature, that can be requested in necessary contexts - for example for group stability.
+
+Can servers delivery failure lead to de-sync? If message is lost on server and never delivered, ratchet wouldn't advance, so there's no room for de-sync? If yes, re-evaluate.
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack

 name:           simplexmq
-version:        5.1.2
+version:        5.2.1
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                <./docs/Simplex-Messaging-Client.html client> and
@@ -63,6 +63,7 @@ library
      Simplex.Messaging.Agent.Server
      Simplex.Messaging.Agent.Store
      Simplex.Messaging.Agent.Store.SQLite
+      Simplex.Messaging.Agent.Store.SQLite.Common
      Simplex.Messaging.Agent.Store.SQLite.Migrations
      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
@@ -83,6 +84,7 @@ library
      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
      Simplex.Messaging.Agent.TAsyncs
      Simplex.Messaging.Agent.TRcvQueues
      Simplex.Messaging.Client
@@ -532,6 +534,7 @@ test-suite simplexmq-test
      CoreTests.EncodingTests
      CoreTests.ProtocolErrorTests
      CoreTests.RetryIntervalTests
+      CoreTests.UtilTests
      CoreTests.VersionRangeTests
      FileDescriptionTests
      NtfClient
@@ -71,7 +71,6 @@ import System.FilePath (takeFileName, (</>))
 import UnliftIO
 import UnliftIO.Concurrent
 import UnliftIO.Directory
-import qualified UnliftIO.Exception as E

 startWorkers :: AgentMonad m => AgentClient -> Maybe FilePath -> m ()
 startWorkers c workDir = do
@@ -162,7 +161,7 @@ addWorker c wsSel runWorker runWorkerNoSrv srv_ = do
      let runWorker' = case srv_ of
            Just srv -> runWorker c srv doWork
            Nothing -> runWorkerNoSrv c doWork
-      worker <- async $ runWorker' `E.finally` atomically (TM.delete srv_ ws)
+      worker <- async $ runWorker' `agentFinally` atomically (TM.delete srv_ ws)
      atomically $ TM.insert srv_ (doWork, worker) ws
    Just (doWork, _) ->
      void . atomically $ tryPutTMVar doWork ()
@@ -187,10 +186,10 @@ runXFTPRcvWorker c srv doWork = do
          let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
          withRetryInterval ri' $ \delay' loop ->
            downloadFileChunk fc replica
-              `catchError` \e -> retryOnError "XFTP rcv worker" (retryLoop loop e delay') (retryDone e) e
+              `catchAgentError` \e -> retryOnError "XFTP rcv worker" (retryLoop loop e delay') (retryDone e) e
          where
            retryLoop loop e replicaDelay = do
-              flip catchError (\_ -> pure ()) $ do
+              flip catchAgentError (\_ -> pure ()) $ do
                notifyOnRetry <- asks (xftpNotifyErrsOnRetry . config)
                when notifyOnRetry $ notify c rcvFileEntityId $ RFERR e
                closeXFTPServerClient c userId server digest
@@ -249,7 +248,7 @@ runXFTPRcvLocalWorker c doWork = do
      case nextFile of
        Nothing -> noWorkToDo
        Just f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath} ->
-          decryptFile f `catchError` (rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath . show)
+          decryptFile f `catchAgentError` (rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath . show)
    noWorkToDo = void . atomically $ tryTakeTMVar doWork
    decryptFile :: RcvFile -> m ()
    decryptFile RcvFile {rcvFileId, rcvFileEntityId, key, nonce, tmpPath, savePath, status, chunks} = do
@@ -300,7 +299,7 @@ sendFileExperimental c@AgentClient {xftpServers} userId filePath numRecipients =
      createDirectory outputDir
      let tempPath = workPath </> "snd"
      createDirectoryIfMissing False tempPath
-      runSend fileName outputDir tempPath `catchError` \e -> do
+      runSend fileName outputDir tempPath `catchAgentError` \e -> do
        cleanup outputDir tempPath
        notify c sndFileId $ SFERR e
      where
@@ -370,7 +369,7 @@ runXFTPSndPrepareWorker c doWork = do
      case nextFile of
        Nothing -> noWorkToDo
        Just f@SndFile {sndFileId, sndFileEntityId, prefixPath} ->
-          prepareFile f `catchError` (sndWorkerInternalError c sndFileId sndFileEntityId prefixPath . show)
+          prepareFile f `catchAgentError` (sndWorkerInternalError c sndFileId sndFileEntityId prefixPath . show)
    noWorkToDo = void . atomically $ tryTakeTMVar doWork
    prepareFile :: SndFile -> m ()
    prepareFile SndFile {prefixPath = Nothing} =
@@ -424,7 +423,7 @@ runXFTPSndPrepareWorker c doWork = do
              usedSrvs <- newTVarIO ([] :: [XFTPServer])
              withRetryInterval (riFast ri) $ \_ loop ->
                createWithNextSrv usedSrvs
-                  `catchError` \e -> retryOnError "XFTP prepare worker" (retryLoop loop) (throwError e) e
+                  `catchAgentError` \e -> retryOnError "XFTP prepare worker" (retryLoop loop) (throwError e) e
              where
                retryLoop loop = atomically (assertAgentForeground c) >> loop
            createWithNextSrv usedSrvs = do
@@ -460,10 +459,10 @@ runXFTPSndWorker c srv doWork = do
          let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
          withRetryInterval ri' $ \delay' loop ->
            uploadFileChunk fc replica
-              `catchError` \e -> retryOnError "XFTP snd worker" (retryLoop loop e delay') (retryDone e) e
+              `catchAgentError` \e -> retryOnError "XFTP snd worker" (retryLoop loop e delay') (retryDone e) e
          where
            retryLoop loop e replicaDelay = do
-              flip catchError (\_ -> pure ()) $ do
+              flip catchAgentError (\_ -> pure ()) $ do
                notifyOnRetry <- asks (xftpNotifyErrsOnRetry . config)
                when notifyOnRetry $ notify c sndFileEntityId $ SFERR e
                closeXFTPServerClient c userId server digest
@@ -579,8 +578,8 @@ deleteSndFileInternal c sndFileEntityId = do

 deleteSndFileRemote :: forall m. AgentMonad m => AgentClient -> UserId -> SndFileId -> ValidFileDescription 'FSender -> m ()
 deleteSndFileRemote c userId sndFileEntityId (ValidFileDescription FileDescription {chunks}) = do
-  deleteSndFileInternal c sndFileEntityId `catchError` (notify c sndFileEntityId . SFERR)
-  forM_ chunks $ \ch -> deleteFileChunk ch `catchError` (notify c sndFileEntityId . SFERR)
+  deleteSndFileInternal c sndFileEntityId `catchAgentError` (notify c sndFileEntityId . SFERR)
+  forM_ chunks $ \ch -> deleteFileChunk ch `catchAgentError` (notify c sndFileEntityId . SFERR)
  where
    deleteFileChunk :: FileChunk -> m ()
    deleteFileChunk FileChunk {digest, replicas = replica@FileChunkReplica {server} : _} = do
@@ -594,7 +593,7 @@ addXFTPDelWorker c srv = do
  atomically (TM.lookup srv ws) >>= \case
    Nothing -> do
      doWork <- newTMVarIO ()
-      worker <- async $ runXFTPDelWorker c srv doWork `E.finally` atomically (TM.delete srv ws)
+      worker <- async $ runXFTPDelWorker c srv doWork `agentFinally` atomically (TM.delete srv ws)
      atomically $ TM.insert srv (doWork, worker) ws
    Just (doWork, _) ->
      void . atomically $ tryPutTMVar doWork ()
@@ -619,10 +618,10 @@ runXFTPDelWorker c srv doWork = do
          let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
          withRetryInterval ri' $ \delay' loop ->
            deleteChunkReplica replica
-              `catchError` \e -> retryOnError "XFTP del worker" (retryLoop loop e delay') (retryDone e) e
+              `catchAgentError` \e -> retryOnError "XFTP del worker" (retryLoop loop e delay') (retryDone e) e
          where
            retryLoop loop e replicaDelay = do
-              flip catchError (\_ -> pure ()) $ do
+              flip catchAgentError (\_ -> pure ()) $ do
                notifyOnRetry <- asks (xftpNotifyErrsOnRetry . config)
                when notifyOnRetry $ notify c "" $ SFERR e
                closeXFTPServerClient c userId server chunkDigest
@@ -38,9 +38,8 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (toLower)
-import Data.Function (on)
 import Data.Int (Int64)
-import Data.List (foldl', groupBy, sortOn)
+import Data.List (foldl', sortOn)
 import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map (Map)
@@ -66,7 +65,7 @@ import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), SenderId, SndPrivateSignKey, XFTPServer, XFTPServerWithAuth)
 import Simplex.Messaging.Server.CLI (getCliCommand')
-import Simplex.Messaging.Util (ifM, tshow, whenM)
+import Simplex.Messaging.Util (groupAllOn, ifM, tshow, whenM)
 import System.Exit (exitFailure)
 import System.FilePath (splitFileName, (</>))
 import System.IO.Temp (getCanonicalTemporaryDirectory)
@@ -75,7 +74,7 @@ import UnliftIO
 import UnliftIO.Directory

 xftpClientVersion :: String
-xftpClientVersion = "0.1.0"
+xftpClientVersion = "1.0.1"

 chunkSize1 :: Word32
 chunkSize1 = kb 256
@@ -316,7 +315,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
      let xftpSrvs = fromMaybe defaultXFTPServers (nonEmpty xftpServers)
      srvs <- liftIO $ replicateM (length chunks) $ getXFTPServer gen xftpSrvs
      let thd3 (_, _, x) = x
-          chunks' = groupBy ((==) `on` thd3) $ sortOn thd3 $ zip3 [1 ..] chunks srvs
+          chunks' = groupAllOn thd3 $ zip3 [1 ..] chunks srvs
      -- TODO shuffle/unshuffle chunks
      -- the reason we don't do pooled downloads here within one server is that http2 library doesn't handle cleint concurrency, even though
      -- upload doesn't allow other requests within the same client until complete (but download does allow).
@@ -428,7 +427,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
      liftIO $ printNoNewLine "Downloading file..."
      downloadedChunks <- newTVarIO []
      let srv FileChunk {replicas} = server (head replicas :: FileChunkReplica)
-          srvChunks = groupBy ((==) `on` srv) $ sortOn srv chunks
+          srvChunks = groupAllOn srv chunks
      chunkPaths <- map snd . sortOn fst . concat <$> pooledForConcurrentlyN 16 srvChunks (mapM $ downloadFileChunk a encPath size downloadedChunks)
      encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
      when (encDigest /= unFileDigest digest) $ throwError $ CLIError "File digest mismatch"
@@ -42,9 +42,8 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Function (on)
 import Data.Int (Int64)
-import Data.List (foldl', groupBy, sortOn)
+import Data.List (foldl', sortOn)
 import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
@@ -59,7 +58,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (XFTPServer)
-import Simplex.Messaging.Util (bshow, (<$?>))
+import Simplex.Messaging.Util (bshow, groupAllOn, (<$?>))

 data FileDescription (p :: FileParty) = FileDescription
  { party :: SFileParty p,
@@ -258,9 +257,7 @@ instance (ToField a) => ToField (FileSize a) where toField (FileSize s) = toFiel

 groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [[FileServerReplica]]
 groupReplicasByServer defChunkSize =
-  groupBy ((==) `on` replicaServer)
-    . sortOn replicaServer
-    . unfoldChunksToReplicas defChunkSize
+  groupAllOn replicaServer . unfoldChunksToReplicas defChunkSize

 encodeFileReplicas :: FileSize Word32 -> [FileChunk] -> [YAMLServerReplicas]
 encodeFileReplicas defChunkSize =
@@ -268,7 +265,7 @@ encodeFileReplicas defChunkSize =
  where
    encodeServerReplicas fs =
      YAMLServerReplicas
-        { server = replicaServer $ head fs, -- groupBy guarantees that fs is not empty
+        { server = replicaServer $ head fs, -- groupAllOn guarantees that fs is not empty
          chunks = map (B.unpack . encodeServerReplica) fs
        }

@@ -70,7 +70,7 @@ runXFTPServerBlocking :: TMVar Bool -> XFTPServerConfig -> IO ()
 runXFTPServerBlocking started cfg = newXFTPServerEnv cfg >>= runReaderT (xftpServer cfg started)

 xftpServer :: XFTPServerConfig -> TMVar Bool -> M ()
-xftpServer cfg@XFTPServerConfig {xftpPort, logTLSErrors} started = do
+xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig} started = do
  restoreServerStats
  raceAny_ (runServer : expireFilesThread_ cfg <> serverStatsThread_ cfg) `finally` stopServer
  where
@@ -79,7 +79,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, logTLSErrors} started = do
      serverParams <- asks tlsServerParams
      env <- ask
      liftIO $
-        runHTTP2Server started xftpPort defaultHTTP2BufferSize serverParams logTLSErrors $ \sessionId r sendResponse -> do
+        runHTTP2Server started xftpPort defaultHTTP2BufferSize serverParams transportConfig $ \sessionId r sendResponse -> do
          reqBody <- getHTTP2Body r xftpBlockSize
          processRequest HTTP2Request {sessionId, request = r, reqBody, sendResponse} `runReaderT` env

@@ -26,7 +26,7 @@ import Simplex.FileTransfer.Server.StoreLog
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (BasicAuth, RcvPublicVerifyKey)
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams)
+import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams, TransportServerConfig)
 import Simplex.Messaging.Util (tshow)
 import System.IO (IOMode (..))
 import UnliftIO.STM
@@ -55,7 +55,7 @@ data XFTPServerConfig = XFTPServerConfig
    logStatsStartTime :: Int64,
    serverStatsLogFile :: FilePath,
    serverStatsBackupFile :: Maybe FilePath,
-    logTLSErrors :: Bool
+    transportConfig :: TransportServerConfig
  }

 data XFTPEnv = XFTPEnv
@@ -25,13 +25,14 @@ import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)

 xftpServerVersion :: String
-xftpServerVersion = "1.0.0"
+xftpServerVersion = "1.0.1"

 xftpServerCLI :: FilePath -> FilePath -> IO ()
 xftpServerCLI cfgPath logPath = do
@@ -151,7 +152,10 @@ xftpServerCLI cfgPath logPath = do
              logStatsStartTime = 0, -- seconds from 00:00 UTC
              serverStatsLogFile = combine logPath "file-server-stats.daily.log",
              serverStatsBackupFile = logStats $> combine logPath "file-server-stats.log",
-              logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
+              transportConfig =
+                defaultTransportServerConfig
+                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
+                  }
            }

 data CliCommand
@@ -41,7 +41,9 @@ module Simplex.Messaging.Agent.Client
    temporaryOrHostError,
    secureQueue,
    enableQueueNotifications,
+    enableQueuesNtfs,
    disableQueueNotifications,
+    disableQueuesNtfs,
    sendAgentMessage,
    agentNtfRegisterToken,
    agentNtfVerifyToken,
@@ -161,9 +163,6 @@ import Simplex.Messaging.Protocol
    ErrorType,
    MsgFlags (..),
    MsgId,
-    NotifierId,
-    NtfPrivateSignKey,
-    NtfPublicVerifyKey,
    NtfServer,
    ProtoServer,
    ProtoServerWithAuth (..),
@@ -400,7 +399,7 @@ instance ProtocolServerClient XFTPErrorType FileResponse where

 getSMPServerClient :: forall m. AgentMonad m => AgentClient -> SMPTransportSession -> m SMPClient
 getSMPServerClient c@AgentClient {active, smpClients, msgQ} tSess@(userId, srv, _) = do
-  unlessM (readTVarIO active) . throwError $ INTERNAL "agent is stopped"
+  unlessM (readTVarIO active) . throwError $ INACTIVE
  atomically (getClientVar tSess smpClients)
    >>= either
      (newProtocolClient c tSess smpClients connectClient reconnectSMPClient)
@@ -444,7 +443,7 @@ reconnectServer c tSess = newAsyncAction tryReconnectSMPClient $ reconnections c
    tryReconnectSMPClient aId = do
      ri <- asks $ reconnectInterval . config
      withRetryInterval ri $ \_ loop ->
-        reconnectSMPClient c tSess `catchError` const loop
+        reconnectSMPClient c tSess `catchAgentError` const loop
      atomically . removeAsyncAction aId $ reconnections c

 reconnectSMPClient :: forall m. AgentMonad m => AgentClient -> SMPTransportSession -> m ()
@@ -468,7 +467,7 @@ reconnectSMPClient c tSess@(_, srv, _) =

 getNtfServerClient :: forall m. AgentMonad m => AgentClient -> NtfTransportSession -> m NtfClient
 getNtfServerClient c@AgentClient {active, ntfClients} tSess@(userId, srv, _) = do
-  unlessM (readTVarIO active) . throwError $ INTERNAL "agent is stopped"
+  unlessM (readTVarIO active) . throwError $ INACTIVE
  atomically (getClientVar tSess ntfClients)
    >>= either
      (newProtocolClient c tSess ntfClients connectClient $ \_ _ -> pure ())
@@ -488,7 +487,7 @@ getNtfServerClient c@AgentClient {active, ntfClients} tSess@(userId, srv, _) = d

 getXFTPServerClient :: forall m. AgentMonad m => AgentClient -> XFTPTransportSession -> m XFTPClient
 getXFTPServerClient c@AgentClient {active, xftpClients, useNetworkConfig} tSess@(userId, srv, _) = do
-  unlessM (readTVarIO active) . throwError $ INTERNAL "agent is stopped"
+  unlessM (readTVarIO active) . throwError $ INACTIVE
  atomically (getClientVar tSess xftpClients)
    >>= either
      (newProtocolClient c tSess xftpClients connectClient $ \_ _ -> pure ())
@@ -641,7 +640,7 @@ withLockMap_ locks key = withGetLock $ TM.lookup key locks >>= maybe newLock pur
 withClient_ :: forall a m err msg. (AgentMonad m, ProtocolServerClient err msg) => AgentClient -> TransportSession msg -> ByteString -> (Client msg -> m a) -> m a
 withClient_ c tSess@(userId, srv, _) statCmd action = do
  cl <- getProtocolServerClient c tSess
-  (action cl <* stat cl "OK") `catchError` logServerError cl
+  (action cl <* stat cl "OK") `catchAgentError` logServerError cl
  where
    stat cl = liftIO . incClientStat c userId cl statCmd
    logServerError :: Client msg -> AgentErrorType -> m a
@@ -861,6 +860,7 @@ temporaryAgentError :: AgentErrorType -> Bool
 temporaryAgentError = \case
  BROKER _ NETWORK -> True
  BROKER _ TIMEOUT -> True
+  INACTIVE -> True
  _ -> False

 temporaryOrHostError :: AgentErrorType -> Bool
@@ -876,11 +876,13 @@ subscribeQueues c qs = do
    modifyTVar (subscrConns c) $ S.insert connId
    RQ.addQueue rq $ pendingSubs c
  u <- askUnliftIO
-  (errs <>) <$> sendTSessionBatches "SUB" 90 (subscribeQueues_ u) c qs
+  -- only "checked" queues are subscribed
+  (errs <>) <$> sendTSessionBatches "SUB" 90 id (subscribeQueues_ u) c qs'
  where
    checkQueue rq@RcvQueue {rcvId, server} = do
      prohibited <- atomically . TM.member (server, rcvId) $ getMsgLocks c
      pure $ if prohibited then Left (rq, Left $ CMD PROHIBITED) else Right rq
+    subscribeQueues_ :: UnliftIO m -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
    subscribeQueues_ u smp qs' = do
      rs <- sendBatch subscribeSMPQueues smp qs'
      mapM_ (uncurry $ processSubResult c) rs
@@ -888,25 +890,25 @@ subscribeQueues c qs = do
        unliftIO u $ reconnectServer c $ transportSession' smp
      pure rs

-type BatchResponses e = (NonEmpty (RcvQueue, Either e ()))
+type BatchResponses e r = (NonEmpty (RcvQueue, Either e r))

 -- statBatchSize is not used to batch the commands, only for traffic statistics
-sendTSessionBatches :: forall m. AgentMonad m => ByteString -> Int -> (SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError)) -> AgentClient -> [RcvQueue] -> m [(RcvQueue, Either AgentErrorType ())]
-sendTSessionBatches statCmd statBatchSize action c qs =
+sendTSessionBatches :: forall m q r. AgentMonad m => ByteString -> Int -> (q -> RcvQueue) -> (SMPClient -> NonEmpty q -> IO (BatchResponses SMPClientError r)) -> AgentClient -> [q] -> m [(RcvQueue, Either AgentErrorType r)]
+sendTSessionBatches statCmd statBatchSize toRQ action c qs =
  concatMap L.toList <$> (mapConcurrently sendClientBatch =<< batchQueues)
  where
-    batchQueues :: m [(SMPTransportSession, NonEmpty RcvQueue)]
+    batchQueues :: m [(SMPTransportSession, NonEmpty q)]
    batchQueues = do
      mode <- sessionMode <$> readTVarIO (useNetworkConfig c)
      pure . M.assocs $ foldl' (batch mode) M.empty qs
      where
-        batch mode m rq =
-          let tSess = mkSMPTSession rq mode
-           in M.alter (Just . maybe [rq] (rq <|)) tSess m
-    sendClientBatch :: (SMPTransportSession, NonEmpty RcvQueue) -> m (BatchResponses AgentErrorType)
+        batch mode m q =
+          let tSess = mkSMPTSession (toRQ q) mode
+           in M.alter (Just . maybe [q] (q <|)) tSess m
+    sendClientBatch :: (SMPTransportSession, NonEmpty q) -> m (BatchResponses AgentErrorType r)
    sendClientBatch (tSess@(userId, srv, _), qs') =
      tryError (getSMPServerClient c tSess) >>= \case
-        Left e -> pure $ L.map (,Left e) qs'
+        Left e -> pure $ L.map ((,Left e) . toRQ) qs'
        Right smp -> liftIO $ do
          logServer "-->" c srv (bshow (length qs') <> " queues") statCmd
          rs <- L.map agentError <$> action smp qs'
@@ -916,9 +918,9 @@ sendTSessionBatches statCmd statBatchSize action c qs =
            agentError = second . first $ protocolClientError SMP $ clientServer smp
            statBatch =
              let n = (length qs - 1) `div` statBatchSize + 1
-               in incClientStatN c userId smp n (statCmd <> "S") "OK"
+               in incClientStatN c userId smp n statCmd "OK"

-sendBatch :: (SMPClient -> NonEmpty (SMP.RcvPrivateSignKey, SMP.RecipientId) -> IO (NonEmpty (Either SMPClientError ()))) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError)
+sendBatch :: (SMPClient -> NonEmpty (SMP.RcvPrivateSignKey, SMP.RecipientId) -> IO (NonEmpty (Either SMPClientError ()))) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
 sendBatch smpCmdFunc smp qs = L.zip qs <$> smpCmdFunc smp (L.map queueCreds qs)
  where
    queueCreds RcvQueue {rcvPrivateKey, rcvId} = (rcvPrivateKey, rcvId)
@@ -1001,16 +1003,28 @@ secureQueue c rq@RcvQueue {rcvId, rcvPrivateKey} senderKey =
  withSMPClient c rq "KEY <key>" $ \smp ->
    secureSMPQueue smp rcvPrivateKey rcvId senderKey

-enableQueueNotifications :: AgentMonad m => AgentClient -> RcvQueue -> NtfPublicVerifyKey -> RcvNtfPublicDhKey -> m (NotifierId, RcvNtfPublicDhKey)
+enableQueueNotifications :: AgentMonad m => AgentClient -> RcvQueue -> SMP.NtfPublicVerifyKey -> SMP.RcvNtfPublicDhKey -> m (SMP.NotifierId, SMP.RcvNtfPublicDhKey)
 enableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} notifierKey rcvNtfPublicDhKey =
  withSMPClient c rq "NKEY <nkey>" $ \smp ->
    enableSMPQueueNotifications smp rcvPrivateKey rcvId notifierKey rcvNtfPublicDhKey

+enableQueuesNtfs :: forall m. AgentMonad m => AgentClient -> [(RcvQueue, SMP.NtfPublicVerifyKey, SMP.RcvNtfPublicDhKey)] -> m [(RcvQueue, Either AgentErrorType (SMP.NotifierId, SMP.RcvNtfPublicDhKey))]
+enableQueuesNtfs = sendTSessionBatches "NKEY" 90 fst3 enableQueues_
+  where
+    fst3 (x, _, _) = x
+    enableQueues_ :: SMPClient -> NonEmpty (RcvQueue, SMP.NtfPublicVerifyKey, SMP.RcvNtfPublicDhKey) -> IO (NonEmpty (RcvQueue, Either (ProtocolClientError ErrorType) (SMP.NotifierId, RcvNtfPublicDhKey)))
+    enableQueues_ smp qs' = L.zipWith ((,) . fst3) qs' <$> enableSMPQueuesNtfs smp (L.map queueCreds qs')
+    queueCreds :: (RcvQueue, SMP.NtfPublicVerifyKey, SMP.RcvNtfPublicDhKey) -> (SMP.RcvPrivateSignKey, SMP.RecipientId, SMP.NtfPublicVerifyKey, SMP.RcvNtfPublicDhKey)
+    queueCreds (RcvQueue {rcvPrivateKey, rcvId}, notifierKey, rcvNtfPublicDhKey) = (rcvPrivateKey, rcvId, notifierKey, rcvNtfPublicDhKey)
+
 disableQueueNotifications :: AgentMonad m => AgentClient -> RcvQueue -> m ()
 disableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} =
  withSMPClient c rq "NDEL" $ \smp ->
    disableSMPQueueNotifications smp rcvPrivateKey rcvId

+disableQueuesNtfs :: forall m. AgentMonad m => AgentClient -> [RcvQueue] -> m [(RcvQueue, Either AgentErrorType ())]
+disableQueuesNtfs = sendTSessionBatches "NDEL" 90 id $ sendBatch disableSMPQueuesNtfs
+
 sendAck :: AgentMonad m => AgentClient -> RcvQueue -> MsgId -> m ()
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = do
  withSMPClient c rq "ACK" $ \smp ->
@@ -1032,7 +1046,7 @@ deleteQueue c rq@RcvQueue {rcvId, rcvPrivateKey} = do
    deleteSMPQueue smp rcvPrivateKey rcvId

 deleteQueues :: forall m. AgentMonad m => AgentClient -> [RcvQueue] -> m [(RcvQueue, Either AgentErrorType ())]
-deleteQueues = sendTSessionBatches "DEL" 90 $ sendBatch deleteSMPQueues
+deleteQueues = sendTSessionBatches "DEL" 90 id $ sendBatch deleteSMPQueues

 sendAgentMessage :: AgentMonad m => AgentClient -> SndQueue -> MsgFlags -> ByteString -> m ()
 sendAgentMessage c sq@SndQueue {sndId, sndPrivateKey} msgFlags agentMsg =
@@ -1065,7 +1079,7 @@ agentNtfEnableCron :: AgentMonad m => AgentClient -> NtfTokenId -> NtfToken -> W
 agentNtfEnableCron c tknId NtfToken {ntfServer, ntfPrivKey} interval =
  withNtfClient c ntfServer tknId "TCRN" $ \ntf -> ntfEnableCron ntf ntfPrivKey tknId interval

-agentNtfCreateSubscription :: AgentMonad m => AgentClient -> NtfTokenId -> NtfToken -> SMPQueueNtf -> NtfPrivateSignKey -> m NtfSubscriptionId
+agentNtfCreateSubscription :: AgentMonad m => AgentClient -> NtfTokenId -> NtfToken -> SMPQueueNtf -> SMP.NtfPrivateSignKey -> m NtfSubscriptionId
 agentNtfCreateSubscription c tknId NtfToken {ntfServer, ntfPrivKey} smpQueue nKey =
  withNtfClient c ntfServer tknId "SNEW" $ \ntf -> ntfCreateSubscription ntf ntfPrivKey (NewNtfSub tknId smpQueue nKey)

@@ -6,6 +6,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}

@@ -17,6 +18,9 @@ module Simplex.Messaging.Agent.Env.SQLite
    NetworkConfig (..),
    defaultAgentConfig,
    defaultReconnectInterval,
+    tryAgentError,
+    catchAgentError,
+    agentFinally,
    Env (..),
    newSMPAgentEnv,
    createAgentStore,
@@ -52,9 +56,10 @@ import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (TLS, Transport (..))
 import Simplex.Messaging.Transport.Client (defaultSMPPort)
+import Simplex.Messaging.Util (allFinally, catchAllErrors, tryAllErrors)
 import Simplex.Messaging.Version
 import System.Random (StdGen, newStdGen)
-import UnliftIO (Async)
+import UnliftIO (Async, SomeException)
 import UnliftIO.STM

 type AgentMonad' m = (MonadUnliftIO m, MonadReader Env m)
@@ -83,6 +88,7 @@ data AgentConfig = AgentConfig
    initialCleanupDelay :: Int64,
    cleanupInterval :: Int64,
    rcvMsgHashesTTL :: NominalDiffTime,
+    processedRatchetKeyHashesTTL :: NominalDiffTime,
    rcvFilesTTL :: NominalDiffTime,
    sndFilesTTL :: NominalDiffTime,
    xftpNotifyErrsOnRetry :: Bool,
@@ -147,6 +153,7 @@ defaultAgentConfig =
      initialCleanupDelay = 30 * 1000000, -- 30 seconds
      cleanupInterval = 30 * 60 * 1000000, -- 30 minutes
      rcvMsgHashesTTL = 30 * nominalDay,
+      processedRatchetKeyHashesTTL = 30 * nominalDay,
      rcvFilesTTL = 2 * nominalDay,
      sndFilesTTL = nominalDay,
      xftpNotifyErrsOnRetry = True,
@@ -223,3 +230,19 @@ newXFTPAgent = do
  xftpSndWorkers <- TM.empty
  xftpDelWorkers <- TM.empty
  pure XFTPAgent {xftpWorkDir, xftpRcvWorkers, xftpSndWorkers, xftpDelWorkers}
+
+tryAgentError :: AgentMonad m => m a -> m (Either AgentErrorType a)
+tryAgentError = tryAllErrors mkInternal
+{-# INLINE tryAgentError #-}
+
+catchAgentError :: AgentMonad m => m a -> (AgentErrorType -> m a) -> m a
+catchAgentError = catchAllErrors mkInternal
+{-# INLINE catchAgentError #-}
+
+agentFinally :: AgentMonad m => m a -> m b -> m a
+agentFinally = allFinally mkInternal
+{-# INLINE agentFinally #-}
+
+mkInternal :: SomeException -> AgentErrorType
+mkInternal = INTERNAL . show
+{-# INLINE mkInternal #-}
@@ -147,7 +147,7 @@ processNtfSub c (connId, cmd) = do
      atomically (TM.lookup srv ws) >>= \case
        Nothing -> do
          doWork <- newTMVarIO ()
-          worker <- async $ runWorker c srv doWork `E.finally` atomically (TM.delete srv ws)
+          worker <- async $ runWorker c srv doWork `agentFinally` atomically (TM.delete srv ws)
          atomically $ TM.insert srv (doWork, worker) ws
        Just (doWork, _) ->
          void . atomically $ tryPutTMVar doWork ()
@@ -173,7 +173,7 @@ runNtfWorker c srv doWork = do
          ri <- asks $ reconnectInterval . config
          withRetryInterval ri $ \_ loop ->
            processAction a
-              `catchError` retryOnError c "NtfWorker" loop (workerInternalError c connId . show)
+              `catchAgentError` retryOnError c "NtfWorker" loop (workerInternalError c connId . show)
    noWorkToDo = void . atomically $ tryTakeTMVar doWork
    processAction :: (NtfSubscription, NtfSubNTFAction, NtfActionTs) -> m ()
    processAction (sub@NtfSubscription {connId, smpServer, ntfSubId}, action, actionTs) = do
@@ -213,7 +213,7 @@ runNtfWorker c srv doWork = do
          NSADelete -> case ntfSubId of
            Just nSubId ->
              (getNtfToken >>= mapM_ (agentNtfDeleteSubscription c nSubId))
-                `E.finally` continueDeletion
+                `agentFinally` continueDeletion
            _ -> continueDeletion
            where
              continueDeletion = do
@@ -224,7 +224,7 @@ runNtfWorker c srv doWork = do
          NSARotate -> case ntfSubId of
            Just nSubId ->
              (getNtfToken >>= mapM_ (agentNtfDeleteSubscription c nSubId))
-                `E.finally` deleteCreate
+                `agentFinally` deleteCreate
            _ -> deleteCreate
            where
              deleteCreate = do
@@ -257,7 +257,7 @@ runNtfSMPWorker c srv doWork = do
          ri <- asks $ reconnectInterval . config
          withRetryInterval ri $ \_ loop ->
            processAction a
-              `catchError` retryOnError c "NtfSMPWorker" loop (workerInternalError c connId . show)
+              `catchAgentError` retryOnError c "NtfSMPWorker" loop (workerInternalError c connId . show)
    noWorkToDo = void . atomically $ tryTakeTMVar doWork
    processAction :: (NtfSubscription, NtfSubSMPAction, NtfActionTs) -> m ()
    processAction (sub@NtfSubscription {connId, ntfServer}, smpAction, actionTs) = do
@@ -62,6 +62,7 @@ module Simplex.Messaging.Agent.Protocol
    RcvSwitchStatus (..),
    SndSwitchStatus (..),
    QueueDirection (..),
+    RatchetSyncState (..),
    SMPConfirmation (..),
    AgentMsgEnvelope (..),
    AgentMessage (..),
@@ -98,6 +99,7 @@ module Simplex.Messaging.Agent.Protocol
    BrokerErrorType (..),
    SMPAgentError (..),
    AgentCryptoError (..),
+    cryptoErrToSyncState,
    ATransmission,
    ATransmissionOrError,
    ARawTransmission,
@@ -159,7 +161,7 @@ import qualified Data.Map as M
 import Data.Maybe (isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.System (SystemTime)
 import Data.Time.ISO8601
@@ -209,7 +211,7 @@ import Text.Read
 import UnliftIO.Exception (Exception)

 currentSMPAgentVersion :: Version
-currentSMPAgentVersion = 2
+currentSMPAgentVersion = 3

 supportedSMPAgentVRange :: VersionRange
 supportedSMPAgentVRange = mkVersionRange 1 currentSMPAgentVersion
@@ -324,6 +326,7 @@ data ACommand (p :: AParty) (e :: AEntity) where
  DOWN :: SMPServer -> [ConnId] -> ACommand Agent AENone
  UP :: SMPServer -> [ConnId] -> ACommand Agent AENone
  SWITCH :: QueueDirection -> SwitchPhase -> ConnectionStats -> ACommand Agent AEConn
+  RSYNC :: RatchetSyncState -> Maybe AgentCryptoError -> ConnectionStats -> ACommand Agent AEConn
  SEND :: MsgFlags -> MsgBody -> ACommand Client AEConn
  MID :: AgentMsgId -> ACommand Agent AEConn
  SENT :: AgentMsgId -> ACommand Agent AEConn
@@ -382,6 +385,7 @@ data ACommandTag (p :: AParty) (e :: AEntity) where
  DOWN_ :: ACommandTag Agent AENone
  UP_ :: ACommandTag Agent AENone
  SWITCH_ :: ACommandTag Agent AEConn
+  RSYNC_ :: ACommandTag Agent AEConn
  SEND_ :: ACommandTag Client AEConn
  MID_ :: ACommandTag Agent AEConn
  SENT_ :: ACommandTag Agent AEConn
@@ -433,6 +437,7 @@ aCommandTag = \case
  DOWN {} -> DOWN_
  UP {} -> UP_
  SWITCH {} -> SWITCH_
+  RSYNC {} -> RSYNC_
  SEND {} -> SEND_
  MID _ -> MID_
  SENT _ -> SENT_
@@ -522,9 +527,9 @@ instance StrEncoding RcvSwitchStatus where
      "received_message" -> pure RSReceivedMessage
      _ -> fail "bad RcvSwitchStatus"

-instance ToField RcvSwitchStatus where toField = toField . strEncode
+instance ToField RcvSwitchStatus where toField = toField . decodeLatin1 . strEncode

-instance FromField RcvSwitchStatus where fromField = blobFieldDecoder $ parseAll strP
+instance FromField RcvSwitchStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8

 instance ToJSON RcvSwitchStatus where
  toEncoding = strToJEncoding
@@ -548,9 +553,9 @@ instance StrEncoding SndSwitchStatus where
      "sending_qtest" -> pure SSSendingQTEST
      _ -> fail "bad SndSwitchStatus"

-instance ToField SndSwitchStatus where toField = toField . strEncode
+instance ToField SndSwitchStatus where toField = toField . decodeLatin1 . strEncode

-instance FromField SndSwitchStatus where fromField = blobFieldDecoder $ parseAll strP
+instance FromField SndSwitchStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8

 instance ToJSON SndSwitchStatus where
  toEncoding = strToJEncoding
@@ -559,6 +564,41 @@ instance ToJSON SndSwitchStatus where
 instance FromJSON SndSwitchStatus where
  parseJSON = strParseJSON "SndSwitchStatus"

+data RatchetSyncState
+  = RSOk
+  | RSAllowed
+  | RSRequired
+  | RSStarted
+  | RSAgreed
+  deriving (Eq, Show)
+
+instance StrEncoding RatchetSyncState where
+  strEncode = \case
+    RSOk -> "ok"
+    RSAllowed -> "allowed"
+    RSRequired -> "required"
+    RSStarted -> "started"
+    RSAgreed -> "agreed"
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "ok" -> pure RSOk
+      "allowed" -> pure RSAllowed
+      "required" -> pure RSRequired
+      "started" -> pure RSStarted
+      "agreed" -> pure RSAgreed
+      _ -> fail "bad RatchetSyncState"
+
+instance FromField RatchetSyncState where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
+instance ToField RatchetSyncState where toField = toField . decodeLatin1 . strEncode
+
+instance ToJSON RatchetSyncState where
+  toEncoding = strToJEncoding
+  toJSON = strToJSON
+
+instance FromJSON RatchetSyncState where
+  parseJSON = strParseJSON "RatchetSyncState"
+
 data RcvQueueInfo = RcvQueueInfo
  { rcvServer :: SMPServer,
    rcvSwitchStatus :: Maybe RcvSwitchStatus,
@@ -596,18 +636,28 @@ instance StrEncoding SndQueueInfo where
    pure SndQueueInfo {sndServer, sndSwitchStatus}

 data ConnectionStats = ConnectionStats
-  { rcvQueuesInfo :: [RcvQueueInfo],
-    sndQueuesInfo :: [SndQueueInfo]
+  { connAgentVersion :: Version,
+    rcvQueuesInfo :: [RcvQueueInfo],
+    sndQueuesInfo :: [SndQueueInfo],
+    ratchetSyncState :: RatchetSyncState,
+    ratchetSyncSupported :: Bool
  }
  deriving (Eq, Show, Generic)

 instance StrEncoding ConnectionStats where
-  strEncode ConnectionStats {rcvQueuesInfo, sndQueuesInfo} =
-    "rcv=" <> strEncodeList rcvQueuesInfo <> " snd=" <> strEncodeList sndQueuesInfo
+  strEncode ConnectionStats {connAgentVersion, rcvQueuesInfo, sndQueuesInfo, ratchetSyncState, ratchetSyncSupported} =
+    "agent_version=" <> strEncode connAgentVersion
+      <> (" rcv=" <> strEncodeList rcvQueuesInfo)
+      <> (" snd=" <> strEncodeList sndQueuesInfo)
+      <> (" sync=" <> strEncode ratchetSyncState)
+      <> (" sync_supported=" <> strEncode ratchetSyncSupported)
  strP = do
-    rcvQueuesInfo <- "rcv=" *> strListP
+    connAgentVersion <- "agent_version=" *> strP
+    rcvQueuesInfo <- " rcv=" *> strListP
    sndQueuesInfo <- " snd=" *> strListP
-    pure ConnectionStats {rcvQueuesInfo, sndQueuesInfo}
+    ratchetSyncState <- " sync=" *> strP
+    ratchetSyncSupported <- " sync_supported=" *> strP
+    pure ConnectionStats {connAgentVersion, rcvQueuesInfo, sndQueuesInfo, ratchetSyncState, ratchetSyncSupported}

 instance ToJSON ConnectionStats where toEncoding = J.genericToEncoding J.defaultOptions

@@ -710,7 +760,7 @@ data SMPConfirmation = SMPConfirmation
 data AgentMsgEnvelope
  = AgentConfirmation
      { agentVersion :: Version,
-        e2eEncryption :: Maybe (E2ERatchetParams 'C.X448),
+        e2eEncryption_ :: Maybe (E2ERatchetParams 'C.X448),
        encConnInfo :: ByteString
      }
  | AgentMsgEnvelope
@@ -722,22 +772,29 @@ data AgentMsgEnvelope
        connReq :: ConnectionRequestUri 'CMInvitation,
        connInfo :: ByteString -- this message is only encrypted with per-queue E2E, not with double ratchet,
      }
+  | AgentRatchetKey
+      { agentVersion :: Version,
+        e2eEncryption :: E2ERatchetParams 'C.X448,
+        info :: ByteString
+      }
  deriving (Show)

 instance Encoding AgentMsgEnvelope where
  smpEncode = \case
-    AgentConfirmation {agentVersion, e2eEncryption, encConnInfo} ->
-      smpEncode (agentVersion, 'C', e2eEncryption, Tail encConnInfo)
+    AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo} ->
+      smpEncode (agentVersion, 'C', e2eEncryption_, Tail encConnInfo)
    AgentMsgEnvelope {agentVersion, encAgentMessage} ->
      smpEncode (agentVersion, 'M', Tail encAgentMessage)
    AgentInvitation {agentVersion, connReq, connInfo} ->
      smpEncode (agentVersion, 'I', Large $ strEncode connReq, Tail connInfo)
+    AgentRatchetKey {agentVersion, e2eEncryption, info} ->
+      smpEncode (agentVersion, 'R', e2eEncryption, Tail info)
  smpP = do
    agentVersion <- smpP
    smpP >>= \case
      'C' -> do
-        (e2eEncryption, Tail encConnInfo) <- smpP
-        pure AgentConfirmation {agentVersion, e2eEncryption, encConnInfo}
+        (e2eEncryption_, Tail encConnInfo) <- smpP
+        pure AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo}
      'M' -> do
        Tail encAgentMessage <- smpP
        pure AgentMsgEnvelope {agentVersion, encAgentMessage}
@@ -745,15 +802,21 @@ instance Encoding AgentMsgEnvelope where
        connReq <- strDecode . unLarge <$?> smpP
        Tail connInfo <- smpP
        pure AgentInvitation {agentVersion, connReq, connInfo}
+      'R' -> do
+        e2eEncryption <- smpP
+        Tail info <- smpP
+        pure AgentRatchetKey {agentVersion, e2eEncryption, info}
      _ -> fail "bad AgentMsgEnvelope"

 -- SMP agent message formats (after double ratchet decryption,
 -- or in case of AgentInvitation - in plain text body)
+-- AgentRatchetInfo is not encrypted with double ratchet, but with per-queue E2E encryption
 data AgentMessage
  = AgentConnInfo ConnInfo
  | -- AgentConnInfoReply is only used in duplexHandshake mode (v2), allowing to include reply queue(s) in the initial confirmation.
    -- It makes REPLY message unnecessary.
    AgentConnInfoReply (L.NonEmpty SMPQueueInfo) ConnInfo
+  | AgentRatchetInfo ByteString
  | AgentMessage APrivHeader AMessage
  deriving (Show)

@@ -761,17 +824,20 @@ instance Encoding AgentMessage where
  smpEncode = \case
    AgentConnInfo cInfo -> smpEncode ('I', Tail cInfo)
    AgentConnInfoReply smpQueues cInfo -> smpEncode ('D', smpQueues, Tail cInfo) -- 'D' stands for "duplex"
+    AgentRatchetInfo info -> smpEncode ('R', Tail info)
    AgentMessage hdr aMsg -> smpEncode ('M', hdr, aMsg)
  smpP =
    smpP >>= \case
      'I' -> AgentConnInfo . unTail <$> smpP
      'D' -> AgentConnInfoReply <$> smpP <*> (unTail <$> smpP)
+      'R' -> AgentRatchetInfo . unTail <$> smpP
      'M' -> AgentMessage <$> smpP <*> smpP
      _ -> fail "bad AgentMessage"

 data AgentMessageType
  = AM_CONN_INFO
  | AM_CONN_INFO_REPLY
+  | AM_RATCHET_INFO
  | AM_HELLO_
  | AM_REPLY_
  | AM_A_MSG_
@@ -780,12 +846,14 @@ data AgentMessageType
  | AM_QKEY_
  | AM_QUSE_
  | AM_QTEST_
+  | AM_EREADY_
  deriving (Eq, Show)

 instance Encoding AgentMessageType where
  smpEncode = \case
    AM_CONN_INFO -> "C"
    AM_CONN_INFO_REPLY -> "D"
+    AM_RATCHET_INFO -> "S"
    AM_HELLO_ -> "H"
    AM_REPLY_ -> "R"
    AM_A_MSG_ -> "M"
@@ -794,10 +862,12 @@ instance Encoding AgentMessageType where
    AM_QKEY_ -> "QK"
    AM_QUSE_ -> "QU"
    AM_QTEST_ -> "QT"
+    AM_EREADY_ -> "E"
  smpP =
    A.anyChar >>= \case
      'C' -> pure AM_CONN_INFO
      'D' -> pure AM_CONN_INFO_REPLY
+      'S' -> pure AM_RATCHET_INFO
      'H' -> pure AM_HELLO_
      'R' -> pure AM_REPLY_
      'M' -> pure AM_A_MSG_
@@ -809,12 +879,14 @@ instance Encoding AgentMessageType where
          'U' -> pure AM_QUSE_
          'T' -> pure AM_QTEST_
          _ -> fail "bad AgentMessageType"
+      'E' -> pure AM_EREADY_
      _ -> fail "bad AgentMessageType"

 agentMessageType :: AgentMessage -> AgentMessageType
 agentMessageType = \case
  AgentConnInfo _ -> AM_CONN_INFO
  AgentConnInfoReply {} -> AM_CONN_INFO_REPLY
+  AgentRatchetInfo _ -> AM_RATCHET_INFO
  AgentMessage _ aMsg -> case aMsg of
    -- HELLO is used both in v1 and in v2, but differently.
    -- - in v1 (and, possibly, in v2 for simplex connections) can be sent multiple times,
@@ -829,6 +901,7 @@ agentMessageType = \case
    QKEY _ -> AM_QKEY_
    QUSE _ -> AM_QUSE_
    QTEST _ -> AM_QTEST_
+    EREADY _ -> AM_EREADY_

 data APrivHeader = APrivHeader
  { -- | sequential ID assigned by the sending agent
@@ -852,6 +925,7 @@ data AMsgType
  | QKEY_
  | QUSE_
  | QTEST_
+  | EREADY_
  deriving (Eq)

 instance Encoding AMsgType where
@@ -864,6 +938,7 @@ instance Encoding AMsgType where
    QKEY_ -> "QK"
    QUSE_ -> "QU"
    QTEST_ -> "QT"
+    EREADY_ -> "E"
  smpP =
    A.anyChar >>= \case
      'H' -> pure HELLO_
@@ -877,6 +952,7 @@ instance Encoding AMsgType where
          'U' -> pure QUSE_
          'T' -> pure QTEST_
          _ -> fail "bad AMsgType"
+      'E' -> pure EREADY_
      _ -> fail "bad AMsgType"

 -- | Messages sent between SMP agents once SMP queue is secured.
@@ -899,6 +975,8 @@ data AMessage
    QUSE (L.NonEmpty (SndQAddr, Bool))
  | -- sent by the sender to test new queues and to complete switching
    QTEST (L.NonEmpty SndQAddr)
+  | -- ratchet re-synchronization is complete, with last decrypted sender message id (recipient's `last_external_snd_msg_id`)
+    EREADY Int64
  deriving (Show)

 type SndQAddr = (SMPServer, SMP.SenderId)
@@ -913,6 +991,7 @@ instance Encoding AMessage where
    QKEY qs -> smpEncode (QKEY_, qs)
    QUSE qs -> smpEncode (QUSE_, qs)
    QTEST qs -> smpEncode (QTEST_, qs)
+    EREADY lastDecryptedMsgId -> smpEncode (EREADY_, lastDecryptedMsgId)
  smpP =
    smpP
      >>= \case
@@ -924,6 +1003,7 @@ instance Encoding AMessage where
        QKEY_ -> QKEY <$> smpP
        QUSE_ -> QUSE <$> smpP
        QTEST_ -> QTEST <$> smpP
+        EREADY_ -> EREADY <$> smpP

 instance forall m. ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where
  strEncode = \case
@@ -1271,6 +1351,8 @@ data AgentErrorType
    AGENT {agentErr :: SMPAgentError}
  | -- | agent implementation or dependency errors
    INTERNAL {internalErr :: String}
+  | -- | agent inactive
+    INACTIVE
  deriving (Eq, Generic, Show, Exception)

 instance ToJSON AgentErrorType where
@@ -1367,6 +1449,20 @@ instance ToJSON AgentCryptoError where
  toJSON = J.genericToJSON $ sumTypeJSON id
  toEncoding = J.genericToEncoding $ sumTypeJSON id

+instance StrEncoding AgentCryptoError where
+  strP =
+    "DECRYPT_AES" $> DECRYPT_AES
+      <|> "DECRYPT_CB" $> DECRYPT_CB
+      <|> "RATCHET_HEADER" $> RATCHET_HEADER
+      <|> "RATCHET_EARLIER " *> (RATCHET_EARLIER <$> strP)
+      <|> "RATCHET_SKIPPED " *> (RATCHET_SKIPPED <$> strP)
+  strEncode = \case
+    DECRYPT_AES -> "DECRYPT_AES"
+    DECRYPT_CB -> "DECRYPT_CB"
+    RATCHET_HEADER -> "RATCHET_HEADER"
+    RATCHET_EARLIER n -> "RATCHET_EARLIER " <> strEncode n
+    RATCHET_SKIPPED n -> "RATCHET_SKIPPED " <> strEncode n
+
 instance ToJSON SMPAgentError where
  toJSON = J.genericToJSON $ sumTypeJSON id
  toEncoding = J.genericToEncoding $ sumTypeJSON id
@@ -1385,6 +1481,7 @@ instance StrEncoding AgentErrorType where
      <|> "AGENT QUEUE " *> (AGENT . A_QUEUE <$> parseRead A.takeByteString)
      <|> "AGENT " *> (AGENT <$> parseRead1)
      <|> "INTERNAL " *> (INTERNAL <$> parseRead A.takeByteString)
+      <|> "INACTIVE" $> INACTIVE
    where
      textP = T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' ')
  strEncode = \case
@@ -1400,6 +1497,7 @@ instance StrEncoding AgentErrorType where
    AGENT (A_QUEUE e) -> "AGENT QUEUE " <> bshow e
    AGENT e -> "AGENT " <> bshow e
    INTERNAL e -> "INTERNAL " <> bshow e
+    INACTIVE -> "INACTIVE"
    where
      text = encodeUtf8 . T.pack

@@ -1415,6 +1513,14 @@ instance Arbitrary SMPAgentError where arbitrary = genericArbitraryU

 instance Arbitrary AgentCryptoError where arbitrary = genericArbitraryU

+cryptoErrToSyncState :: AgentCryptoError -> RatchetSyncState
+cryptoErrToSyncState = \case
+  DECRYPT_AES -> RSAllowed
+  DECRYPT_CB -> RSAllowed
+  RATCHET_HEADER -> RSRequired
+  RATCHET_EARLIER _ -> RSAllowed
+  RATCHET_SKIPPED _ -> RSRequired
+
 -- | SMP agent command and response parser for commands passed via network (only parses binary length)
 networkCommandP :: Parser ACmd
 networkCommandP = commandP A.takeByteString
@@ -1444,6 +1550,7 @@ instance StrEncoding ACmdTag where
      "DOWN" -> nt DOWN_
      "UP" -> nt UP_
      "SWITCH" -> ct SWITCH_
+      "RSYNC" -> ct RSYNC_
      "SEND" -> t SEND_
      "MID" -> ct MID_
      "SENT" -> ct SENT_
@@ -1497,6 +1604,7 @@ instance (APartyI p, AEntityI e) => StrEncoding (ACommandTag p e) where
    DOWN_ -> "DOWN"
    UP_ -> "UP"
    SWITCH_ -> "SWITCH"
+    RSYNC_ -> "RSYNC"
    SEND_ -> "SEND"
    MID_ -> "MID"
    SENT_ -> "SENT"
@@ -1564,6 +1672,7 @@ commandP binaryP =
          DOWN_ -> s (DOWN <$> strP_ <*> connections)
          UP_ -> s (UP <$> strP_ <*> connections)
          SWITCH_ -> s (SWITCH <$> strP_ <*> strP_ <*> strP)
+          RSYNC_ -> s (RSYNC <$> strP_ <*> strP <*> strP)
          MID_ -> s (MID <$> A.decimal)
          SENT_ -> s (SENT <$> A.decimal)
          MERR_ -> s (MERR <$> A.decimal <* A.space <*> strP)
@@ -1622,6 +1731,7 @@ serializeCommand = \case
  DOWN srv conns -> B.unwords [s DOWN_, s srv, connections conns]
  UP srv conns -> B.unwords [s UP_, s srv, connections conns]
  SWITCH dir phase srvs -> s (SWITCH_, dir, phase, srvs)
+  RSYNC rrState cryptoErr cstats -> s (RSYNC_, rrState, cryptoErr, cstats)
  SEND msgFlags msgBody -> B.unwords [s SEND_, smpEncode msgFlags, serializeBinary msgBody]
  MID mId -> s (MID_, Str $ bshow mId)
  SENT mId -> s (SENT_, Str $ bshow mId)
@@ -23,7 +23,7 @@ import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
 import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), simplexMQVersion)
-import Simplex.Messaging.Transport.Server (loadTLSServerParams, runTransportServer)
+import Simplex.Messaging.Transport.Server (loadTLSServerParams, runTransportServer, defaultTransportServerConfig)
 import Simplex.Messaging.Util (bshow)
 import UnliftIO.Async (race_)
 import qualified UnliftIO.Exception as E
@@ -48,7 +48,7 @@ runSMPAgentBlocking (ATransport t) cfg@AgentConfig {tcpPort, caCertificateFile,
    smpAgent _ = do
      -- tlsServerParams is not in Env to avoid breaking functional API w/t key and certificate generation
      tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
-      runTransportServer started tcpPort tlsServerParams True $ \(h :: c) -> do
+      runTransportServer started tcpPort tlsServerParams defaultTransportServerConfig $ \(h :: c) -> do
        liftIO . putLn h $ "Welcome to SMP agent v" <> B.pack simplexMQVersion
        c <- getAgentClient initServers
        logConnection c True
@@ -243,14 +243,22 @@ deriving instance Eq (Connection d)

 deriving instance Show (Connection d)

-connData :: Connection d -> ConnData
-connData = \case
+toConnData :: Connection d -> ConnData
+toConnData = \case
  NewConnection cData -> cData
  RcvConnection cData _ -> cData
  SndConnection cData _ -> cData
  DuplexConnection cData _ _ -> cData
  ContactConnection cData _ -> cData

+updateConnection :: ConnData -> Connection d -> Connection d
+updateConnection cData = \case
+  NewConnection _ -> NewConnection cData
+  RcvConnection _ rq -> RcvConnection cData rq
+  SndConnection _ sq -> SndConnection cData sq
+  DuplexConnection _ rqs sqs -> DuplexConnection cData rqs sqs
+  ContactConnection _ rq -> ContactConnection cData rq
+
 data SConnType :: ConnType -> Type where
  SCNew :: SConnType CNew
  SCRcv :: SConnType CRcv
@@ -293,10 +301,25 @@ data ConnData = ConnData
    connAgentVersion :: Version,
    enableNtfs :: Bool,
    duplexHandshake :: Maybe Bool, -- added in agent protocol v2
-    deleted :: Bool
+    lastExternalSndId :: PrevExternalSndId,
+    deleted :: Bool,
+    ratchetSyncState :: RatchetSyncState
  }
  deriving (Eq, Show)

+-- this function should be mirrored in the clients
+ratchetSyncAllowed :: ConnData -> Bool
+ratchetSyncAllowed cData@ConnData {ratchetSyncState} =
+  ratchetSyncSupported' cData && (ratchetSyncState `elem` ([RSAllowed, RSRequired] :: [RatchetSyncState]))
+
+ratchetSyncSupported' :: ConnData -> Bool
+ratchetSyncSupported' ConnData {connAgentVersion} = connAgentVersion >= 3
+
+-- this function should be mirrored in the clients
+ratchetSyncSendProhibited :: ConnData -> Bool
+ratchetSyncSendProhibited ConnData {ratchetSyncState} =
+  ratchetSyncState `elem` ([RSRequired, RSStarted, RSAgreed] :: [RatchetSyncState])
+
 data PendingCommand = PendingCommand
  { corrId :: ACorrId,
    userId :: UserId,
@@ -52,7 +52,12 @@ module Simplex.Messaging.Agent.Store.SQLite
    getDeletedConns,
    getConnData,
    setConnDeleted,
+    setConnAgentVersion,
    getDeletedConnIds,
+    setConnRatchetSync,
+    addProcessedRatchetKeyHash,
+    checkProcessedRatchetKeyHashExists,
+    deleteProcessedRatchetKeyHashesExpired,
    getRcvConn,
    getRcvQueueById,
    getSndQueueById,
@@ -107,7 +112,11 @@ module Simplex.Messaging.Agent.Store.SQLite
    -- Double ratchet persistence
    createRatchetX3dhKeys,
    getRatchetX3dhKeys,
+    createRatchetX3dhKeys',
+    getRatchetX3dhKeys',
+    setRatchetX3dhKeys,
    createRatchet,
+    deleteRatchet,
    getRatchet,
    getSkippedMsgKeys,
    updateRatchet,
@@ -197,7 +206,6 @@ module Simplex.Messaging.Agent.Store.SQLite
  )
 where

-import Control.Concurrent (threadDelay)
 import Control.Concurrent.STM (stateTVar)
 import Control.Monad.Except
 import Crypto.Random (ChaChaDRG, randomBytesGenerate)
@@ -208,11 +216,10 @@ import Data.Bifunctor (second)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base64.URL as U
 import Data.Char (toLower)
-import Data.Function (on)
 import Data.Functor (($>))
 import Data.IORef
 import Data.Int (Int64)
-import Data.List (foldl', groupBy, intercalate, sortBy)
+import Data.List (foldl', intercalate, sortBy)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
@@ -221,7 +228,7 @@ import Data.Ord (Down (..))
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
-import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime, getCurrentTime)
+import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
 import Data.Word (Word32)
 import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), Query (..), SQLError, ToRow, field, (:.) (..))
 import qualified Database.SQLite.Simple as DB
@@ -238,6 +245,7 @@ import Simplex.FileTransfer.Types
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval (RI2State (..))
 import Simplex.Messaging.Agent.Store
+import Simplex.Messaging.Agent.Store.SQLite.Common
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (DownMigration (..), MTRError, Migration (..), MigrationsToRun (..), mtrErrorDescription)
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import qualified Simplex.Messaging.Crypto as C
@@ -250,25 +258,18 @@ import Simplex.Messaging.Parsers (blobFieldParser, dropPrefix, fromTextField_, s
 import Simplex.Messaging.Protocol
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Util (bshow, diffToMilliseconds, eitherToMaybe, ($>>=), (<$$>))
+import Simplex.Messaging.Util (bshow, eitherToMaybe, groupOn, ($>>=), (<$$>))
 import Simplex.Messaging.Version
 import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (takeDirectory)
 import System.IO (hFlush, stdout)
-import UnliftIO.Exception (bracket, onException)
+import UnliftIO.Exception (onException)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM

 -- * SQLite Store implementation

-data SQLiteStore = SQLiteStore
-  { dbFilePath :: FilePath,
-    dbEncrypted :: TVar Bool,
-    dbConnection :: TMVar DB.Connection,
-    dbNew :: Bool
-  }
-
 data MigrationError
  = MEUpgrade {upMigrations :: [UpMigration]}
  | MEDowngrade {downMigrations :: [String]}
@@ -325,35 +326,35 @@ createSQLiteStore dbFilePath dbKey migrations confirmMigrations = do
    Left e -> closeSQLiteStore st $> Left e

 migrateSchema :: SQLiteStore -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError ())
-migrateSchema st migrations confirmMigrations = withConnection st $ \db -> do
-  Migrations.initialize db
-  Migrations.get db migrations >>= \case
+migrateSchema st migrations confirmMigrations = do
+  Migrations.initialize st
+  Migrations.get st migrations >>= \case
    Left e -> do
      when (confirmMigrations == MCConsole) $ confirmOrExit ("Database state error: " <> mtrErrorDescription e)
      pure . Left $ MigrationError e
    Right MTRNone -> pure $ Right ()
    Right ms@(MTRUp ums)
-      | dbNew st -> Migrations.run db ms $> Right ()
+      | dbNew st -> Migrations.run st ms $> Right ()
      | otherwise -> case confirmMigrations of
-        MCYesUp -> run db ms
-        MCYesUpDown -> run db ms
-        MCConsole -> confirm err >> run db ms
+        MCYesUp -> run ms
+        MCYesUpDown -> run ms
+        MCConsole -> confirm err >> run ms
        MCError -> pure $ Left err
      where
        err = MEUpgrade $ map upMigration ums -- "The app has a newer version than the database.\nConfirm to back up and upgrade using these migrations: " <> intercalate ", " (map name ums)
    Right ms@(MTRDown dms) -> case confirmMigrations of
-      MCYesUpDown -> run db ms
-      MCConsole -> confirm err >> run db ms
+      MCYesUpDown -> run ms
+      MCConsole -> confirm err >> run ms
      MCYesUp -> pure $ Left err
      MCError -> pure $ Left err
      where
        err = MEDowngrade $ map downName dms
  where
    confirm err = confirmOrExit $ migrationErrorDescription err
-    run db ms = do
+    run ms = do
      let f = dbFilePath st
      copyFile f (f <> ".bak")
-      Migrations.run db ms
+      Migrations.run st ms
      pure $ Right ()

 confirmOrExit :: String -> IO ()
@@ -367,9 +368,10 @@ confirmOrExit s = do
 connectSQLiteStore :: FilePath -> String -> IO SQLiteStore
 connectSQLiteStore dbFilePath dbKey = do
  dbNew <- not <$> doesFileExist dbFilePath
-  dbConnection <- newTMVarIO =<< connectDB dbFilePath dbKey
+  dbConn <- dbBusyLoop $ connectDB dbFilePath dbKey
+  dbConnVar <- newTMVarIO dbConn
  dbEncrypted <- newTVarIO . not $ null dbKey
-  pure SQLiteStore {dbFilePath, dbEncrypted, dbConnection, dbNew}
+  pure SQLiteStore {dbFilePath, dbEncrypted, dbConnection = dbConnVar, dbNew}

 connectDB :: FilePath -> String -> IO DB.Connection
 connectDB path key = do
@@ -381,13 +383,11 @@ connectDB path key = do
    prepare db = do
      let exec = SQLite3.exec $ DB.connectionHandle db
      unless (null key) . exec $ "PRAGMA key = " <> sqlString key <> ";"
-      exec . fromQuery $
-        [sql|
-          PRAGMA foreign_keys = ON;
-          -- PRAGMA trusted_schema = OFF;
-          PRAGMA secure_delete = ON;
-          PRAGMA auto_vacuum = FULL;
-        |]
+      exec "PRAGMA busy_timeout = 100;"
+      exec "PRAGMA foreign_keys = ON;"
+      -- exec "PRAGMA trusted_schema = OFF;"
+      exec "PRAGMA secure_delete = ON;"
+      exec "PRAGMA auto_vacuum = FULL;"

 closeSQLiteStore :: SQLiteStore -> IO ()
 closeSQLiteStore st = atomically (takeTMVar $ dbConnection st) >>= DB.close
@@ -430,37 +430,6 @@ handleSQLError err e
  | DB.sqlError e == DB.ErrorConstraint = err
  | otherwise = SEInternal $ bshow e

-withConnection :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withConnection SQLiteStore {dbConnection} =
-  bracket
-    (atomically $ takeTMVar dbConnection)
-    (atomically . putTMVar dbConnection)
-
-withTransaction :: forall a. SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransaction = withTransactionCtx Nothing
-
-withTransactionCtx :: forall a. Maybe String -> SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransactionCtx ctx_ st action = withConnection st $ loop 500 3_000_000
-  where
-    loop :: Int -> Int -> DB.Connection -> IO a
-    loop t tLim db =
-      transactionWithCtx `E.catch` \(e :: SQLError) ->
-        if tLim > t && DB.sqlError e == DB.ErrorBusy
-          then do
-            threadDelay t
-            loop (t * 9 `div` 8) (tLim - t) db
-          else E.throwIO e
-      where
-        transactionWithCtx = case ctx_ of
-          Nothing -> DB.withImmediateTransaction db (action db)
-          Just ctx -> do
-            t1 <- getCurrentTime
-            r <- DB.withImmediateTransaction db (action db)
-            t2 <- getCurrentTime
-            putStrLn $ "withTransactionCtx start :: " <> show t1 <> " :: " <> ctx
-            putStrLn $ "withTransactionCtx end   :: " <> show t2 <> " :: " <> ctx <> " :: duration=" <> show (diffToMilliseconds $ diffUTCTime t2 t1)
-            pure r
-
 createUserRecord :: DB.Connection -> IO UserId
 createUserRecord db = do
  DB.execute_ db "INSERT INTO users DEFAULT VALUES"
@@ -1030,6 +999,35 @@ getRatchetX3dhKeys db connId =
      Right (Just k1, Just k2) -> Right (k1, k2)
      _ -> Left SEX3dhKeysNotFound

+createRatchetX3dhKeys' :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> C.PublicKeyX448 -> C.PublicKeyX448 -> IO ()
+createRatchetX3dhKeys' db connId x3dhPrivKey1 x3dhPrivKey2 x3dhPubKey1 x3dhPubKey2 =
+  DB.execute
+    db
+    "INSERT INTO ratchets (conn_id, x3dh_priv_key_1, x3dh_priv_key_2, x3dh_pub_key_1, x3dh_pub_key_2) VALUES (?,?,?,?,?)"
+    (connId, x3dhPrivKey1, x3dhPrivKey2, x3dhPubKey1, x3dhPubKey2)
+
+getRatchetX3dhKeys' :: DB.Connection -> ConnId -> IO (Either StoreError (C.PrivateKeyX448, C.PrivateKeyX448, C.PublicKeyX448, C.PublicKeyX448))
+getRatchetX3dhKeys' db connId =
+  fmap hasKeys $
+    firstRow id SEX3dhKeysNotFound $
+      DB.query db "SELECT x3dh_priv_key_1, x3dh_priv_key_2, x3dh_pub_key_1, x3dh_pub_key_2 FROM ratchets WHERE conn_id = ?" (Only connId)
+  where
+    hasKeys = \case
+      Right (Just pk1, Just pk2, Just k1, Just k2) -> Right (pk1, pk2, k1, k2)
+      _ -> Left SEX3dhKeysNotFound
+
+-- used to remember new keys when starting ratchet re-synchronization
+setRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> C.PublicKeyX448 -> C.PublicKeyX448 -> IO ()
+setRatchetX3dhKeys db connId x3dhPrivKey1 x3dhPrivKey2 x3dhPubKey1 x3dhPubKey2 =
+  DB.execute
+    db
+    [sql|
+      UPDATE ratchets
+      SET x3dh_priv_key_1 = ?, x3dh_priv_key_2 = ?, x3dh_pub_key_1 = ?, x3dh_pub_key_2 = ?
+      WHERE conn_id = ?
+    |]
+    (x3dhPrivKey1, x3dhPrivKey2, x3dhPubKey1, x3dhPubKey2, connId)
+
 createRatchet :: DB.Connection -> ConnId -> RatchetX448 -> IO ()
 createRatchet db connId rc =
  DB.executeNamed
@@ -1040,10 +1038,16 @@ createRatchet db connId rc =
      ON CONFLICT (conn_id) DO UPDATE SET
        ratchet_state = :ratchet_state,
        x3dh_priv_key_1 = NULL,
-        x3dh_priv_key_2 = NULL
+        x3dh_priv_key_2 = NULL,
+        x3dh_pub_key_1 = NULL,
+        x3dh_pub_key_2 = NULL
    |]
    [":conn_id" := connId, ":ratchet_state" := rc]

+deleteRatchet :: DB.Connection -> ConnId -> IO ()
+deleteRatchet db connId =
+  DB.execute db "DELETE FROM ratchets WHERE conn_id = ?" (Only connId)
+
 getRatchet :: DB.Connection -> ConnId -> IO (Either StoreError RatchetX448)
 getRatchet db connId =
  firstRow' ratchet SERatchetNotFound $ DB.query db "SELECT ratchet_state FROM ratchets WHERE conn_id = ?" (Only connId)
@@ -1092,7 +1096,9 @@ insertedRowId db = fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"

 getPendingCommands :: DB.Connection -> ConnId -> IO [(Maybe SMPServer, [AsyncCmdId])]
 getPendingCommands db connId = do
-  map (\ids -> (fst $ head ids, map snd ids)) . groupBy ((==) `on` fst) . map srvCmdId
+  -- `groupOn` is used instead of `groupAllOn` to avoid extra sorting by `server + cmdId`, as the query already sorts by them.
+  -- TODO review whether this can break if, e.g., the server has another key hash.
+  map (\ids -> (fst $ head ids, map snd ids)) . groupOn fst . map srvCmdId
    <$> DB.query
      db
      [sql|
@@ -1642,17 +1648,56 @@ getAnyConns_ deleted' db connIds = forM connIds $ E.handle handleDBError . getAn
    handleDBError = pure . Left . SEInternal . bshow

 getConnData :: DB.Connection -> ConnId -> IO (Maybe (ConnData, ConnectionMode))
-getConnData dbConn connId' =
-  maybeFirstRow cData $ DB.query dbConn "SELECT user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, duplex_handshake, deleted FROM connections WHERE conn_id = ?;" (Only connId')
+getConnData db connId' =
+  maybeFirstRow cData $
+    DB.query
+      db
+      [sql|
+        SELECT
+          user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, duplex_handshake,
+          last_external_snd_msg_id, deleted, ratchet_sync_state
+        FROM connections
+        WHERE conn_id = ?
+      |]
+      (Only connId')
  where
-    cData (userId, connId, cMode, connAgentVersion, enableNtfs_, duplexHandshake, deleted) = (ConnData {userId, connId, connAgentVersion, enableNtfs = fromMaybe True enableNtfs_, duplexHandshake, deleted}, cMode)
+    cData (userId, connId, cMode, connAgentVersion, enableNtfs_, duplexHandshake, lastExternalSndId, deleted, ratchetSyncState) =
+      (ConnData {userId, connId, connAgentVersion, enableNtfs = fromMaybe True enableNtfs_, duplexHandshake, lastExternalSndId, deleted, ratchetSyncState}, cMode)

 setConnDeleted :: DB.Connection -> ConnId -> IO ()
 setConnDeleted db connId = DB.execute db "UPDATE connections SET deleted = ? WHERE conn_id = ?" (True, connId)

+setConnAgentVersion :: DB.Connection -> ConnId -> Version -> IO ()
+setConnAgentVersion db connId aVersion =
+  DB.execute db "UPDATE connections SET smp_agent_version = ? WHERE conn_id = ?" (aVersion, connId)
+
 getDeletedConnIds :: DB.Connection -> IO [ConnId]
 getDeletedConnIds db = map fromOnly <$> DB.query db "SELECT conn_id FROM connections WHERE deleted = ?" (Only True)

+setConnRatchetSync :: DB.Connection -> ConnId -> RatchetSyncState -> IO ()
+setConnRatchetSync db connId ratchetSyncState =
+  DB.execute db "UPDATE connections SET ratchet_sync_state = ? WHERE conn_id = ?" (ratchetSyncState, connId)
+
+addProcessedRatchetKeyHash :: DB.Connection -> ConnId -> ByteString -> IO ()
+addProcessedRatchetKeyHash db connId hash =
+  DB.execute db "INSERT INTO processed_ratchet_key_hashes (conn_id, hash) VALUES (?,?)" (connId, hash)
+
+checkProcessedRatchetKeyHashExists :: DB.Connection -> ConnId -> ByteString -> IO Bool
+checkProcessedRatchetKeyHashExists db connId hash = do
+  fromMaybe False
+    <$> maybeFirstRow
+      fromOnly
+      ( DB.query
+          db
+          "SELECT 1 FROM processed_ratchet_key_hashes WHERE conn_id = ? AND hash = ? LIMIT 1"
+          (connId, hash)
+      )
+
+deleteProcessedRatchetKeyHashesExpired :: DB.Connection -> NominalDiffTime -> IO ()
+deleteProcessedRatchetKeyHashesExpired db ttl = do
+  cutoffTs <- addUTCTime (- ttl) <$> getCurrentTime
+  DB.execute db "DELETE FROM processed_ratchet_key_hashes WHERE created_at < ?" (Only cutoffTs)
+
 -- | returns all connection queues, the first queue is the primary one
 getRcvQueuesByConnId_ :: DB.Connection -> ConnId -> IO (Maybe (NonEmpty RcvQueue))
 getRcvQueuesByConnId_ db connId =
@@ -0,0 +1,61 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Common
+  ( SQLiteStore (..),
+    withConnection,
+    withTransaction,
+    withTransactionCtx,
+    dbBusyLoop,
+  )
+where
+
+import Control.Concurrent (threadDelay)
+import Data.Time.Clock (diffUTCTime, getCurrentTime)
+import Database.SQLite.Simple (SQLError)
+import qualified Database.SQLite.Simple as DB
+import Simplex.Messaging.Util (diffToMilliseconds)
+import UnliftIO.Exception (bracket)
+import qualified UnliftIO.Exception as E
+import UnliftIO.STM
+
+data SQLiteStore = SQLiteStore
+  { dbFilePath :: FilePath,
+    dbEncrypted :: TVar Bool,
+    dbConnection :: TMVar DB.Connection,
+    dbNew :: Bool
+  }
+
+withConnection :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
+withConnection SQLiteStore {dbConnection} =
+  bracket
+    (atomically $ takeTMVar dbConnection)
+    (atomically . putTMVar dbConnection)
+
+withTransaction :: forall a. SQLiteStore -> (DB.Connection -> IO a) -> IO a
+withTransaction = withTransactionCtx Nothing
+
+withTransactionCtx :: forall a. Maybe String -> SQLiteStore -> (DB.Connection -> IO a) -> IO a
+withTransactionCtx ctx_ st action = withConnection st $ \db -> dbBusyLoop (transactionWithCtx db)
+  where
+    transactionWithCtx db = case ctx_ of
+      Nothing -> DB.withImmediateTransaction db (action db)
+      Just ctx -> do
+        t1 <- getCurrentTime
+        r <- DB.withImmediateTransaction db (action db)
+        t2 <- getCurrentTime
+        putStrLn $ "withTransactionCtx start :: " <> show t1 <> " :: " <> ctx
+        putStrLn $ "withTransactionCtx end   :: " <> show t2 <> " :: " <> ctx <> " :: duration=" <> show (diffToMilliseconds $ diffUTCTime t2 t1)
+        pure r
+
+dbBusyLoop :: forall a. IO a -> IO a
+dbBusyLoop action = loop 500 3000000
+  where
+    loop :: Int -> Int -> IO a
+    loop t tLim =
+      action `E.catch` \(e :: SQLError) ->
+        if tLim > t && DB.sqlError e == DB.ErrorBusy
+          then do
+            threadDelay t
+            loop (t * 9 `div` 8) (tLim - t)
+          else E.throwIO e
@@ -42,6 +42,7 @@ import Database.SQLite.Simple.QQ (sql)
 import qualified Database.SQLite3 as SQLite3
 import GHC.Generics (Generic)
 import Simplex.Messaging.Agent.Protocol (extraSMPServerHosts)
+import Simplex.Messaging.Agent.Store.SQLite.Common
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
@@ -61,6 +62,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -88,7 +90,8 @@ schemaMigrations =
    ("m20230401_snd_files", m20230401_snd_files, Just down_m20230401_snd_files),
    ("m20230510_files_pending_replicas_indexes", m20230510_files_pending_replicas_indexes, Just down_m20230510_files_pending_replicas_indexes),
    ("m20230516_encrypted_rcv_message_hashes", m20230516_encrypted_rcv_message_hashes, Just down_m20230516_encrypted_rcv_message_hashes),
-    ("m20230531_switch_status", m20230531_switch_status, Just down_m20230531_switch_status)
+    ("m20230531_switch_status", m20230531_switch_status, Just down_m20230531_switch_status),
+    ("m20230615_ratchet_sync", m20230615_ratchet_sync, Just down_m20230615_ratchet_sync)
  ]

 -- | The list of migrations in ascending order by date
@@ -97,44 +100,42 @@ app = sortOn name $ map migration schemaMigrations
  where
    migration (name, up, down) = Migration {name, up = fromQuery up, down = fromQuery <$> down}

-get :: Connection -> [Migration] -> IO (Either MTRError MigrationsToRun)
-get db migrations = migrationsToRun migrations <$> getCurrent db
+get :: SQLiteStore -> [Migration] -> IO (Either MTRError MigrationsToRun)
+get st migrations = migrationsToRun migrations <$> withTransaction st getCurrent

 getCurrent :: Connection -> IO [Migration]
 getCurrent db = map toMigration <$> DB.query_ db "SELECT name, down FROM migrations ORDER BY name ASC;"
  where
    toMigration (name, down) = Migration {name, up = "", down}

-run :: Connection -> MigrationsToRun -> IO ()
-run db = \case
+run :: SQLiteStore -> MigrationsToRun -> IO ()
+run st = \case
  MTRUp [] -> pure ()
-  MTRUp ms -> mapM_ runUp ms >> execSQL "VACUUM;"
+  MTRUp ms -> mapM_ runUp ms >> withConnection st (`execSQL` "VACUUM;")
  MTRDown ms -> mapM_ runDown $ reverse ms
  MTRNone -> pure ()
  where
-    runUp Migration {name, up, down} = do
-      when (name == "m20220811_onion_hosts") updateServers
-      DB.withImmediateTransaction db $ insert >> execSQL up
+    runUp Migration {name, up, down} = withTransaction st $ \db -> do
+      when (name == "m20220811_onion_hosts") $ updateServers db
+      insert db >> execSQL db up
      where
-        insert = DB.execute db "INSERT INTO migrations (name, down, ts) VALUES (?,?,?)" . (name,down,) =<< getCurrentTime
-        updateServers = forM_ (M.assocs extraSMPServerHosts) $ \(h, h') ->
-          DB.withImmediateTransaction db $
-            let hs = decodeLatin1 . strEncode $ ([h, h'] :: NonEmpty TransportHost)
-             in DB.execute db "UPDATE servers SET host = ? WHERE host = ?" (hs, decodeLatin1 $ strEncode h)
-    runDown DownMigration {downName, downQuery} = do
-      DB.withImmediateTransaction db $ do
-        execSQL downQuery
-        DB.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
-    execSQL = SQLite3.exec $ DB.connectionHandle db
+        insert db = DB.execute db "INSERT INTO migrations (name, down, ts) VALUES (?,?,?)" . (name,down,) =<< getCurrentTime
+        updateServers db = forM_ (M.assocs extraSMPServerHosts) $ \(h, h') ->
+          let hs = decodeLatin1 . strEncode $ ([h, h'] :: NonEmpty TransportHost)
+           in DB.execute db "UPDATE servers SET host = ? WHERE host = ?" (hs, decodeLatin1 $ strEncode h)
+    runDown DownMigration {downName, downQuery} = withTransaction st $ \db -> do
+      execSQL db downQuery
+      DB.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
+    execSQL db = SQLite3.exec $ DB.connectionHandle db

-initialize :: Connection -> IO ()
-initialize db = do
+initialize :: SQLiteStore -> IO ()
+initialize st = withTransaction st $ \db -> do
  cs :: [Text] <- map fromOnly <$> DB.query_ db "SELECT name FROM pragma_table_info('migrations')"
  case cs of
-    [] -> createMigrations
+    [] -> createMigrations db
    _ -> when ("down" `notElem` cs) $ DB.execute_ db "ALTER TABLE migrations ADD COLUMN down TEXT"
  where
-    createMigrations =
+    createMigrations db =
      DB.execute_
        db
        [sql|
@@ -0,0 +1,41 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+-- Ratchet public keys are saved when ratchet re-synchronization is started - upon receiving other party's public keys,
+-- keys are compared to determine ratchet initialization ordering for both parties.
+-- This solves a possible race when both parties start ratchet re-synchronization at the same time.
+m20230615_ratchet_sync :: Query
+m20230615_ratchet_sync =
+  [sql|
+ALTER TABLE connections ADD COLUMN ratchet_sync_state TEXT NOT NULL DEFAULT 'ok';
+
+ALTER TABLE ratchets ADD COLUMN x3dh_pub_key_1 BLOB;
+ALTER TABLE ratchets ADD COLUMN x3dh_pub_key_2 BLOB;
+
+CREATE TABLE processed_ratchet_key_hashes(
+  processed_ratchet_key_hash_id INTEGER PRIMARY KEY,
+  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  hash BLOB NOT NULL,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now'))
+);
+
+CREATE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(conn_id, hash);
+|]
+
+down_m20230615_ratchet_sync :: Query
+down_m20230615_ratchet_sync =
+  [sql|
+DROP INDEX idx_processed_ratchet_key_hashes_hash;
+
+DROP TABLE processed_ratchet_key_hashes;
+
+ALTER TABLE ratchets DROP COLUMN x3dh_pub_key_2;
+ALTER TABLE ratchets DROP COLUMN x3dh_pub_key_1;
+
+ALTER TABLE connections DROP COLUMN ratchet_sync_state;
+|]
@@ -25,7 +25,8 @@ CREATE TABLE connections(
  enable_ntfs INTEGER,
  deleted INTEGER DEFAULT 0 CHECK(deleted NOT NULL),
  user_id INTEGER CHECK(user_id NOT NULL)
-  REFERENCES users ON DELETE CASCADE
+  REFERENCES users ON DELETE CASCADE,
+  ratchet_sync_state TEXT NOT NULL DEFAULT 'ok'
 ) WITHOUT ROWID;
 CREATE TABLE rcv_queues(
  host TEXT NOT NULL,
@@ -154,6 +155,9 @@ CREATE TABLE ratchets(
  -- ratchet is initially empty on the receiving side(the side offering the connection)
  ratchet_state BLOB,
  e2e_version INTEGER NOT NULL DEFAULT 1
+  ,
+  x3dh_pub_key_1 BLOB,
+  x3dh_pub_key_2 BLOB
 ) WITHOUT ROWID;
 CREATE TABLE skipped_messages(
  skipped_message_id INTEGER PRIMARY KEY,
@@ -356,6 +360,13 @@ CREATE TABLE encrypted_rcv_message_hashes(
  created_at TEXT NOT NULL DEFAULT(datetime('now')),
  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
+CREATE TABLE processed_ratchet_key_hashes(
+  processed_ratchet_key_hash_id INTEGER PRIMARY KEY,
+  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  hash BLOB NOT NULL,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
 CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id);
 CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id);
 CREATE UNIQUE INDEX idx_snd_queue_id ON snd_queues(conn_id, snd_queue_id);
@@ -446,3 +457,7 @@ CREATE INDEX idx_encrypted_rcv_message_hashes_hash ON encrypted_rcv_message_hash
  conn_id,
  hash
 );
+CREATE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(
+  conn_id,
+  hash
+);
@@ -11,6 +11,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TupleSections #-}

 -- |
 -- Module      : Simplex.Messaging.Client
@@ -82,10 +83,11 @@ import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (rights)
+import Data.Foldable (foldl')
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (find)
-import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
 import Data.Time.Clock (UTCTime, getCurrentTime)
@@ -114,6 +116,9 @@ data ProtocolClient err msg = ProtocolClient
    sessionId :: SessionId,
    sessionTs :: UTCTime,
    thVersion :: Version,
+    timeoutPerBlock :: Int,
+    blockSize :: Int,
+    batch :: Bool,
    client_ :: PClient err msg
  }

@@ -122,6 +127,7 @@ data PClient err msg = PClient
    transportSession :: TransportSession msg,
    transportHost :: TransportHost,
    tcpTimeout :: Int,
+    batchDelay :: Maybe Int,
    pingErrorCount :: TVar Int,
    clientCorrId :: TVar Natural,
    sentCommands :: TMap CorrId (Request err msg),
@@ -168,6 +174,8 @@ data NetworkConfig = NetworkConfig
    tcpConnectTimeout :: Int,
    -- | timeout of protocol commands (microseconds)
    tcpTimeout :: Int,
+    -- | additional timeout per kilobyte (1024 bytes) to be sent
+    tcpTimeoutPerKb :: Int,
    -- | TCP keep-alive options, Nothing to skip enabling keep-alive
    tcpKeepAlive :: Maybe KeepAliveOpts,
    -- | period for SMP ping commands (microseconds, 0 to disable)
@@ -199,8 +207,9 @@ defaultNetworkConfig =
      hostMode = HMOnionViaSocks,
      requiredHostMode = False,
      sessionMode = TSMUser,
-      tcpConnectTimeout = 7_500_000,
-      tcpTimeout = 5_000_000,
+      tcpConnectTimeout = 15_000_000,
+      tcpTimeout = 10_000_000,
+      tcpTimeoutPerKb = 20_000, -- 20ms, should be less than 130ms to avoid Int overflow on 32 bit systems
      tcpKeepAlive = Just defaultKeepAliveOpts,
      smpPingInterval = 600_000_000, -- 10min
      smpPingCount = 3,
@@ -219,8 +228,10 @@ data ProtocolClientConfig = ProtocolClientConfig
    defaultTransport :: (ServiceName, ATransport),
    -- | network configuration
    networkConfig :: NetworkConfig,
-    -- | SMP client-server protocol version range
-    smpServerVRange :: VersionRange
+    -- | client-server protocol version range
+    serverVRange :: VersionRange,
+    -- | delay between sending batches of commands (microseconds)
+    batchDelay :: Maybe Int
  }

 -- | Default protocol client configuration.
@@ -230,7 +241,8 @@ defaultClientConfig =
    { qSize = 64,
      defaultTransport = ("443", transport @TLS),
      networkConfig = defaultNetworkConfig,
-      smpServerVRange = supportedSMPServerVRange
+      serverVRange = supportedSMPServerVRange,
+      batchDelay = Nothing
    }

 data Request err msg = Request
@@ -276,14 +288,14 @@ type TransportSession msg = (UserId, ProtoServer msg, Maybe EntityId)
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
 getProtocolClient :: forall err msg. Protocol err msg => TransportSession msg -> ProtocolClientConfig -> Maybe (TBQueue (ServerTransmission msg)) -> (ProtocolClient err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient err msg))
-getProtocolClient transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, smpServerVRange} msgQ disconnected = do
+getProtocolClient transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, serverVRange, batchDelay} msgQ disconnected = do
  case chooseTransportHost networkConfig (host srv) of
    Right useHost ->
      (atomically (mkProtocolClient useHost) >>= runClient useTransport useHost)
        `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
    Left e -> pure $ Left e
  where
-    NetworkConfig {tcpConnectTimeout, tcpTimeout, smpPingInterval} = networkConfig
+    NetworkConfig {tcpConnectTimeout, tcpTimeout, tcpTimeoutPerKb, smpPingInterval} = networkConfig
    mkProtocolClient :: TransportHost -> STM (PClient err msg)
    mkProtocolClient transportHost = do
      connected <- newTVar False
@@ -298,6 +310,7 @@ getProtocolClient transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize,
            transportSession,
            transportHost,
            tcpTimeout,
+            batchDelay,
            pingErrorCount,
            clientCorrId,
            sentCommands,
@@ -329,11 +342,12 @@ getProtocolClient transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize,

    client :: forall c. Transport c => TProxy c -> PClient err msg -> TMVar (Either (ProtocolClientError err) (ProtocolClient err msg)) -> c -> IO ()
    client _ c cVar h =
-      runExceptT (protocolClientHandshake @err @msg h (keyHash srv) smpServerVRange) >>= \case
+      runExceptT (protocolClientHandshake @err @msg h (keyHash srv) serverVRange) >>= \case
        Left e -> atomically . putTMVar cVar . Left $ PCETransportError e
-        Right th@THandle {sessionId, thVersion} -> do
+        Right th@THandle {sessionId, thVersion, blockSize, batch} -> do
          sessionTs <- getCurrentTime
-          let c' = ProtocolClient {action = Nothing, client_ = c, sessionId, thVersion, sessionTs}
+          let timeoutPerBlock = (blockSize * tcpTimeoutPerKb) `div` 1024
+              c' = ProtocolClient {action = Nothing, client_ = c, sessionId, thVersion, sessionTs, timeoutPerBlock, blockSize, batch}
          atomically $ do
            writeTVar (connected c) True
            putTMVar cVar $ Right c'
@@ -341,7 +355,7 @@ getProtocolClient transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize,
            `finally` disconnected c'

    send :: Transport c => ProtocolClient err msg -> THandle c -> IO ()
-    send ProtocolClient {client_ = PClient {sndQ}} h = forever $ atomically (readTBQueue sndQ) >>= tPut h
+    send ProtocolClient {client_ = PClient {sndQ}} h = forever $ atomically (readTBQueue sndQ) >>= tPut h batchDelay

    receive :: Transport c => ProtocolClient err msg -> THandle c -> IO ()
    receive ProtocolClient {client_ = PClient {rcvQ}} h = forever $ tGet h >>= atomically . writeTBQueue rcvQ
@@ -490,13 +504,7 @@ subscribeSMPQueueNotifications = okSMPCommand NSUB

 -- | Subscribe to multiple SMP queues notifications batching commands if supported.
 subscribeSMPQueuesNtfs :: SMPClient -> NonEmpty (NtfPrivateSignKey, NotifierId) -> IO (NonEmpty (Either SMPClientError ()))
-subscribeSMPQueuesNtfs c qs = sendProtocolCommands c cs >>= mapM response
-  where
-    cs = L.map (\(npKey, nId) -> (Just npKey, nId, Cmd SNotifier NSUB)) qs
-    response r = pure $ case r of
-      Right OK -> Right ()
-      Right r' -> Left . PCEUnexpectedResponse $ bshow r'
-      Left e -> Left e
+subscribeSMPQueuesNtfs = okSMPCommands NSUB

 -- | Secure the SMP queue by adding a sender public key.
 --
@@ -589,32 +597,61 @@ okSMPCommands cmd c qs = L.map response <$> sendProtocolCommands c cs
 sendSMPCommand :: PartyI p => SMPClient -> Maybe C.APrivateSignKey -> QueueId -> Command p -> ExceptT SMPClientError IO BrokerMsg
 sendSMPCommand c pKey qId cmd = sendProtocolCommand c pKey qId (Cmd sParty cmd)

+type PCTransmission err msg = (SentRawTransmission, TMVar (Response err msg))
+
 -- | Send multiple commands with batching and collect responses
+-- It will result in Int overflow on 32 bit platform for a large number of blocks (~13.4k blocks / ~1.2m subscriptions)
+-- TODO switch to timeout or TimeManager that supports Int64
 sendProtocolCommands :: forall err msg. ProtocolEncoding err (ProtoCommand msg) => ProtocolClient err msg -> NonEmpty (ClientCommand msg) -> IO (NonEmpty (Either (ProtocolClientError err) msg))
-sendProtocolCommands c@ProtocolClient {client_ = PClient {sndQ}} cs = do
-  ts <- mapM (runExceptT . mkTransmission c) cs
-  mapM_ (atomically . writeTBQueue sndQ . L.map fst) . L.nonEmpty . rights $ L.toList ts
-  forConcurrently ts $ \case
-    Right (_, r) -> withTimeout c $ atomically $ takeTMVar r
+sendProtocolCommands c@ProtocolClient {client_ = PClient {sndQ, tcpTimeout, batchDelay}, batch, blockSize, timeoutPerBlock} cs = do
+  (h :| ts) <- mapM (runExceptT . mkTransmission c) cs
+  let h' :: Either (ProtocolClientError err) (PCTransmission err msg, Int) = (,timeoutPerBlock) <$> h
+      batchSz = if batch then either (const 0) tSize h else 0
+      ts' :: NonEmpty (Either (ProtocolClientError err) (PCTransmission err msg, Int)) =
+        L.reverse . fst3 $ foldl' batchTimeouts ([h'], timeoutPerBlock, batchSz) ts
+      ts_ :: (Maybe (NonEmpty SentRawTransmission)) =
+        L.nonEmpty . map (fst . fst) . rights $ L.toList ts'
+  mapM_ (atomically . writeTBQueue sndQ) ts_
+  forConcurrently ts' $ \case
+    Right ((_t, r), bt) -> withTimeout c (tcpTimeout + bt) (atomically $ takeTMVar r)
    Left e -> pure $ Left e
+  where
+    fst3 (x, _, _) = x
+    -- tSize calculation matches the batching logic in tPut that does actual breaking of transmissions into blocks
+    tSize :: PCTransmission err msg -> Int
+    tSize ((sig, t), _) = maybe 0 C.signatureSize sig + B.length t + 3 -- 1 byte for signature size + 2 bytes for transmission size
+    batchTimeouts :: (NonEmpty (Either (ProtocolClientError err) (PCTransmission err msg, Int)), Int, Int) -> Either (ProtocolClientError err) (PCTransmission err msg) -> (NonEmpty (Either (ProtocolClientError err) (PCTransmission err msg, Int)), Int, Int)
+    batchTimeouts (ts, bt, batchSz) = \case
+      Left e -> (Left e <| ts, bt, batchSz)
+      Right t
+        | not batch ->
+          (Right (t, bt') <| ts, bt', 0)
+        | batchSz' + 1 > blockSize ->
+          (Right (t, bt') <| ts, bt', tSz)
+        | otherwise -> -- same block in the batch
+          (Right (t, bt) <| ts, bt, batchSz') -- 1 byte for the number of transmissions in the batch
+        where
+          batchSz' = batchSz + tSz
+          bt' = bt + timeoutPerBlock + fromMaybe 0 batchDelay
+          tSz = tSize t

 -- | Send Protocol command
 sendProtocolCommand :: forall err msg. ProtocolEncoding err (ProtoCommand msg) => ProtocolClient err msg -> Maybe C.APrivateSignKey -> QueueId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg
-sendProtocolCommand c@ProtocolClient {client_ = PClient {sndQ}} pKey qId cmd = do
+sendProtocolCommand c@ProtocolClient {client_ = PClient {sndQ, tcpTimeout}} pKey qId cmd = do
  (t, r) <- mkTransmission c (pKey, qId, cmd)
  ExceptT $ sendRecv t r
  where
    -- two separate "atomically" needed to avoid blocking
    sendRecv :: SentRawTransmission -> TMVar (Response err msg) -> IO (Response err msg)
-    sendRecv t r = atomically (writeTBQueue sndQ [t]) >> withTimeout c (atomically $ takeTMVar r)
+    sendRecv t r = atomically (writeTBQueue sndQ [t]) >> withTimeout c tcpTimeout (atomically $ takeTMVar r)

-withTimeout :: ProtocolClient err msg -> IO (Either (ProtocolClientError err) msg) -> IO (Either (ProtocolClientError err) msg)
-withTimeout ProtocolClient {client_ = PClient {tcpTimeout, pingErrorCount}} a =
-  timeout tcpTimeout a >>= \case
+withTimeout :: ProtocolClient err msg -> Int -> IO (Either (ProtocolClientError err) msg) -> IO (Either (ProtocolClientError err) msg)
+withTimeout ProtocolClient {client_ = PClient {pingErrorCount}} t a = do
+  timeout t a >>= \case
    Just r -> atomically (writeTVar pingErrorCount 0) >> pure r
    _ -> pure $ Left PCEResponseTimeout

-mkTransmission :: forall err msg. ProtocolEncoding err (ProtoCommand msg) => ProtocolClient err msg -> ClientCommand msg -> ExceptT (ProtocolClientError err) IO (SentRawTransmission, TMVar (Response err msg))
+mkTransmission :: forall err msg. ProtocolEncoding err (ProtoCommand msg) => ProtocolClient err msg -> ClientCommand msg -> ExceptT (ProtocolClientError err) IO (PCTransmission err msg)
 mkTransmission ProtocolClient {sessionId, thVersion, client_ = PClient {clientCorrId, sentCommands}} (pKey, qId, cmd) = do
  corrId <- liftIO $ atomically getNextCorrId
  let t = signTransmission $ encodeTransmission thVersion sessionId (corrId, qId, cmd)
@@ -17,14 +17,16 @@ import Control.Logger.Simple
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except
-import Data.Bifunctor (first)
+import Data.Bifunctor (first, bimap)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.List (find, partition)
+import Data.Either (partitionEithers)
+import Data.List (partition)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import Data.Maybe (listToMaybe)
 import Data.Set (Set)
 import Data.Text.Encoding
 import Data.Tuple (swap)
@@ -37,13 +39,12 @@ import Simplex.Messaging.Protocol (BrokerMsg, ProtocolServer (..), QueueId, SMPS
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Util (catchAll_, tryE, ($>>=))
+import Simplex.Messaging.Util (catchAll_, tryE, ($>>=), toChunks)
 import System.Timeout (timeout)
 import UnliftIO (async)
 import UnliftIO.Exception (Exception)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
-import Data.Either (isLeft)

 type SMPClientVar = TMVar (Either SMPClientError SMPClient)

@@ -51,8 +52,8 @@ data SMPClientAgentEvent
  = CAConnected SMPServer
  | CADisconnected SMPServer (Set SMPSub)
  | CAReconnected SMPServer
-  | CAResubscribed SMPServer SMPSub
-  | CASubError SMPServer SMPSub SMPClientError
+  | CAResubscribed SMPServer (NonEmpty SMPSub)
+  | CASubError SMPServer (NonEmpty (SMPSub, SMPClientError))

 data SMPSubParty = SPRecipient | SPNotifier
  deriving (Eq, Ord, Show)
@@ -65,7 +66,8 @@ data SMPClientAgentConfig = SMPClientAgentConfig
  { smpCfg :: ProtocolClientConfig,
    reconnectInterval :: RetryInterval,
    msgQSize :: Natural,
-    agentQSize :: Natural
+    agentQSize :: Natural,
+    agentSubsBatchSize :: Int
  }

 defaultSMPClientAgentConfig :: SMPClientAgentConfig
@@ -78,8 +80,9 @@ defaultSMPClientAgentConfig =
            increaseAfter = 10 * second,
            maxInterval = 10 * second
          },
-      msgQSize = 64,
-      agentQSize = 64
+      msgQSize = 256,
+      agentQSize = 256,
+      agentSubsBatchSize = 900
    }
  where
    second = 1000000
@@ -208,45 +211,35 @@ getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, msgQ} srv =
    reconnectClient :: ExceptT SMPClientError IO ()
    reconnectClient = do
      withSMP ca srv $ \smp -> do
-        liftIO . notify $ CAReconnected srv
+        liftIO $ notify $ CAReconnected srv
        cs_ <- atomically $ mapM readTVar =<< TM.lookup srv (pendingSrvSubs ca)
        forM_ cs_ $ \cs -> do
          subs' <- filterM (fmap not . atomically . hasSub (srvSubs ca) srv . fst) $ M.assocs cs
          let (nSubs, rSubs) = partition (isNotifier . fst . fst) subs'
-          nRs <- liftIO $ subscribe_ smp SPNotifier nSubs
-          rRs <- liftIO $ subscribe_ smp SPRecipient rSubs
-          case find isLeft $ nRs <> rRs of
-            Just (Left e) -> throwE e
-            _ -> pure ()
+          subscribe_ smp SPNotifier nSubs
+          subscribe_ smp SPRecipient rSubs
      where
        isNotifier = \case
          SPNotifier -> True
          SPRecipient -> False

-        subscribe_ :: SMPClient -> SMPSubParty -> [(SMPSub, C.APrivateSignKey)] -> IO [Either SMPClientError ()]
-        subscribe_ smp party subs =
-          case L.nonEmpty subs of
-            Just subs' -> do
-              let subs'' = L.map (first snd) subs'
-              rs <- L.zip subs'' <$> smpSubscribeQueues party ca smp srv subs''
-              rs' <- forM rs $ \(sub, r) -> do
-                let sub' = first (party,) sub
-                    s = fst sub'
-                case snd r of
-                  Right () -> do
-                    atomically $ addSubscription ca srv sub'
-                    notify $ CAResubscribed srv s
-                    pure $ Right ()
-                  Left e -> do
-                    case e of
-                      PCEResponseTimeout -> pure $ Left e
-                      PCENetworkError -> pure $ Left e
-                      _ -> do
-                        notify $ CASubError srv s e
-                        atomically $ removePendingSubscription ca srv s
-                        pure $ Right ()
-              pure $ L.toList rs'
-            Nothing -> pure []
+        subscribe_ :: SMPClient -> SMPSubParty -> [(SMPSub, C.APrivateSignKey)] -> ExceptT SMPClientError IO ()
+        subscribe_ smp party = mapM_ subscribeBatch . toChunks (agentSubsBatchSize agentCfg)
+          where
+            subscribeBatch subs' = do
+              let subs'' :: (NonEmpty (QueueId, C.APrivateSignKey)) = L.map (first snd) subs'
+              rs <- liftIO $ smpSubscribeQueues party ca smp srv subs''
+              let rs' :: (NonEmpty ((SMPSub, C.APrivateSignKey), Either SMPClientError ())) =
+                    L.zipWith (first . const) subs' rs
+                  rs'' :: [Either (SMPSub, SMPClientError) (SMPSub, C.APrivateSignKey)] =
+                    map (\(sub, r) -> bimap (fst sub,) (const sub) r) $ L.toList rs'
+                  (errs, oks) = partitionEithers rs''
+                  (tempErrs, finalErrs) = partition (temporaryClientError . snd) errs
+              mapM_ (atomically . addSubscription ca srv) oks
+              mapM_ (liftIO . notify . CAResubscribed srv) $ L.nonEmpty $ map fst oks
+              mapM_ (atomically . removePendingSubscription ca srv . fst) finalErrs 
+              mapM_ (liftIO . notify . CASubError srv) $ L.nonEmpty finalErrs
+              mapM_ (throwE . snd) $ listToMaybe tempErrs

    notify :: SMPClientAgentEvent -> IO ()
    notify evt = atomically $ writeTBQueue (agentQ ca) evt
@@ -680,6 +680,9 @@ instance SignatureSize (Signature a) where
    SignatureEd25519 _ -> Ed25519.signatureSize
    SignatureEd448 _ -> Ed448.signatureSize

+instance SignatureSize ASignature where
+  signatureSize (ASignature _ s) = signatureSize s
+
 instance SignatureSize APrivateSignKey where
  signatureSize (APrivateSignKey _ k) = signatureSize k

@@ -429,7 +429,7 @@ data NtfSubStatus
    NSAuth
  | -- | SMP error other than AUTH
    NSErr ByteString
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)

 ntfShouldSubscribe :: NtfSubStatus -> Bool
 ntfShouldSubscribe = \case
@@ -16,16 +16,17 @@ import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple
 import Control.Monad.Except
 import Control.Monad.Reader
+import Data.Bifunctor (second)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Function (on)
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (intercalate)
+import Data.List (intercalate, sort)
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import Data.Maybe (catMaybes)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
@@ -55,11 +56,10 @@ import System.Exit (exitFailure)
 import System.IO (BufferMode (..), hPutStrLn, hSetBuffering)
 import System.Mem.Weak (deRefWeak)
 import UnliftIO (IOMode (..), async, uninterruptibleCancel, withFile)
-import UnliftIO.Concurrent (forkIO, killThread, mkWeakThreadId, threadDelay)
+import UnliftIO.Concurrent (forkIO, killThread, mkWeakThreadId)
 import UnliftIO.Directory (doesFileExist, renameFile)
 import UnliftIO.Exception
 import UnliftIO.STM
-import Data.Bifunctor (second)

 runNtfServer :: NtfServerConfig -> IO ()
 runNtfServer cfg = do
@@ -72,7 +72,7 @@ runNtfServerBlocking started cfg = runReaderT (ntfServer cfg started) =<< newNtf
 type M a = ReaderT NtfEnv IO a

 ntfServer :: NtfServerConfig -> TMVar Bool -> M ()
-ntfServer cfg@NtfServerConfig {transports, logTLSErrors} started = do
+ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
  restoreServerStats
  s <- asks subscriber
  ps <- asks pushServer
@@ -83,7 +83,7 @@ ntfServer cfg@NtfServerConfig {transports, logTLSErrors} started = do
    runServer :: (ServiceName, ATransport) -> M ()
    runServer (tcpPort, ATransport t) = do
      serverParams <- asks tlsServerParams
-      runTransportServer started tcpPort serverParams logTLSErrors (runClient t)
+      runTransportServer started tcpPort serverParams tCfg (runClient t)

    runClient :: Transport c => TProxy c -> c -> M ()
    runClient _ h = do
@@ -147,23 +147,23 @@ ntfServer cfg@NtfServerConfig {transports, logTLSErrors} started = do
 resubscribe :: NtfSubscriber -> Map NtfSubscriptionId NtfSubData -> M ()
 resubscribe NtfSubscriber {newSubQ} subs = do
  subs' <- atomically $ filterM (fmap ntfShouldSubscribe . readTVar . subStatus) $ M.elems subs
-  mapM_ (atomically . writeTBQueue newSubQ . L.map NtfSub) $ L.nonEmpty subs'
-  liftIO $ logInfo "SMP connections resubscribed"
+  atomically . writeTBQueue newSubQ $ map NtfSub subs'
+  liftIO $ logInfo $ "SMP resubscriptions queued (" <> tshow (length subs') <> " subscriptions)"

 ntfSubscriber :: NtfSubscriber -> M ()
 ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAgent {msgQ, agentQ}} = do
  raceAny_ [subscribe, receiveSMP, receiveAgent]
  where
    subscribe :: M ()
-    subscribe = do
-      d <- asks $ resubscribeDelay . config
-      forever $ do
-        subs <- atomically (readTBQueue newSubQ)
-        let ss = L.groupBy ((==) `on` server) subs
-        forM_ ss $ \serverSubs -> do
-          SMPSubscriber {newSubQ = subscriberSubQ} <- getSMPSubscriber $ server $ L.head serverSubs
-          atomically $ writeTQueue subscriberSubQ serverSubs
-          when (length serverSubs > 10) $ threadDelay d
+    subscribe = forever $ do
+      subs <- atomically (readTBQueue newSubQ)
+      let ss = L.groupAllWith server subs
+      batchSize <- asks $ subsBatchSize . config
+      forM_ ss $ \serverSubs -> do
+        let srv = server $ L.head serverSubs
+            batches = toChunks batchSize $ L.toList serverSubs
+        SMPSubscriber {newSubQ = subscriberSubQ} <- getSMPSubscriber srv
+        mapM_ (atomically . writeTQueue subscriberSubQ) batches

    server :: NtfEntityRec 'Subscription -> SMPServer
    server (NtfSub sub) = ntfSubServer sub
@@ -184,21 +184,26 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
      forever $ do
        subs <- atomically (peekTQueue subscriberSubQ)
        let subs' = L.map (\(NtfSub sub) -> sub) subs
+            srv = server $ L.head subs
+        logSubStatus srv "subscribing" $ length subs
        mapM_ (\NtfSubData {smpQueue} -> updateSubStatus smpQueue NSPending) subs'
-        rs <- liftIO $ subscribeQueues (server $ L.head subs) subs'
-        subs_ <- L.nonEmpty <$> foldM process [] rs
+        rs <- liftIO $ subscribeQueues srv subs'
+        (subs'', oks, errs) <- foldM process ([], 0, []) rs
        atomically $ do
          void $ readTQueue subscriberSubQ
-          mapM_ (writeTQueue subscriberSubQ . L.map NtfSub) subs_
+          mapM_ (writeTQueue subscriberSubQ . L.map NtfSub) $ L.nonEmpty subs''
+        logSubStatus srv "retrying" $ length subs''
+        logSubStatus srv "subscribed" oks
+        logSubErrors srv errs
      where
-        process subs (sub@NtfSubData {smpQueue}, r) = case r of
-          Right _ -> updateSubStatus smpQueue NSActive $> subs
-          Left err -> do
-            handleSubError smpQueue err
-            pure $ case err of
-              PCEResponseTimeout -> sub : subs
-              PCENetworkError -> sub : subs
-              _ -> subs
+        process :: ([NtfSubData], Int, [NtfSubStatus]) -> (NtfSubData, Either SMPClientError ()) -> M ([NtfSubData], Int, [NtfSubStatus])
+        process (subs, oks, errs) (sub@NtfSubData {smpQueue}, r) = case r of
+          Right _ -> updateSubStatus smpQueue NSActive $> (subs, oks + 1, errs)
+          Left e -> update <$> handleSubError smpQueue e
+          where
+            update = \case
+              Just err -> (subs, oks, err : errs) -- permanent error, log and don't retry subscription
+              Nothing -> (sub : subs, oks, errs) -- temporary error, retry subscription

    -- | Subscribe to queues. The list of results can have a different order.
    subscribeQueues :: SMPServer -> NonEmpty NtfSubData -> IO (NonEmpty (NtfSubData, Either SMPClientError ()))
@@ -230,37 +235,43 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
        atomically (readTBQueue agentQ) >>= \case
          CAConnected _ -> pure ()
          CADisconnected srv subs -> do
-            logInfo $ "SMP server disconnected " <> showServer' srv <> " (" <> tshow (length subs) <> ") subscriptions"
+            logSubStatus srv "disconnected" $ length subs
            forM_ subs $ \(_, ntfId) -> do
              let smpQueue = SMPQueueNtf srv ntfId
              updateSubStatus smpQueue NSInactive
          CAReconnected srv ->
            logInfo $ "SMP server reconnected " <> showServer' srv
-          CAResubscribed srv sub -> do
-            let ntfId = snd sub
-                smpQueue = SMPQueueNtf srv ntfId
-            updateSubStatus smpQueue NSActive
-          CASubError srv (_, ntfId) err -> do
-            logError $ "SMP subscription error on server " <> showServer' srv <> ": " <> tshow err
-            handleSubError (SMPQueueNtf srv ntfId) err
-      where
-        showServer' = decodeLatin1 . strEncode . host
+          CAResubscribed srv subs -> do
+            forM_ subs $ \(_, ntfId) -> updateSubStatus (SMPQueueNtf srv ntfId) NSActive
+            logSubStatus srv "resubscribed" $ length subs
+          CASubError srv errs ->
+            forM errs (\((_, ntfId), err) -> handleSubError (SMPQueueNtf srv ntfId) err)
+              >>= logSubErrors srv . catMaybes . L.toList

-    handleSubError :: SMPQueueNtf -> SMPClientError -> M ()
+    logSubStatus srv event n = when (n > 0) $
+      logInfo $ "SMP server " <> event <> " " <> showServer' srv <> " (" <> tshow n <> " subscriptions)"
+
+    logSubErrors :: SMPServer -> [NtfSubStatus] -> M ()        
+    logSubErrors srv errs = forM_ (L.group $ sort errs) $ \errs' -> do
+      logError $ "SMP subscription errors on server " <> showServer' srv <> ": " <> tshow (L.head errs') <> " (" <> tshow (length errs') <> " errors)"
+
+    showServer' = decodeLatin1 . strEncode . host
+
+    handleSubError :: SMPQueueNtf -> SMPClientError -> M (Maybe NtfSubStatus)
    handleSubError smpQueue = \case
-      PCEProtocolError AUTH -> updateSubStatus smpQueue NSAuth
+      PCEProtocolError AUTH -> updateSubStatus smpQueue NSAuth $> Just NSAuth
      PCEProtocolError e -> updateErr "SMP error " e
-      PCEIOError e -> updateErr "IOError " e
      PCEResponseError e -> updateErr "ResponseError " e
      PCEUnexpectedResponse r -> updateErr "UnexpectedResponse " r
      PCETransportError e -> updateErr "TransportError " e
      PCECryptoError e -> updateErr "CryptoError " e
-      PCEIncompatibleHost -> updateSubStatus smpQueue $ NSErr "IncompatibleHost"
-      PCEResponseTimeout -> pure ()
-      PCENetworkError -> pure ()
+      PCEIncompatibleHost -> let e = NSErr "IncompatibleHost" in updateSubStatus smpQueue e $> Just e
+      PCEResponseTimeout -> pure Nothing
+      PCENetworkError -> pure Nothing
+      PCEIOError _ -> pure Nothing
      where
-        updateErr :: Show e => ByteString -> e -> M ()
-        updateErr errType e = updateSubStatus smpQueue . NSErr $ errType <> bshow e
+        updateErr :: Show e => ByteString -> e -> M (Maybe NtfSubStatus)
+        updateErr errType e = updateSubStatus smpQueue (NSErr $ errType <> bshow e) $> Just (NSErr errType)

    updateSubStatus smpQueue status = do
      st <- asks store
@@ -354,7 +365,7 @@ receive th NtfServerClient {rcvQ, sndQ, activeAt} = forever $ do
 send :: Transport c => THandle c -> NtfServerClient -> IO ()
 send h@THandle {thVersion = v} NtfServerClient {sndQ, sessionId, activeAt} = forever $ do
  t <- atomically $ readTBQueue sndQ
-  void . liftIO $ tPut h [(Nothing, encodeTransmission v sessionId t)]
+  void . liftIO $ tPut h Nothing [(Nothing, encodeTransmission v sessionId t)]
  atomically . writeTVar activeAt =<< liftIO getSystemTime

 -- instance Show a => Show (TVar a) where
@@ -32,7 +32,7 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport)
-import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams)
+import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams, TransportServerConfig)
 import System.IO (IOMode (..))
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
@@ -46,9 +46,9 @@ data NtfServerConfig = NtfServerConfig
    pushQSize :: Natural,
    smpAgentCfg :: SMPClientAgentConfig,
    apnsConfig :: APNSPushClientConfig,
+    subsBatchSize :: Int,
    inactiveClientExpiration :: Maybe ExpirationConfig,
    storeLogFile :: Maybe FilePath,
-    resubscribeDelay :: Int, -- microseconds
    -- CA certificate private key is not needed for initialization
    caCertificateFile :: FilePath,
    privateKeyFile :: FilePath,
@@ -58,7 +58,7 @@ data NtfServerConfig = NtfServerConfig
    logStatsStartTime :: Int64,
    serverStatsLogFile :: FilePath,
    serverStatsBackupFile :: Maybe FilePath,
-    logTLSErrors :: Bool
+    transportConfig :: TransportServerConfig
  }

 defaultInactiveClientExpiration :: ExpirationConfig
@@ -94,7 +94,7 @@ newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsCo

 data NtfSubscriber = NtfSubscriber
  { smpSubscribers :: TMap SMPServer SMPSubscriber,
-    newSubQ :: TBQueue (NonEmpty (NtfEntityRec 'Subscription)),
+    newSubQ :: TBQueue [NtfEntityRec 'Subscription],
    smpAgent :: SMPClientAgent
  }

@@ -14,7 +14,8 @@ import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import Network.Socket (HostName)
 import Options.Applicative
-import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig)
+import Simplex.Messaging.Client (ProtocolClientConfig (..))
+import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Server (runNtfServer)
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
@@ -22,13 +23,17 @@ import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientCo
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)

 ntfServerVersion :: String
-ntfServerVersion = "1.4.1"
+ntfServerVersion = "1.5.1"
+
+defaultSMPBatchDelay :: Int
+defaultSMPBatchDelay = 10000

 ntfServerCLI :: FilePath -> FilePath -> IO ()
 ntfServerCLI cfgPath logPath =
@@ -80,7 +85,9 @@ ntfServerCLI cfgPath logPath =
            <> ("host: " <> host <> "\n")
            <> ("port: " <> defaultServerPort <> "\n")
            <> "log_tls_errors: off\n\
-               \websockets: off\n"
+               \# delay between command batches sent to SMP relays (microseconds), 0 to disable\n"
+            <> ("smp_batch_delay: " <> show defaultSMPBatchDelay <> "\n")
+            <> "websockets: off\n"
    runServer ini = do
      hSetBuffering stdout LineBuffering
      hSetBuffering stderr LineBuffering
@@ -96,19 +103,21 @@ ntfServerCLI cfgPath logPath =
        enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
        logStats = settingIsOn "STORE_LOG" "log_stats" ini
        c = combine cfgPath . ($ defaultX509Config)
+        smpBatchDelay = readIniDefault defaultSMPBatchDelay "TRANSPORT" "smp_batch_delay" ini
+        batchDelay = if smpBatchDelay <= 0 then Nothing else Just smpBatchDelay
        serverConfig =
          NtfServerConfig
            { transports = iniTransports ini,
              subIdBytes = 24,
              regCodeBytes = 32,
-              clientQSize = 16,
-              subQSize = 64,
-              pushQSize = 128,
-              smpAgentCfg = defaultSMPClientAgentConfig,
+              clientQSize = 64,
+              subQSize = 512,
+              pushQSize = 1048,
+              smpAgentCfg = defaultSMPClientAgentConfig {smpCfg = (smpCfg defaultSMPClientAgentConfig) {batchDelay}},
              apnsConfig = defaultAPNSPushClientConfig,
+              subsBatchSize = 900,
              inactiveClientExpiration = Nothing,
              storeLogFile = enableStoreLog $> storeLogFilePath,
-              resubscribeDelay = 50000, -- 50ms
              caCertificateFile = c caCrtFile,
              privateKeyFile = c serverKeyFile,
              certificateFile = c serverCrtFile,
@@ -116,7 +125,10 @@ ntfServerCLI cfgPath logPath =
              logStatsStartTime = 0, -- seconds from 00:00 UTC
              serverStatsLogFile = combine logPath "ntf-server-stats.daily.log",
              serverStatsBackupFile = logStats $> combine logPath "ntf-server-stats.log",
-              logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
+              transportConfig =
+                defaultTransportServerConfig
+                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
+                  }
            }

 data CliCommand
@@ -146,6 +146,7 @@ module Simplex.Messaging.Protocol
 where

 import Control.Applicative (optional, (<|>))
+import Control.Concurrent (threadDelay)
 import Control.Monad.Except
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as J
@@ -1244,8 +1245,8 @@ instance Encoding CommandError where
      _ -> fail "bad command error type"

 -- | Send signed SMP transmission to TCP transport.
-tPut :: Transport c => THandle c -> NonEmpty SentRawTransmission -> IO [Either TransportError ()]
-tPut th trs
+tPut :: Transport c => THandle c -> Maybe Int -> NonEmpty SentRawTransmission -> IO [Either TransportError ()]
+tPut th delay_ trs 
  | batch th = tPutBatch [] $ L.map tEncode trs
  | otherwise = forM (L.toList trs) $ tPutLog . tEncode
  where
@@ -1255,7 +1256,7 @@ tPut th trs
      r <- if n == 0 then largeMsg else replicate n <$> tPutLog (tEncodeBatch n s)
      let rs' = rs <> r
      case ts_ of
-        Just ts' -> tPutBatch rs' ts'
+        Just ts' -> mapM_ threadDelay delay_ >> tPutBatch rs' ts'
        _ -> pure rs'
    largeMsg = putStrLn "tPut error: large message" >> pure [Left TELargeMsg]
    tPutLog s = do
@@ -103,7 +103,7 @@ runSMPServerBlocking started cfg = newEnv cfg >>= runReaderT (smpServer started
 type M a = ReaderT Env IO a

 smpServer :: TMVar Bool -> ServerConfig -> M ()
-smpServer started cfg@ServerConfig {transports, logTLSErrors} = do
+smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
  s <- asks server
  restoreServerMessages
  restoreServerStats
@@ -117,7 +117,7 @@ smpServer started cfg@ServerConfig {transports, logTLSErrors} = do
    runServer :: (ServiceName, ATransport) -> M ()
    runServer (tcpPort, ATransport t) = do
      serverParams <- asks tlsServerParams
-      runTransportServer started tcpPort serverParams logTLSErrors (runClient t)
+      runTransportServer started tcpPort serverParams tCfg (runClient t)

    serverThread ::
      forall s.
@@ -281,12 +281,13 @@ receive th Client {rcvQ, sndQ, activeAt} = forever $ do
 send :: Transport c => THandle c -> Client -> IO ()
 send h@THandle {thVersion = v} Client {sndQ, sessionId, activeAt} = forever $ do
  ts <- atomically $ L.sortWith tOrder <$> readTBQueue sndQ
-  void . liftIO . tPut h $ L.map ((Nothing,) . encodeTransmission v sessionId) ts
+  void . liftIO . tPut h Nothing $ L.map ((Nothing,) . encodeTransmission v sessionId) ts
  atomically . writeTVar activeAt =<< liftIO getSystemTime
  where
    tOrder :: Transmission BrokerMsg -> Int
    tOrder (_, _, cmd) = case cmd of
      MSG {} -> 0
+      NMSG {} -> 0
      _ -> 1

 disconnectTransport :: Transport c => THandle c -> client -> (client -> TVar SystemTime) -> ExpirationConfig -> IO ()
@@ -30,7 +30,7 @@ import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport)
-import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams)
+import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams, TransportServerConfig)
 import Simplex.Messaging.Version
 import System.IO (IOMode (..))
 import System.Mem.Weak (Weak)
@@ -69,7 +69,8 @@ data ServerConfig = ServerConfig
    certificateFile :: FilePath,
    -- | SMP client-server protocol version range
    smpServerVRange :: VersionRange,
-    logTLSErrors :: Bool
+    -- | TCP transport config
+    transportConfig :: TransportServerConfig
  }

 defMsgExpirationDays :: Int64
@@ -28,6 +28,7 @@ import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defaultInactiveClien
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (simplexMQVersion, supportedSMPServerVRange)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
 import Simplex.Messaging.Util (safeDecodeUtf8)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
@@ -164,7 +165,7 @@ smpServerCLI cfgPath logPath =
        serverConfig =
          ServerConfig
            { transports = iniTransports ini,
-              tbqSize = 32,
+              tbqSize = 64,
              serverTbqSize = 1024,
              msgQueueQuota = 128,
              queueIdBytes = 24,
@@ -198,7 +199,10 @@ smpServerCLI cfgPath logPath =
              serverStatsLogFile = combine logPath "smp-server-stats.daily.log",
              serverStatsBackupFile = logStats $> combine logPath "smp-server-stats.log",
              smpServerVRange = supportedSMPServerVRange,
-              logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
+              transportConfig =
+                defaultTransportServerConfig
+                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
+                  }
            }

 data CliCommand
@@ -29,6 +29,7 @@ module Simplex.Messaging.Transport
    supportedSMPServerVRange,
    simplexMQVersion,
    smpBlockSize,
+    TransportConfig (..),

    -- * Transport connection class
    Transport (..),
@@ -104,6 +105,11 @@ simplexMQVersion = showVersion SMQ.version

 -- * Transport connection class

+data TransportConfig = TransportConfig
+  { logTLSErrors :: Bool,
+    transportTimeout :: Maybe Int
+  }
+
 class Transport c where
  transport :: ATransport
  transport = ATransport (TProxy @c)
@@ -112,11 +118,13 @@ class Transport c where

  transportPeer :: c -> TransportPeer

+  transportConfig :: c -> TransportConfig
+
  -- | Upgrade server TLS context to connection (used in the server)
-  getServerConnection :: T.Context -> IO c
+  getServerConnection :: TransportConfig -> T.Context -> IO c

  -- | Upgrade client TLS context to connection (used in the client)
-  getClientConnection :: T.Context -> IO c
+  getClientConnection :: TransportConfig -> T.Context -> IO c

  -- | tls-unique channel binding per RFC5929
  tlsUnique :: c -> SessionId
@@ -150,24 +158,25 @@ data TLS = TLS
  { tlsContext :: T.Context,
    tlsPeer :: TransportPeer,
    tlsUniq :: ByteString,
-    tlsBuffer :: TBuffer
+    tlsBuffer :: TBuffer,
+    tlsTransportConfig :: TransportConfig
  }

-connectTLS :: T.TLSParams p => Maybe HostName -> Bool -> p -> Socket -> IO T.Context
-connectTLS host_ logErrors params sock =
+connectTLS :: T.TLSParams p => Maybe HostName -> TransportConfig -> p -> Socket -> IO T.Context
+connectTLS host_ TransportConfig {logTLSErrors} params sock =
  E.bracketOnError (T.contextNew sock params) closeTLS $ \ctx ->
    logHandshakeErrors (T.handshake ctx) $> ctx
  where
-    logHandshakeErrors = if logErrors then (`catchAll` logThrow) else id
+    logHandshakeErrors = if logTLSErrors then (`catchAll` logThrow) else id
    logThrow e = putStrLn ("TLS error" <> host <> ": " <> show e) >> E.throwIO e
    host = maybe "" (\h -> " (" <> h <> ")") host_

-getTLS :: TransportPeer -> T.Context -> IO TLS
-getTLS tlsPeer cxt = withTlsUnique tlsPeer cxt newTLS
+getTLS :: TransportPeer -> TransportConfig -> T.Context -> IO TLS
+getTLS tlsPeer cfg cxt = withTlsUnique tlsPeer cxt newTLS
  where
    newTLS tlsUniq = do
      tlsBuffer <- atomically newTBuffer
-      pure TLS {tlsContext = cxt, tlsPeer, tlsUniq, tlsBuffer}
+      pure TLS {tlsContext = cxt, tlsTransportConfig = cfg, tlsPeer, tlsUniq, tlsBuffer}

 withTlsUnique :: TransportPeer -> T.Context -> (ByteString -> IO c) -> IO c
 withTlsUnique peer cxt f =
@@ -199,6 +208,7 @@ supportedParameters =
 instance Transport TLS where
  transportName _ = "TLS"
  transportPeer = tlsPeer
+  transportConfig = tlsTransportConfig
  getServerConnection = getTLS TServer
  getClientConnection = getTLS TClient
  tlsUnique = tlsUniq
@@ -207,10 +217,12 @@ instance Transport TLS where
  -- https://hackage.haskell.org/package/tls-1.6.0/docs/Network-TLS.html#v:recvData
  -- this function may return less than requested number of bytes
  cGet :: TLS -> Int -> IO ByteString
-  cGet TLS {tlsContext, tlsBuffer} n = getBuffered tlsBuffer n (T.recvData tlsContext)
-
+  cGet TLS {tlsContext, tlsBuffer, tlsTransportConfig = TransportConfig {transportTimeout = t_}} n =
+    getBuffered tlsBuffer n t_ (T.recvData tlsContext)
+      
  cPut :: TLS -> ByteString -> IO ()
-  cPut tls = T.sendData (tlsContext tls) . BL.fromStrict
+  cPut TLS {tlsContext, tlsTransportConfig = TransportConfig {transportTimeout = t_}} s =
+    withTimedErr t_ . T.sendData tlsContext $ BL.fromStrict s

  getLn :: TLS -> IO ByteString
  getLn TLS {tlsContext, tlsBuffer} = do
@@ -8,6 +8,8 @@ import Control.Concurrent.STM
 import qualified Control.Exception as E
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import System.Timeout (timeout)
+import GHC.IO.Exception (ioException, IOException (..), IOErrorType (..))

 data TBuffer = TBuffer
  { buffer :: TVar ByteString,
@@ -26,22 +28,33 @@ withBufferLock TBuffer {getLock} =
    (atomically $ takeTMVar getLock)
    (atomically $ putTMVar getLock ())

-getBuffered :: TBuffer -> Int -> IO ByteString -> IO ByteString
-getBuffered tb@TBuffer {buffer} n getChunk = withBufferLock tb $ do
-  b <- readChunks =<< readTVarIO buffer
+getBuffered :: TBuffer -> Int -> Maybe Int -> IO ByteString -> IO ByteString
+getBuffered tb@TBuffer {buffer} n t_ getChunk = withBufferLock tb $ do
+  b <- readChunks True =<< readTVarIO buffer
  let (s, b') = B.splitAt n b
  atomically $ writeTVar buffer $! b'
  -- This would prevent the need to pad auth tag in HTTP2
  -- threadDelay 150
  pure s
  where
-    readChunks :: ByteString -> IO ByteString
-    readChunks b
+    readChunks :: Bool -> ByteString -> IO ByteString
+    readChunks firstChunk b
      | B.length b >= n = pure b
      | otherwise =
-        getChunk >>= \case
+        get >>= \case
          "" -> pure b
-          s -> readChunks $ b <> s
+          s -> readChunks False $ b <> s
+      where
+        get
+          | firstChunk = getChunk
+          | otherwise = withTimedErr t_ getChunk
+
+withTimedErr :: Maybe Int -> IO a -> IO a
+withTimedErr t_ a = case t_ of
+  Just t -> timeout t a >>= maybe err pure
+  Nothing -> a
+  where
+    err = ioException (IOError Nothing TimeExpired "" "get timeout" Nothing Nothing)

 -- This function is only used in test and needs to be improved before it can be used in production,
 -- it will never complete if TLS connection is closed before there is newline.
@@ -1,3 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -114,12 +115,16 @@ data TransportClientConfig = TransportClientConfig
 defaultTransportClientConfig :: TransportClientConfig
 defaultTransportClientConfig = TransportClientConfig Nothing (Just defaultKeepAliveOpts) True

+clientTransportConfig :: TransportClientConfig -> TransportConfig
+clientTransportConfig TransportClientConfig {logTLSErrors} =
+  TransportConfig {logTLSErrors, transportTimeout = Nothing}
+
 -- | Connect to passed TCP host:port and pass handle to the client.
 runTransportClient :: (Transport c, MonadUnliftIO m) => TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> m a) -> m a
 runTransportClient = runTLSTransportClient supportedParameters Nothing

 runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> m a) -> m a
-runTLSTransportClient tlsParams caStore_ TransportClientConfig {socksProxy, tcpKeepAlive, logTLSErrors} proxyUsername host port keyHash client = do
+runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive} proxyUsername host port keyHash client = do
  let hostName = B.unpack $ strEncode host
      clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash
      connectTCP = case socksProxy of
@@ -128,7 +133,8 @@ runTLSTransportClient tlsParams caStore_ TransportClientConfig {socksProxy, tcpK
  c <- liftIO $ do
    sock <- connectTCP port
    mapM_ (setSocketKeepAlive sock) tcpKeepAlive
-    connectTLS (Just hostName) logTLSErrors clientParams sock >>= getClientConnection
+    let tCfg = clientTransportConfig cfg
+    connectTLS (Just hostName) tCfg clientParams sock >>= getClientConnection tCfg
  client c `E.finally` liftIO (closeConnection c)
  where
    hostAddr = \case
@@ -73,7 +73,7 @@ instance HTTP2BodyChunk HS.Request where
 getHTTP2Body :: HTTP2BodyChunk a => a -> Int -> IO HTTP2Body
 getHTTP2Body r n = do
  bodyBuffer <- atomically newTBuffer
-  let getPart n' = getBuffered bodyBuffer n' $ getBodyChunk r
+  let getPart n' = getBuffered bodyBuffer n' Nothing $ getBodyChunk r
  bodyHead <- getPart n
  let bodySize = fromMaybe 0 $ getBodySize r
      -- TODO check bodySize once it is set
@@ -14,7 +14,7 @@ import qualified Network.TLS as T
 import Numeric.Natural (Natural)
 import Simplex.Messaging.Transport (SessionId)
 import Simplex.Messaging.Transport.HTTP2
-import Simplex.Messaging.Transport.Server (loadSupportedTLSServerParams, runTransportServer)
+import Simplex.Messaging.Transport.Server (TransportServerConfig (..), loadSupportedTLSServerParams, runTransportServer)

 type HTTP2ServerFunc = SessionId -> Request -> (Response -> IO ()) -> IO ()

@@ -27,7 +27,7 @@ data HTTP2ServerConfig = HTTP2ServerConfig
    caCertificateFile :: FilePath,
    privateKeyFile :: FilePath,
    certificateFile :: FilePath,
-    logTLSErrors :: Bool
+    transportConfig :: TransportServerConfig
  }
  deriving (Show)

@@ -45,12 +45,12 @@ data HTTP2Server = HTTP2Server

 -- This server is for testing only, it processes all requests in a single queue.
 getHTTP2Server :: HTTP2ServerConfig -> IO HTTP2Server
-getHTTP2Server HTTP2ServerConfig {qSize, http2Port, bufferSize, bodyHeadSize, serverSupported, caCertificateFile, certificateFile, privateKeyFile, logTLSErrors} = do
+getHTTP2Server HTTP2ServerConfig {qSize, http2Port, bufferSize, bodyHeadSize, serverSupported, caCertificateFile, certificateFile, privateKeyFile, transportConfig} = do
  tlsServerParams <- loadSupportedTLSServerParams serverSupported caCertificateFile certificateFile privateKeyFile
  started <- newEmptyTMVarIO
  reqQ <- newTBQueueIO qSize
  action <- async $
-    runHTTP2Server started http2Port bufferSize tlsServerParams logTLSErrors $ \sessionId r sendResponse -> do
+    runHTTP2Server started http2Port bufferSize tlsServerParams transportConfig $ \sessionId r sendResponse -> do
      reqBody <- getHTTP2Body r bodyHeadSize
      atomically $ writeTBQueue reqQ HTTP2Request {sessionId, request = r, reqBody, sendResponse}
  void . atomically $ takeTMVar started
@@ -59,8 +59,8 @@ getHTTP2Server HTTP2ServerConfig {qSize, http2Port, bufferSize, bodyHeadSize, se
 closeHTTP2Server :: HTTP2Server -> IO ()
 closeHTTP2Server = uninterruptibleCancel . action

-runHTTP2Server :: TMVar Bool -> ServiceName -> BufferSize -> T.ServerParams -> Bool -> HTTP2ServerFunc -> IO ()
-runHTTP2Server started port bufferSize serverParams logTLSErrors http2Server =
-  runTransportServer started port serverParams logTLSErrors $ withHTTP2 bufferSize run
+runHTTP2Server :: TMVar Bool -> ServiceName -> BufferSize -> T.ServerParams -> TransportServerConfig -> HTTP2ServerFunc -> IO ()
+runHTTP2Server started port bufferSize serverParams transportConfig http2Server =
+  runTransportServer started port serverParams transportConfig $ withHTTP2 bufferSize run
  where
    run cfg sessId = H.run cfg $ \req _aux sendResp -> http2Server sessId req (`sendResp` [])
@@ -7,6 +7,8 @@
 module Simplex.Messaging.Transport.Server
  ( runTransportServer,
    runTCPServer,
+    TransportServerConfig (..),
+    defaultTransportServerConfig,
    loadSupportedTLSServerParams,
    loadTLSServerParams,
    loadFingerprint,
@@ -38,15 +40,33 @@ import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM

+data TransportServerConfig = TransportServerConfig
+  { logTLSErrors :: Bool,
+    transportTimeout :: Int
+  }
+  deriving (Eq, Show)
+
+defaultTransportServerConfig :: TransportServerConfig
+defaultTransportServerConfig = TransportServerConfig
+  { logTLSErrors = True,
+    transportTimeout = 40000000
+  }
+
+serverTransportConfig :: TransportServerConfig -> TransportConfig
+serverTransportConfig TransportServerConfig {logTLSErrors} =
+  -- TransportConfig {logTLSErrors, transportTimeout = Just transportTimeout}
+  TransportConfig {logTLSErrors, transportTimeout = Nothing}
+
 -- | Run transport server (plain TCP or WebSockets) on passed TCP port and signal when server started and stopped via passed TMVar.
 --
 -- All accepted connections are passed to the passed function.
-runTransportServer :: forall c m. (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> T.ServerParams -> Bool -> (c -> m ()) -> m ()
-runTransportServer started port serverParams logTLSErrors server = do
+runTransportServer :: forall c m. (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> T.ServerParams -> TransportServerConfig -> (c -> m ()) -> m ()
+runTransportServer started port serverParams cfg server = do
  u <- askUnliftIO
+  let tCfg = serverTransportConfig cfg
  liftIO . runTCPServer started port $ \conn ->
    E.bracket
-      (connectTLS Nothing logTLSErrors serverParams conn >>= getServerConnection)
+      (connectTLS Nothing tCfg serverParams conn >>= getServerConnection tCfg)
      closeConnection
      (unliftIO u . server)

@@ -17,6 +17,7 @@ import Simplex.Messaging.Transport
    Transport (..),
    TransportError (..),
    TransportPeer (..),
+    TransportConfig (..),
    closeTLS,
    smpBlockSize,
    withTlsUnique,
@@ -27,7 +28,8 @@ data WS = WS
  { wsPeer :: TransportPeer,
    tlsUniq :: ByteString,
    wsStream :: Stream,
-    wsConnection :: Connection
+    wsConnection :: Connection,
+    wsTransportConfig :: TransportConfig
  }

 websocketsOpts :: ConnectionOptions
@@ -45,10 +47,13 @@ instance Transport WS where
  transportPeer :: WS -> TransportPeer
  transportPeer = wsPeer

-  getServerConnection :: T.Context -> IO WS
+  transportConfig :: WS -> TransportConfig
+  transportConfig = wsTransportConfig
+
+  getServerConnection :: TransportConfig -> T.Context -> IO WS
  getServerConnection = getWS TServer

-  getClientConnection :: T.Context -> IO WS
+  getClientConnection :: TransportConfig -> T.Context -> IO WS
  getClientConnection = getWS TClient

  tlsUnique :: WS -> ByteString
@@ -74,13 +79,13 @@ instance Transport WS where
      then E.throwIO TEBadBlock
      else pure $ B.init s

-getWS :: TransportPeer -> T.Context -> IO WS
-getWS wsPeer cxt = withTlsUnique wsPeer cxt connectWS
+getWS :: TransportPeer -> TransportConfig -> T.Context -> IO WS
+getWS wsPeer cfg cxt = withTlsUnique wsPeer cxt connectWS
  where
    connectWS tlsUniq = do
      s <- makeTLSContextStream cxt
      wsConnection <- connectPeer wsPeer s
-      pure $ WS {wsPeer, tlsUniq, wsStream = s, wsConnection}
+      pure $ WS {wsPeer, tlsUniq, wsStream = s, wsConnection, wsTransportConfig = cfg}
    connectPeer :: TransportPeer -> Stream -> IO Connection
    connectPeer TServer = acceptClientRequest
    connectPeer TClient = sendClientRequest
@@ -1,4 +1,3 @@
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}

@@ -13,11 +12,15 @@ import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
+import Data.List (groupBy, sortOn)
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as L
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Time (NominalDiffTime)
 import UnliftIO.Async
+import qualified UnliftIO.Exception as UE

 raceAny_ :: MonadUnliftIO m => [m a] -> m ()
 raceAny_ = r []
@@ -98,10 +101,44 @@ catchAll_ :: IO a -> IO a -> IO a
 catchAll_ a = catchAll a . const
 {-# INLINE catchAll_ #-}

+tryAllErrors :: (MonadUnliftIO m, MonadError e m) => (E.SomeException -> e) -> m a -> m (Either e a)
+tryAllErrors err action = tryError action `UE.catch` (pure . Left . err)
+{-# INLINE tryAllErrors #-}
+
+catchAllErrors :: (MonadUnliftIO m, MonadError e m) => (E.SomeException -> e) -> m a -> (e -> m a) -> m a
+catchAllErrors err action handle = tryAllErrors err action >>= either handle pure
+{-# INLINE catchAllErrors #-}
+
+catchThrow :: (MonadUnliftIO m, MonadError e m) => m a -> (E.SomeException -> e) -> m a
+catchThrow action err  = catchAllErrors err action throwError
+{-# INLINE catchThrow #-}
+
+allFinally :: (MonadUnliftIO m, MonadError e m) => (E.SomeException -> e) -> m a -> m b -> m a
+allFinally err action final = tryAllErrors err action >>= \r -> final >> either throwError pure r
+{-# INLINE allFinally #-}
+
 eitherToMaybe :: Either a b -> Maybe b
 eitherToMaybe = either (const Nothing) Just
 {-# INLINE eitherToMaybe #-}

+groupOn :: Eq k => (a -> k) -> [a] -> [[a]]
+groupOn = groupBy . eqOn
+  -- it is equivalent to groupBy ((==) `on` f),
+  -- but it redefines `on` to avoid duplicate computation for most values.
+  -- source: https://hackage.haskell.org/package/extra-1.7.13/docs/src/Data.List.Extra.html#groupOn
+  -- the on2 in this package is specialized to only use `==` as the function, `eqOn f` is equivalent to `(==) `on` f`
+  where
+    eqOn f = \x -> let fx = f x in \y -> fx == f y
+
+groupAllOn :: Ord k => (a -> k) -> [a] -> [[a]]
+groupAllOn f = groupOn f . sortOn f
+
+toChunks :: Int -> [a] -> [NonEmpty a]
+toChunks _ [] = []
+toChunks n xs =
+  let (ys, xs') = splitAt n xs
+  in maybe id (:) (L.nonEmpty ys) (toChunks n xs')
+
 safeDecodeUtf8 :: ByteString -> Text
 safeDecodeUtf8 = decodeUtf8With onError
  where
@@ -70,8 +70,8 @@ connectionRequest =
  ACR SCMInvitation $
    CRInvitationUri connReqData testE2ERatchetParams

-connectionRequest12 :: AConnectionRequestUri
-connectionRequest12 =
+connectionRequestCurrentRange :: AConnectionRequestUri
+connectionRequestCurrentRange =
  ACR SCMInvitation $
    CRInvitationUri
      connReqData {crAgentVRange = supportedSMPAgentVRange, crSmpQueues = [queueV1, queueV1]}
@@ -113,8 +113,8 @@ connectionRequestTests =
        `shouldBe` "https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
        <> urlEncode True testDhKeyStrUri
        <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
-      strEncode connectionRequest12
-        `shouldBe` "https://simplex.chat/invitation#/?v=1-2&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
+      strEncode connectionRequestCurrentRange
+        `shouldBe` "https://simplex.chat/invitation#/?v=1-3&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
        <> urlEncode True testDhKeyStrUri
        <> "%2Csmp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
        <> urlEncode True testDhKeyStrUri
@@ -158,9 +158,9 @@ connectionRequestTests =
            <> testDhKeyStrUri
            <> "&e2e=extra_key%3Dnew%26v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
            <> "&some_new_param=abc"
-            <> "&v=1-2"
+            <> "&v=1-3"
        )
-        `shouldBe` Right connectionRequest12
+        `shouldBe` Right connectionRequestCurrentRange
      strDecode
        ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
            <> testDhKeyStrUri
@@ -104,17 +104,31 @@ pGet c = do
 pattern Msg :: MsgBody -> ACommand 'Agent e
 pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} _ msgBody

-smpCfgV1 :: ProtocolClientConfig
-smpCfgV1 = (smpCfg agentCfg) {smpServerVRange = vr11}
+smpCfgVPrev :: ProtocolClientConfig
+smpCfgVPrev = (smpCfg agentCfg) {serverVRange = serverVRangePrev}
+  where
+    serverVRangePrev = prevRange $ serverVRange $ smpCfg agentCfg

-agentCfgV1 :: AgentConfig
-agentCfgV1 = agentCfg {smpAgentVRange = vr11, smpClientVRange = vr11, e2eEncryptVRange = vr11, smpCfg = smpCfgV1}
+agentCfgVPrev :: AgentConfig
+agentCfgVPrev =
+  agentCfg
+    { smpAgentVRange = smpAgentVRangePrev,
+      smpClientVRange = smpClientVRangePrev,
+      e2eEncryptVRange = e2eEncryptVRangePrev,
+      smpCfg = smpCfgVPrev
+    }
+  where
+    smpAgentVRangePrev = prevRange $ smpAgentVRange agentCfg
+    smpClientVRangePrev = prevRange $ smpClientVRange agentCfg
+    e2eEncryptVRangePrev = prevRange $ e2eEncryptVRange agentCfg

-agentCfgRatchetV1 :: AgentConfig
-agentCfgRatchetV1 = agentCfg {e2eEncryptVRange = vr11}
+agentCfgRatchetVPrev :: AgentConfig
+agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = e2eEncryptVRangePrev}
+  where
+    e2eEncryptVRangePrev = prevRange $ e2eEncryptVRange agentCfg

-vr11 :: VersionRange
-vr11 = mkVersionRange 1 1
+prevRange :: VersionRange -> VersionRange
+prevRange vr = vr {maxVersion = maxVersion vr - 1}

 runRight_ :: (Eq e, Show e, HasCallStack) => ExceptT e IO () -> Expectation
 runRight_ action = runExceptT action `shouldReturn` Right ()
@@ -125,16 +139,16 @@ runRight action =
    Right x -> pure x
    Left e -> error $ "Unexpected error: " <> show e

-getInAnyOrder :: HasCallStack => AgentClient -> [AEntityTransmission 'AEConn -> Bool] -> Expectation
+getInAnyOrder :: HasCallStack => AgentClient -> [ATransmission 'Agent -> Bool] -> Expectation
 getInAnyOrder _ [] = pure ()
 getInAnyOrder c rs = do
-  r <- get c
+  r <- pGet c
  let rest = filter (not . expected r) rs
  if length rest < length rs
    then getInAnyOrder c rest
    else error $ "unexpected event: " <> show r
  where
-    expected :: AEntityTransmission 'AEConn -> (AEntityTransmission 'AEConn -> Bool) -> Bool
+    expected :: ATransmission 'Agent -> (ATransmission 'Agent -> Bool) -> Bool
    expected r rp = rp r

 functionalAPITests :: ATransport -> Spec
@@ -160,13 +174,33 @@ functionalAPITests t = do
      testAsyncServerOffline t
    it "should notify after HELLO timeout" $
      withSmpServer t testAsyncHelloTimeout
+    it "should restore confirmation after client restart" $
+      testAllowConnectionClientRestart t
  describe "Message delivery" $ do
+    describe "update connection agent version on received messages" $ do
+      it "should increase if compatible, shouldn't decrease" $
+        testIncreaseConnAgentVersion t
+      it "should increase to max compatible version" $
+        testIncreaseConnAgentVersionMaxCompatible t
+      it "should increase when connection was negotiated on different versions" $
+        testIncreaseConnAgentVersionStartDifferentVersion t
+    it "should deliver message after client restart" $
+      testDeliverClientRestart t
    it "should deliver messages to the user once, even if repeat delivery is made by the server (no ACK)" $
      testDuplicateMessage t
    it "should report error via msg integrity on skipped messages" $
      testSkippedMessages t
-    it "should report decryption error on ratchet becoming out of sync" $
-      testDecryptionError t
+    describe "Ratchet synchronization" $ do
+      it "should report ratchet de-synchronization, synchronize ratchets" $
+        testRatchetSync t
+      it "should synchronize ratchets after server being offline" $
+        testRatchetSyncServerOffline t
+      it "should synchronize ratchets after client restart" $
+        testRatchetSyncClientRestart t
+      it "should synchronize ratchets after suspend/foreground" $
+        testRatchetSyncSuspendForeground t
+      it "should synchronize ratchets when clients start synchronization simultaneously" $
+        testRatchetSyncSimultaneous t
  describe "Inactive client disconnection" $ do
    it "should disconnect clients if it was inactive longer than TTL" $
      testInactiveClientDisconnected t
@@ -279,17 +313,17 @@ canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =

 testMatrix2 :: ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2 t runTest = do
-  it "v2" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 runTest
-  it "v1" $ withSmpServer t $ runTestCfg2 agentCfgV1 agentCfgV1 4 runTest
-  it "v1 to v2" $ withSmpServer t $ runTestCfg2 agentCfgV1 agentCfg 4 runTest
-  it "v2 to v1" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgV1 4 runTest
+  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 runTest
+  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 runTest
+  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 runTest
+  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 runTest

 testRatchetMatrix2 :: ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testRatchetMatrix2 t runTest = do
-  it "ratchet v2" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 runTest
-  it "ratchet v1" $ withSmpServer t $ runTestCfg2 agentCfgRatchetV1 agentCfgRatchetV1 3 runTest
-  it "ratchets v1 to v2" $ withSmpServer t $ runTestCfg2 agentCfgRatchetV1 agentCfg 3 runTest
-  it "ratchets v2 to v1" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetV1 3 runTest
+  it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 runTest
+  it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 3 runTest
+  it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 3 runTest
+  it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 3 runTest

 testServerMatrix2 :: ATransport -> (InitialAgentServers -> IO ()) -> Spec
 testServerMatrix2 t runTest = do
@@ -465,6 +499,9 @@ testAsyncServerOffline t = do
 testAsyncHelloTimeout :: HasCallStack => IO ()
 testAsyncHelloTimeout = do
  -- this test would only work if any of the agent is v1, there is no HELLO timeout in v2
+  let vr11 = mkVersionRange 1 1
+      smpCfgV1 = (smpCfg agentCfg) {serverVRange = vr11}
+      agentCfgV1 = agentCfg {smpAgentVRange = vr11, smpClientVRange = vr11, e2eEncryptVRange = vr11, smpCfg = smpCfgV1}
  alice <- getSMPAgentClient' agentCfgV1 initAgentServers testDB
  bob <- getSMPAgentClient' agentCfg {helloTimeout = 1} initAgentServers testDB2
  runRight_ $ do
@@ -473,6 +510,181 @@ testAsyncHelloTimeout = do
    aliceId <- joinConnection bob 1 True cReq "bob's connInfo"
    get bob ##> ("", aliceId, ERR $ CONN NOT_ACCEPTED)

+testAllowConnectionClientRestart :: HasCallStack => ATransport -> IO ()
+testAllowConnectionClientRestart t = do
+  let initAgentServersSrv2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer2]}
+  alice <- getSMPAgentClient' agentCfg initAgentServers testDB
+  bob <- getSMPAgentClient' agentCfg initAgentServersSrv2 testDB2
+  withSmpServerStoreLogOn t testPort $ \_ -> do
+    (aliceId, bobId, confId) <-
+      withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \_ -> do
+        runRight $ do
+          (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing
+          aliceId <- joinConnection bob 1 True qInfo "bob's connInfo"
+          ("", _, CONF confId _ "bob's connInfo") <- get alice
+          pure (aliceId, bobId, confId)
+
+    ("", "", DOWN _ _) <- nGet bob
+
+    runRight_ $ do
+      allowConnectionAsync alice "1" bobId confId "alice's connInfo"
+      ("1", _, OK) <- get alice
+      pure ()
+
+    threadDelay 100000 -- give time to enqueue confirmation (enqueueConfirmation)
+    disconnectAgentClient alice
+
+    alice2 <- getSMPAgentClient' agentCfg initAgentServers testDB
+
+    withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \_ -> do
+      runRight $ do
+        ("", "", UP _ _) <- nGet bob
+
+        subscribeConnection alice2 bobId
+
+        get alice2 ##> ("", bobId, CON)
+        get bob ##> ("", aliceId, INFO "alice's connInfo")
+        get bob ##> ("", aliceId, CON)
+
+        exchangeGreetingsMsgId 4 alice2 bobId bob aliceId
+
+testIncreaseConnAgentVersion :: HasCallStack => ATransport -> IO ()
+testIncreaseConnAgentVersion t = do
+  alice <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB
+  bob <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2
+  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    (aliceId, bobId) <- runRight $ do
+      (aliceId, bobId) <- makeConnection alice bob
+      exchangeGreetingsMsgId 4 alice bobId bob aliceId
+      checkVersion alice bobId 2
+      checkVersion bob aliceId 2
+      pure (aliceId, bobId)
+
+    -- version doesn't increase if incompatible
+
+    disconnectAgentClient alice
+    alice2 <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
+
+    runRight_ $ do
+      subscribeConnection alice2 bobId
+      exchangeGreetingsMsgId 6 alice2 bobId bob aliceId
+      checkVersion alice2 bobId 2
+      checkVersion bob aliceId 2
+
+    -- version increases if compatible
+
+    disconnectAgentClient bob
+    bob2 <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
+
+    runRight_ $ do
+      subscribeConnection bob2 aliceId
+      exchangeGreetingsMsgId 8 alice2 bobId bob2 aliceId
+      checkVersion alice2 bobId 3
+      checkVersion bob2 aliceId 3
+
+    -- version doesn't decrease, even if incompatible
+
+    disconnectAgentClient alice2
+    alice3 <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 2 2} initAgentServers testDB
+
+    runRight_ $ do
+      subscribeConnection alice3 bobId
+      exchangeGreetingsMsgId 10 alice3 bobId bob2 aliceId
+      checkVersion alice3 bobId 3
+      checkVersion bob2 aliceId 3
+
+    disconnectAgentClient bob2
+    bob3 <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 1} initAgentServers testDB2
+
+    runRight_ $ do
+      subscribeConnection bob3 aliceId
+      exchangeGreetingsMsgId 12 alice3 bobId bob3 aliceId
+      checkVersion alice3 bobId 3
+      checkVersion bob3 aliceId 3
+
+checkVersion :: AgentClient -> ConnId -> Version -> ExceptT AgentErrorType IO ()
+checkVersion c connId v = do
+  ConnectionStats {connAgentVersion} <- getConnectionServers c connId
+  liftIO $ connAgentVersion `shouldBe` v
+
+testIncreaseConnAgentVersionMaxCompatible :: HasCallStack => ATransport -> IO ()
+testIncreaseConnAgentVersionMaxCompatible t = do
+  alice <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB
+  bob <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2
+  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    (aliceId, bobId) <- runRight $ do
+      (aliceId, bobId) <- makeConnection alice bob
+      exchangeGreetingsMsgId 4 alice bobId bob aliceId
+      checkVersion alice bobId 2
+      checkVersion bob aliceId 2
+      pure (aliceId, bobId)
+
+    -- version increases to max compatible
+
+    disconnectAgentClient alice
+    alice2 <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
+    disconnectAgentClient bob
+    bob2 <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 4} initAgentServers testDB2
+
+    runRight_ $ do
+      subscribeConnection alice2 bobId
+      subscribeConnection bob2 aliceId
+      exchangeGreetingsMsgId 6 alice2 bobId bob2 aliceId
+      checkVersion alice2 bobId 3
+      checkVersion bob2 aliceId 3
+
+testIncreaseConnAgentVersionStartDifferentVersion :: HasCallStack => ATransport -> IO ()
+testIncreaseConnAgentVersionStartDifferentVersion t = do
+  alice <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB
+  bob <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
+  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    (aliceId, bobId) <- runRight $ do
+      (aliceId, bobId) <- makeConnection alice bob
+      exchangeGreetingsMsgId 4 alice bobId bob aliceId
+      checkVersion alice bobId 2
+      checkVersion bob aliceId 2
+      pure (aliceId, bobId)
+
+    -- version increases to max compatible
+
+    disconnectAgentClient alice
+    alice2 <- getSMPAgentClient' agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
+
+    runRight_ $ do
+      subscribeConnection alice2 bobId
+      exchangeGreetingsMsgId 6 alice2 bobId bob aliceId
+      checkVersion alice2 bobId 3
+      checkVersion bob aliceId 3
+
+testDeliverClientRestart :: HasCallStack => ATransport -> IO ()
+testDeliverClientRestart t = do
+  alice <- getSMPAgentClient' agentCfg initAgentServers testDB
+  bob <- getSMPAgentClient' agentCfg initAgentServers testDB2
+
+  (aliceId, bobId) <- withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    runRight $ do
+      (aliceId, bobId) <- makeConnection alice bob
+      exchangeGreetingsMsgId 4 alice bobId bob aliceId
+      pure (aliceId, bobId)
+
+  ("", "", DOWN _ _) <- nGet alice
+  ("", "", DOWN _ _) <- nGet bob
+
+  6 <- runRight $ sendMessage bob aliceId SMP.noMsgFlags "hello"
+
+  disconnectAgentClient bob
+
+  bob2 <- getSMPAgentClient' agentCfg initAgentServers testDB2
+
+  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    runRight_ $ do
+      ("", "", UP _ _) <- nGet alice
+
+      subscribeConnection bob2 aliceId
+
+      get bob2 ##> ("", aliceId, SENT 6)
+      get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
+
 testDuplicateMessage :: HasCallStack => ATransport -> IO ()
 testDuplicateMessage t = do
  alice <- getSMPAgentClient' agentCfg initAgentServers testDB
@@ -568,53 +780,222 @@ testSkippedMessages t = do
      get bob2 =##> \case ("", c, Msg "hello 6") -> c == aliceId; _ -> False
      ackMessage bob2 aliceId 6

-testDecryptionError :: HasCallStack => ATransport -> IO ()
-testDecryptionError t = do
+testRatchetSync :: HasCallStack => ATransport -> IO ()
+testRatchetSync t = do
  alice <- getSMPAgentClient' agentCfg initAgentServers testDB
  bob <- getSMPAgentClient' agentCfg initAgentServers testDB2
  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
-    (aliceId, bobId) <- runRight $ makeConnection alice bob
+    (aliceId, bobId, bob2) <- setupDesynchronizedRatchet alice bob
+    runRight $ do
+      ConnectionStats {ratchetSyncState} <- synchronizeRatchet bob2 aliceId False
+      liftIO $ ratchetSyncState `shouldBe` RSStarted
+
+      get alice =##> ratchetSyncP bobId RSAgreed
+
+      get bob2 =##> ratchetSyncP aliceId RSAgreed
+
+      get alice =##> ratchetSyncP bobId RSOk
+
+      get bob2 =##> ratchetSyncP aliceId RSOk
+
+      exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9
+
+setupDesynchronizedRatchet :: HasCallStack => AgentClient -> AgentClient -> IO (ConnId, ConnId, AgentClient)
+setupDesynchronizedRatchet alice bob = do
+  (aliceId, bobId) <- runRight $ makeConnection alice bob
+  runRight_ $ do
+    4 <- sendMessage alice bobId SMP.noMsgFlags "hello"
+    get alice ##> ("", bobId, SENT 4)
+    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+    ackMessage bob aliceId 4
+
+    5 <- sendMessage bob aliceId SMP.noMsgFlags "hello 2"
+    get bob ##> ("", aliceId, SENT 5)
+    get alice =##> \case ("", c, Msg "hello 2") -> c == bobId; _ -> False
+    ackMessage alice bobId 5
+
+    liftIO $ copyFile testDB2 (testDB2 <> ".bak")
+
+    6 <- sendMessage alice bobId SMP.noMsgFlags "hello 3"
+    get alice ##> ("", bobId, SENT 6)
+    get bob =##> \case ("", c, Msg "hello 3") -> c == aliceId; _ -> False
+    ackMessage bob aliceId 6
+
+    7 <- sendMessage bob aliceId SMP.noMsgFlags "hello 4"
+    get bob ##> ("", aliceId, SENT 7)
+    get alice =##> \case ("", c, Msg "hello 4") -> c == bobId; _ -> False
+    ackMessage alice bobId 7
+
+  disconnectAgentClient bob
+
+  -- importing database backup after progressing ratchet de-synchronizes ratchet
+  liftIO $ renameFile (testDB2 <> ".bak") testDB2
+
+  bob2 <- getSMPAgentClient' agentCfg initAgentServers testDB2
+
+  runRight_ $ do
+    subscribeConnection bob2 aliceId
+
+    Left Agent.CMD {cmdErr = PROHIBITED} <- runExceptT $ synchronizeRatchet bob2 aliceId False
+
+    8 <- sendMessage alice bobId SMP.noMsgFlags "hello 5"
+    get alice ##> ("", bobId, SENT 8)
+    get bob2 =##> ratchetSyncP aliceId RSRequired
+
+    Left Agent.CMD {cmdErr = PROHIBITED} <- runExceptT $ sendMessage bob2 aliceId SMP.noMsgFlags "hello 6"
+    pure ()
+
+  pure (aliceId, bobId, bob2)
+
+ratchetSyncP :: ConnId -> RatchetSyncState -> AEntityTransmission 'AEConn -> Bool
+ratchetSyncP cId rss = \case
+  (_, cId', RSYNC rss' _ ConnectionStats {ratchetSyncState}) ->
+    cId' == cId && rss' == rss && ratchetSyncState == rss
+  _ -> False
+
+ratchetSyncP' :: ConnId -> RatchetSyncState -> ATransmission 'Agent -> Bool
+ratchetSyncP' cId rss = \case
+  (_, cId', APC SAEConn (RSYNC rss' _ ConnectionStats {ratchetSyncState})) ->
+    cId' == cId && rss' == rss && ratchetSyncState == rss
+  _ -> False
+
+testRatchetSyncServerOffline :: HasCallStack => ATransport -> IO ()
+testRatchetSyncServerOffline t = do
+  alice <- getSMPAgentClient' agentCfg initAgentServers testDB
+  bob <- getSMPAgentClient' agentCfg initAgentServers testDB2
+  (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn t testPort $ \_ ->
+    setupDesynchronizedRatchet alice bob
+
+  ("", "", DOWN _ _) <- nGet alice
+  ("", "", DOWN _ _) <- nGet bob2
+
+  ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId False
+  liftIO $ ratchetSyncState `shouldBe` RSStarted
+
+  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    runRight_ $ do
-      4 <- sendMessage alice bobId SMP.noMsgFlags "hello"
-      get alice ##> ("", bobId, SENT 4)
-      get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
-      ackMessage bob aliceId 4
+      liftIO . getInAnyOrder alice $
+        [ ratchetSyncP' bobId RSAgreed,
+          serverUpP
+        ]

-      5 <- sendMessage bob aliceId SMP.noMsgFlags "hello 2"
-      get bob ##> ("", aliceId, SENT 5)
-      get alice =##> \case ("", c, Msg "hello 2") -> c == bobId; _ -> False
-      ackMessage alice bobId 5
+      liftIO . getInAnyOrder bob2 $
+        [ ratchetSyncP' aliceId RSAgreed,
+          serverUpP
+        ]

-      liftIO $ copyFile testDB2 (testDB2 <> ".bak")
+      get alice =##> ratchetSyncP bobId RSOk

-      6 <- sendMessage alice bobId SMP.noMsgFlags "hello 3"
-      get alice ##> ("", bobId, SENT 6)
-      get bob =##> \case ("", c, Msg "hello 3") -> c == aliceId; _ -> False
-      ackMessage bob aliceId 6
+      get bob2 =##> ratchetSyncP aliceId RSOk

-      7 <- sendMessage bob aliceId SMP.noMsgFlags "hello 4"
-      get bob ##> ("", aliceId, SENT 7)
-      get alice =##> \case ("", c, Msg "hello 4") -> c == bobId; _ -> False
-      ackMessage alice bobId 7
+      exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9

-    disconnectAgentClient bob
+serverUpP :: ATransmission 'Agent -> Bool
+serverUpP = \case
+  ("", "", APC SAENone (UP _ _)) -> True
+  _ -> False

-    -- importing database backup after progressing ratchet de-synchronizes ratchet,
-    -- this will be fixed by ratchet re-negotiation
-    liftIO $ renameFile (testDB2 <> ".bak") testDB2
+testRatchetSyncClientRestart :: HasCallStack => ATransport -> IO ()
+testRatchetSyncClientRestart t = do
+  alice <- getSMPAgentClient' agentCfg initAgentServers testDB
+  bob <- getSMPAgentClient' agentCfg initAgentServers testDB2
+  (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn t testPort $ \_ ->
+    setupDesynchronizedRatchet alice bob

-    bob2 <- getSMPAgentClient' agentCfg initAgentServers testDB2
+  ("", "", DOWN _ _) <- nGet alice
+  ("", "", DOWN _ _) <- nGet bob2

+  ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId False
+  liftIO $ ratchetSyncState `shouldBe` RSStarted
+
+  disconnectAgentClient bob2
+
+  bob3 <- getSMPAgentClient' agentCfg initAgentServers testDB2
+
+  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    runRight_ $ do
-      subscribeConnection bob2 aliceId
+      ("", "", UP _ _) <- nGet alice

-      8 <- sendMessage alice bobId SMP.noMsgFlags "hello 5"
-      get alice ##> ("", bobId, SENT 8)
-      get bob2 =##> \case ("", c, ERR AGENT {agentErr = A_CRYPTO {cryptoErr = RATCHET_HEADER}}) -> c == aliceId; _ -> False
+      subscribeConnection bob3 aliceId

-      6 <- sendMessage bob2 aliceId SMP.noMsgFlags "hello 6"
-      get bob2 ##> ("", aliceId, SENT 6)
-      get alice =##> \case ("", c, ERR AGENT {agentErr = A_CRYPTO {cryptoErr = RATCHET_HEADER}}) -> c == bobId; _ -> False
+      get alice =##> ratchetSyncP bobId RSAgreed
+
+      get bob3 =##> ratchetSyncP aliceId RSAgreed
+
+      get alice =##> ratchetSyncP bobId RSOk
+
+      get bob3 =##> ratchetSyncP aliceId RSOk
+
+      exchangeGreetingsMsgIds alice bobId 12 bob3 aliceId 9
+
+testRatchetSyncSuspendForeground :: HasCallStack => ATransport -> IO ()
+testRatchetSyncSuspendForeground t = do
+  alice <- getSMPAgentClient' agentCfg initAgentServers testDB
+  bob <- getSMPAgentClient' agentCfg initAgentServers testDB2
+  (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn t testPort $ \_ ->
+    setupDesynchronizedRatchet alice bob
+
+  ("", "", DOWN _ _) <- nGet alice
+  ("", "", DOWN _ _) <- nGet bob2
+
+  ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId False
+  liftIO $ ratchetSyncState `shouldBe` RSStarted
+
+  suspendAgent bob2 0
+  threadDelay 100000
+  foregroundAgent bob2
+
+  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    runRight_ $ do
+      liftIO . getInAnyOrder alice $
+        [ ratchetSyncP' bobId RSAgreed,
+          serverUpP
+        ]
+
+      liftIO . getInAnyOrder bob2 $
+        [ ratchetSyncP' aliceId RSAgreed,
+          serverUpP
+        ]
+
+      get alice =##> ratchetSyncP bobId RSOk
+
+      get bob2 =##> ratchetSyncP aliceId RSOk
+
+      exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9
+
+testRatchetSyncSimultaneous :: HasCallStack => ATransport -> IO ()
+testRatchetSyncSimultaneous t = do
+  alice <- getSMPAgentClient' agentCfg initAgentServers testDB
+  bob <- getSMPAgentClient' agentCfg initAgentServers testDB2
+  (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn t testPort $ \_ ->
+    setupDesynchronizedRatchet alice bob
+
+  ("", "", DOWN _ _) <- nGet alice
+  ("", "", DOWN _ _) <- nGet bob2
+
+  ConnectionStats {ratchetSyncState = bRSS} <- runRight $ synchronizeRatchet bob2 aliceId False
+  liftIO $ bRSS `shouldBe` RSStarted
+
+  ConnectionStats {ratchetSyncState = aRSS} <- runRight $ synchronizeRatchet alice bobId True
+  liftIO $ aRSS `shouldBe` RSStarted
+
+  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    runRight_ $ do
+      liftIO . getInAnyOrder alice $
+        [ ratchetSyncP' bobId RSAgreed,
+          serverUpP
+        ]
+
+      liftIO . getInAnyOrder bob2 $
+        [ ratchetSyncP' aliceId RSAgreed,
+          serverUpP
+        ]
+
+      get alice =##> ratchetSyncP bobId RSOk
+
+      get bob2 =##> ratchetSyncP aliceId RSOk
+
+      exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9

 makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
 makeConnection alice bob = makeConnectionForUsers alice 1 bob 1
@@ -1194,20 +1575,20 @@ testAbortSwitchStartedReinitiate servers = do
    withB :: (AgentClient -> IO a) -> IO a
    withB = withAgent agentCfg {initialClientId = 1} servers testDB2

-switchPhaseRcvP :: ConnId -> SwitchPhase -> [Maybe RcvSwitchStatus] -> AEntityTransmission 'AEConn -> Bool
+switchPhaseRcvP :: ConnId -> SwitchPhase -> [Maybe RcvSwitchStatus] -> ATransmission 'Agent -> Bool
 switchPhaseRcvP cId sphase swchStatuses = switchPhaseP cId QDRcv sphase (\stats -> rcvSwchStatuses' stats == swchStatuses)

-switchPhaseSndP :: ConnId -> SwitchPhase -> [Maybe SndSwitchStatus] -> AEntityTransmission 'AEConn -> Bool
+switchPhaseSndP :: ConnId -> SwitchPhase -> [Maybe SndSwitchStatus] -> ATransmission 'Agent -> Bool
 switchPhaseSndP cId sphase swchStatuses = switchPhaseP cId QDSnd sphase (\stats -> sndSwchStatuses' stats == swchStatuses)

-switchPhaseP :: ConnId -> QueueDirection -> SwitchPhase -> (ConnectionStats -> Bool) -> AEntityTransmission 'AEConn -> Bool
+switchPhaseP :: ConnId -> QueueDirection -> SwitchPhase -> (ConnectionStats -> Bool) -> ATransmission 'Agent -> Bool
 switchPhaseP cId qd sphase statsP = \case
-  (_, cId', SWITCH qd' sphase' stats) -> cId' == cId && qd' == qd && sphase' == sphase && statsP stats
+  (_, cId', APC SAEConn (SWITCH qd' sphase' stats)) -> cId' == cId && qd' == qd && sphase' == sphase && statsP stats
  _ -> False

-errQueueNotFoundP :: ConnId -> AEntityTransmission 'AEConn -> Bool
+errQueueNotFoundP :: ConnId -> ATransmission 'Agent -> Bool
 errQueueNotFoundP cId = \case
-  (_, cId', ERR AGENT {agentErr = A_QUEUE {queueErr = "QKEY: queue address not found in connection"}}) -> cId' == cId
+  (_, cId', APC SAEConn (ERR AGENT {agentErr = A_QUEUE {queueErr = "QKEY: queue address not found in connection"}})) -> cId' == cId
  _ -> False

 testCannotAbortSwitchSecured :: HasCallStack => InitialAgentServers -> IO ()
@@ -1256,43 +1637,44 @@ testSwitch2Connections servers = do
    (aId2, bId2) <- makeConnection a b
    exchangeGreetingsMsgId 4 a bId2 b aId2
    pure (aId1, bId1, aId2, bId2)
-  withA $ \a -> runRight_ $ do
-    void $ subscribeConnections a [bId1, bId2]
+  let withA' = sessionSubscribe withA [bId1, bId2]
+      withB' = sessionSubscribe withB [aId1, aId2]
+  withA' $ \a -> do
    stats1 <- switchConnectionAsync a "" bId1
    liftIO $ rcvSwchStatuses' stats1 `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId1 SPStarted [Just RSSendingQADD, Nothing]
    stats2 <- switchConnectionAsync a "" bId2
    liftIO $ rcvSwchStatuses' stats2 `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId2 SPStarted [Just RSSendingQADD, Nothing]
-  withA $ \a -> withB $ \b -> runRight_ $ do
-    void $ subscribeConnections a [bId1, bId2]
-    void $ subscribeConnections b [aId1, aId2]
-
+  withB' $ \b -> do
    liftIO . getInAnyOrder b $
      [ switchPhaseSndP aId1 SPStarted [Just SSSendingQKEY, Nothing],
        switchPhaseSndP aId1 SPConfirmed [Just SSSendingQKEY, Nothing],
        switchPhaseSndP aId2 SPStarted [Just SSSendingQKEY, Nothing],
        switchPhaseSndP aId2 SPConfirmed [Just SSSendingQKEY, Nothing]
      ]
-
+  withA' $ \a -> do
    liftIO . getInAnyOrder a $
      [ switchPhaseRcvP bId1 SPConfirmed [Just RSSendingQADD, Nothing],
        switchPhaseRcvP bId1 SPSecured [Just RSSendingQUSE, Nothing],
        switchPhaseRcvP bId2 SPConfirmed [Just RSSendingQADD, Nothing],
        switchPhaseRcvP bId2 SPSecured [Just RSSendingQUSE, Nothing]
      ]
-
+  withB' $ \b -> do
    liftIO . getInAnyOrder b $
      [ switchPhaseSndP aId1 SPSecured [Just SSSendingQTEST, Nothing],
        switchPhaseSndP aId1 SPCompleted [Nothing],
        switchPhaseSndP aId2 SPSecured [Just SSSendingQTEST, Nothing],
        switchPhaseSndP aId2 SPCompleted [Nothing]
      ]
-
+  withA' $ \a -> do
    liftIO . getInAnyOrder a $
      [ switchPhaseRcvP bId1 SPCompleted [Nothing],
        switchPhaseRcvP bId2 SPCompleted [Nothing]
      ]
+  withA $ \a -> withB $ \b -> runRight_ $ do
+    void $ subscribeConnections a [bId1, bId2]
+    void $ subscribeConnections b [aId1, aId2]

    exchangeGreetingsMsgId 10 a bId1 b aId1
    exchangeGreetingsMsgId 10 a bId2 b aId2
@@ -1381,7 +1763,7 @@ testCreateQueueAuth clnt1 clnt2 = do
  where
    getClient (clntAuth, clntVersion) =
      let servers = initAgentServers {smp = userServers [ProtoServerWithAuth testSMPServer clntAuth]}
-          smpCfg = (defaultClientConfig :: ProtocolClientConfig) {smpServerVRange = mkVersionRange 4 clntVersion}
+          smpCfg = (defaultClientConfig :: ProtocolClientConfig) {serverVRange = mkVersionRange 4 clntVersion}
       in getSMPAgentClient' agentCfg {smpCfg} servers testDB

 testSMPServerConnectionTest :: ATransport -> Maybe BasicAuth -> SMPServerWithAuth -> IO (Maybe ProtocolTestFailure)
@@ -1523,3 +1905,18 @@ exchangeGreetingsMsgId msgId alice bobId bob aliceId = do
  get bob ##> ("", aliceId, SENT msgId')
  get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
  ackMessage alice bobId msgId'
+
+exchangeGreetingsMsgIds :: HasCallStack => AgentClient -> ConnId -> Int64 -> AgentClient -> ConnId -> Int64 -> ExceptT AgentErrorType IO ()
+exchangeGreetingsMsgIds alice bobId aliceMsgId bob aliceId bobMsgId = do
+  msgId1 <- sendMessage alice bobId SMP.noMsgFlags "hello"
+  liftIO $ msgId1 `shouldBe` aliceMsgId
+  get alice ##> ("", bobId, SENT aliceMsgId)
+  get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+  ackMessage bob aliceId bobMsgId
+  msgId2 <- sendMessage bob aliceId SMP.noMsgFlags "hello too"
+  let aliceMsgId' = aliceMsgId + 1
+      bobMsgId' = bobMsgId + 1
+  liftIO $ msgId2 `shouldBe` bobMsgId'
+  get bob ##> ("", aliceId, SENT bobMsgId')
+  get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
+  ackMessage alice bobId aliceMsgId'
@@ -140,7 +140,7 @@ testForeignKeysEnabled =
      `shouldThrow` (\e -> DB.sqlError e == DB.ErrorConstraint)

 cData1 :: ConnData
-cData1 = ConnData {userId = 1, connId = "conn1", connAgentVersion = 1, enableNtfs = True, duplexHandshake = Nothing, deleted = False}
+cData1 = ConnData {userId = 1, connId = "conn1", connAgentVersion = 1, enableNtfs = True, duplexHandshake = Nothing, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk}

 testPrivateSignKey :: C.APrivateSignKey
 testPrivateSignKey = C.APrivateSignKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe"
@@ -50,13 +50,13 @@ testSchemaMigrations = do
      putStrLn $ "down migration " <> name m
      let downMigr = fromJust $ toDownMigration m
      schema <- getSchema testDB testSchema
-      withConnection st (`Migrations.run` MTRUp [m])
+      Migrations.run st $ MTRUp [m]
      schema' <- getSchema testDB testSchema
      schema' `shouldNotBe` schema
-      withConnection st (`Migrations.run` MTRDown [downMigr])
+      Migrations.run st $ MTRDown [downMigr]
      schema'' <- getSchema testDB testSchema
      schema'' `shouldBe` schema
-      withConnection st (`Migrations.run` MTRUp [m])
+      Migrations.run st $ MTRUp [m]
      schema''' <- getSchema testDB testSchema
      schema''' `shouldBe` schema'

@@ -0,0 +1,119 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module CoreTests.UtilTests where
+
+import Control.Exception (Exception, SomeException, throwIO)
+import Control.Monad.Except
+import Data.IORef
+import Simplex.Messaging.Util
+import Simplex.Messaging.Client.Agent ()
+import Test.Hspec
+import qualified UnliftIO.Exception as UE
+
+utilTests :: Spec
+utilTests = do
+  describe "problems of lifted try, catch and finally (don't use them)" $ do
+    describe "lifted try" $ do
+      it "does not catch errors" $ do
+        runExceptT (UE.try throwTestError >>= either handleCatch pure) `shouldReturn` Left (TestError "error")
+        runExceptT (UE.try throwTestException >>= either handleCatch pure) `shouldThrow` (\(e :: IOError) -> show e == "user error (error)")
+      it "with SomeException catches all errors but wraps ExceptT errors" $ do
+        runExceptT (UE.try throwTestError >>= either handleException pure) `shouldReturn` Right "caught InternalException {unInternalException = TestError \"error\"}"
+        runExceptT (UE.try throwTestException >>= either handleException pure) `shouldReturn` Right "caught user error (error)"
+    describe "lifted catch" $ do
+      it "does not catch" $ do
+        runExceptT (throwTestError `UE.catch` handleCatch) `shouldReturn` Left (TestError "error")
+        runExceptT (throwTestException `UE.catch` handleCatch) `shouldThrow` (\(e :: IOError) -> show e == "user error (error)")
+      it "with SomeException catches all errors but wraps ExceptT errors" $ do
+        runExceptT (throwTestError `UE.catch` handleException) `shouldReturn` Right "caught InternalException {unInternalException = TestError \"error\"}"
+        runExceptT (throwTestException `UE.catch` handleException) `shouldReturn` Right "caught user error (error)"
+    describe "lifted finally" $ do
+      it "with ExceptT error executes final action and stays in ExceptT monad" $ withFinal $ \final ->
+        runExceptT (throwTestError `UE.finally` final) `shouldReturn` Left (TestError "error")
+      it "with exception executes final action (not always - race condition?) and throws exception" $ withFinal $ \final ->
+        runExceptT (throwTestException `UE.finally` final) `shouldThrow` (\(e :: IOError) -> show e == "user error (error)")
+  describe "problems of tryError and catchError (don't use them)" $ do
+    describe "tryError" $ do
+      it "catches ExceptT errors but not Exceptions" $ do
+        runExceptT (tryError throwTestError >>= either handleCatch pure) `shouldReturn` Right "caught TestError \"error\""
+        runExceptT (tryError throwTestException >>= either handleCatch pure) `shouldThrow` (\(e :: IOError) -> show e == "user error (error)")
+    describe "catchError" $ do
+      it "catches ExceptT errors but not Exceptions" $ do
+        runExceptT (throwTestError `catchError` handleCatch) `shouldReturn` Right "caught TestError \"error\""
+        runExceptT (throwTestException `catchError` handleCatch) `shouldThrow` (\(e :: IOError) -> show e == "user error (error)")
+  describe "tryAllErrors" $ do
+    it "should return ExceptT error as Left" $
+      runExceptT (tryAllErrors testErr throwTestError) `shouldReturn` Right (Left (TestError "error"))
+    it "should return SomeException as Left" $
+      runExceptT (tryAllErrors testErr throwTestException) `shouldReturn` Right (Left (TestException "user error (error)"))
+    it "should return no errors as Right" $
+      runExceptT (tryAllErrors testErr noErrors) `shouldReturn` Right (Right "no errors")
+  describe "tryAllErrors specialized as tryTestError" $ do
+    let tryTestError = tryAllErrors testErr
+    it "should return ExceptT error as Left" $
+      runExceptT (tryTestError throwTestError) `shouldReturn` Right (Left (TestError "error"))
+    it "should return SomeException as Left" $
+      runExceptT (tryTestError throwTestException) `shouldReturn` Right (Left (TestException "user error (error)"))
+    it "should return no errors as Right" $
+      runExceptT (tryTestError noErrors) `shouldReturn` Right (Right "no errors")
+  describe "catchAllErrors" $ do
+    it "should catch ExceptT error" $
+      runExceptT (catchAllErrors testErr throwTestError handleCatch) `shouldReturn` Right "caught TestError \"error\""
+    it "should catch SomeException" $
+      runExceptT (catchAllErrors testErr throwTestException handleCatch) `shouldReturn` Right "caught TestException \"user error (error)\""
+    it "should not throw if there are no errors" $
+      runExceptT (catchAllErrors testErr noErrors throwError) `shouldReturn` Right "no errors"
+  describe "catchAllErrors specialized as catchTestError" $ do
+    let catchTestError = catchAllErrors testErr
+    it "should catch ExceptT error" $
+      runExceptT (throwTestError `catchTestError` handleCatch) `shouldReturn` Right "caught TestError \"error\""
+    it "should catch SomeException" $
+      runExceptT (throwTestException `catchTestError` handleCatch) `shouldReturn` Right "caught TestException \"user error (error)\""
+    it "should not throw if there are no errors" $
+      runExceptT (noErrors `catchTestError` throwError) `shouldReturn` Right "no errors"
+  describe "catchThrow" $ do
+    it "should re-throw ExceptT error" $
+      runExceptT (throwTestError `catchThrow` testErr) `shouldReturn` Left (TestError "error")
+    it "should catch SomeException and throw as ExceptT error" $
+      runExceptT (throwTestException `catchThrow` testErr) `shouldReturn` Left (TestException "user error (error)")
+    it "should not throw if there are no exceptions" $
+      runExceptT (noErrors `catchThrow` testErr) `shouldReturn` Right "no errors"
+  describe "allFinally should run final action" $ do
+    it "then throw ExceptT error" $ withFinal $ \final ->
+      runExceptT (allFinally testErr throwTestError final) `shouldReturn` Left (TestError "error")
+    it "then throw SomeException as ExceptT error" $ withFinal $ \final ->
+      runExceptT (allFinally testErr throwTestException final) `shouldReturn` Left (TestException "user error (error)")
+    it "and should not throw if there are no exceptions" $ withFinal $ \final ->
+      runExceptT (allFinally testErr noErrors final) `shouldReturn` Right "no errors"
+  describe "allFinally specialized as testFinally should run final action" $ do
+    let testFinally = allFinally testErr
+    it "then throw ExceptT error" $ withFinal $ \final ->
+      runExceptT (throwTestError `testFinally` final) `shouldReturn` Left (TestError "error")
+    it "then throw SomeException as ExceptT error" $ withFinal $ \final ->
+      runExceptT (throwTestException `testFinally` final) `shouldReturn` Left (TestException "user error (error)")
+    it "and should not throw if there are no exceptions" $ withFinal $ \final ->
+      runExceptT (noErrors `testFinally` final) `shouldReturn` Right "no errors"
+  where
+    throwTestError :: ExceptT TestError IO String
+    throwTestError = throwError $ TestError "error"
+    throwTestException :: ExceptT TestError IO String
+    throwTestException = liftIO $ throwIO $ userError "error"
+    noErrors :: ExceptT TestError IO String
+    noErrors = pure "no errors"
+    testErr :: SomeException -> TestError
+    testErr = TestException . show
+    handleCatch :: TestError -> ExceptT TestError IO String
+    handleCatch e = pure $ "caught " <> show e
+    handleException :: SomeException -> ExceptT TestError IO String
+    handleException e = pure $ "caught " <> show e
+    withFinal :: (ExceptT TestError IO String -> IO ()) -> IO ()
+    withFinal test = do
+      r <- newIORef False
+      let final = liftIO $ writeIORef r True >> pure "final"
+      test final
+      readIORef r `shouldReturn` True
+
+data TestError = TestError String | TestException String
+  deriving (Eq, Show)
+
+instance Exception TestError
@@ -44,6 +44,7 @@ import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), http2TLSParams)
 import Simplex.Messaging.Transport.HTTP2.Server
+import Simplex.Messaging.Transport.Server
 import Test.Hspec
 import UnliftIO.Async
 import UnliftIO.Concurrent
@@ -88,9 +89,9 @@ ntfServerCfg =
          { apnsPort = apnsTestPort,
            caStoreFile = "tests/fixtures/ca.crt"
          },
+      subsBatchSize = 900,
      inactiveClientExpiration = Just defaultInactiveClientExpiration,
      storeLogFile = Nothing,
-      resubscribeDelay = 1000,
      -- CA certificate private key is not needed for initialization
      caCertificateFile = "tests/fixtures/ca.crt",
      privateKeyFile = "tests/fixtures/server.key",
@@ -100,7 +101,7 @@ ntfServerCfg =
      logStatsStartTime = 0,
      serverStatsLogFile = "tests/ntf-server-stats.daily.log",
      serverStatsBackupFile = Nothing,
-      logTLSErrors = True
+      transportConfig = defaultTransportServerConfig
    }

 withNtfServerStoreLog :: ATransport -> (ThreadId -> IO a) -> IO a
@@ -134,7 +135,7 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
  where
    tPut' h (sig, corrId, queueId, smp) = do
      let t' = smpEncode (sessionId (h :: THandle c), corrId, queueId, smp)
-      [Right ()] <- tPut h [(sig, t')]
+      [Right ()] <- tPut h Nothing [(sig, t')]
      pure ()
    tGet' h = do
      [(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
@@ -167,7 +168,7 @@ apnsMockServerConfig =
      caCertificateFile = "tests/fixtures/ca.crt",
      privateKeyFile = "tests/fixtures/server.key",
      certificateFile = "tests/fixtures/server.crt",
-      logTLSErrors = True
+      transportConfig = defaultTransportServerConfig
    }

 withAPNSMockServer :: (APNSMockServer -> IO ()) -> IO ()
@@ -24,6 +24,7 @@ import Simplex.Messaging.Server (runSMPServerBlocking)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
+import Simplex.Messaging.Transport.Server
 import Simplex.Messaging.Version
 import System.Environment (lookupEnv)
 import System.Info (os)
@@ -99,7 +100,7 @@ cfg =
      privateKeyFile = "tests/fixtures/server.key",
      certificateFile = "tests/fixtures/server.crt",
      smpServerVRange = supportedSMPServerVRange,
-      logTLSErrors = True
+      transportConfig = defaultTransportServerConfig
    }

 withSmpServerStoreMsgLogOnV2 :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
@@ -159,7 +160,7 @@ smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
  where
    tPut' h (sig, corrId, queueId, smp) = do
      let t' = smpEncode (sessionId (h :: THandle c), corrId, queueId, smp)
-      [Right ()] <- tPut h [(sig, t')]
+      [Right ()] <- tPut h Nothing [(sig, t')]
      pure ()
    tGet' h = do
      [(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
@@ -88,7 +88,7 @@ signSendRecv h@THandle {thVersion, sessionId} pk (corrId, qId, cmd) = do

 tPut1 :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ())
 tPut1 h t = do
-  [r] <- tPut h [t]
+  [r] <- tPut h Nothing [t]
  pure r

 tGet1 :: (ProtocolEncoding err cmd, Transport c, MonadIO m, MonadFail m) => THandle c -> m (SignedTransmission err cmd)
@@ -7,6 +7,7 @@ import CoreTests.CryptoTests
 import CoreTests.EncodingTests
 import CoreTests.ProtocolErrorTests
 import CoreTests.RetryIntervalTests
+import CoreTests.UtilTests
 import CoreTests.VersionRangeTests
 import FileDescriptionTests (fileDescriptionTests)
 import NtfServerTests (ntfServerTests)
@@ -39,6 +40,7 @@ main = do
          describe "Version range" versionRangeTests
          describe "Encryption tests" cryptoTests
          describe "Retry interval tests" retryIntervalTests
+          describe "Util tests" utilTests
        describe "SMP server via TLS" $ serverTests (transport @TLS)
        describe "SMP server via WebSockets" $ serverTests (transport @WS)
        describe "Notifications server" $ ntfServerTests (transport @TLS)
@@ -14,6 +14,7 @@ import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Server (runXFTPServerBlocking)
 import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defaultFileExpiration)
 import Simplex.Messaging.Protocol (XFTPServer)
+import Simplex.Messaging.Transport.Server
 import Test.Hspec

 xftpTest :: HasCallStack => (HasCallStack => XFTPClient -> IO ()) -> Expectation
@@ -111,7 +112,7 @@ testXFTPServerConfig =
      logStatsStartTime = 0,
      serverStatsLogFile = "tests/tmp/xftp-server-stats.daily.log",
      serverStatsBackupFile = Nothing,
-      logTLSErrors = True
+      transportConfig = defaultTransportServerConfig
    }

 testXFTPClientConfig :: XFTPClientConfig
Author	SHA1	Message	Date
Evgeny Poberezkin	745a144e0c	5.2.1 (ntf 1.5.1, xftp 1.0.1) (#799 )	2023-07-13 19:23:06 +01:00
Evgeny Poberezkin	4c6c436e7f	resubscribe in batches in Client.Agent (#798 ) * resubscribe in batches in Client.Agent * fix test	2023-07-12 07:35:38 +01:00
Evgeny Poberezkin	b61e3b5f95	server: disable transport timeout (#793 )	2023-07-11 19:43:31 +01:00
Evgeny Poberezkin	58dbc197ce	increase TCP timeout for clients (#797 )	2023-07-11 18:54:14 +01:00
spaced4ndy	1afcefa5e7	db error busy treatments (#796 )	2023-07-11 20:19:20 +04:00
Evgeny Poberezkin	532cd2f39c	fix allFinally	2023-07-09 21:36:23 +01:00
Evgeny Poberezkin	2f5c646e55	test with catchError/tryError	2023-07-09 18:38:44 +01:00
Evgeny Poberezkin	f76a5ca5b6	agent: catch IO errors correctly in MonadError (#795 ) * agent: catch IO errors correctly in MonadError * correction * correction * utils * agentFinally to catch IO exceptions in ExceptT * rename * remove, inline * rename utils * utils unit test * test to show catch and finally problems * tryAllErrors * enable all tests	2023-07-09 18:04:45 +01:00
spaced4ndy	f2657f9c0b	add crypto error to RSYNC event (#794 )	2023-07-05 18:14:51 +04:00
Evgeny Poberezkin	fe22d9b299	agent api to reconnect all servers (#792 )	2023-07-04 22:54:45 +01:00
Evgeny Poberezkin	75fe28a8a6	lint	2023-07-03 17:43:56 +01:00
Evgeny Poberezkin	54dc8d42e7	5.2.0, ntf server 1.5.0 (#790 )	2023-07-03 13:32:58 +01:00
spaced4ndy	0e1562deae	increase connection agent version according to received messages; add version and flags to connection stats, bump currentSMPAgentVersion (#789 )	2023-06-30 20:19:10 +04:00
Evgeny Poberezkin	94540a2c71	servers: add TCP timeouts to avoid memory leaks (#776 ) * servers: add TCP timeouts to avoid memory leaks * fix tests * only use RecvTimeOut * servers: simple timeout for TCP transport * revert dependency change * simplify * simplify * simplify 2	2023-06-30 16:22:01 +01:00
Evgeny Poberezkin	16367fcb3b	make timeouts for batched functions dependent on the number of batches (#786 ) * make timeouts for batched functions dependent on the number of batches * fix * refactor * refactor * change import * refactor * rename function * rename * refactor * remove space	2023-06-30 12:26:09 +01:00
spaced4ndyandEvgeny Poberezkin	8be2505fa0	ratchet re-synchronization (#774 ) * ratchet re-synchronization rfc wip * additions * additions, types * fix tests * re-sync implementation wip * re-sync implementation 1st rev. * test wip * test passes * doc * wording * improve doc schema * single agreed state * refactor (1 state variable) * allowed -> required * prohibit enqueue * enqueue * send via multiple queues * test with server offline * clarify errors * rename * more tests * refactor * rename AgentRKey * rename AM_CONN_RATCHET_KEY * more tests * rename * write encoded AgentRatchetInfo to AgentRatchetKey info * move withConnLock * refactor qDuplex * re-create ratchet on receiving second key * invert condition * refactor * simplify --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>	2023-06-30 14:17:08 +04:00
spaced4ndy	a000419bd7	restore confirmation after client restart (#783 )	2023-06-29 10:10:34 +04:00
spaced4ndy	c8a8e2c297	differentiate agent INACTIVE error, treat as temporary (#784 )	2023-06-29 10:00:53 +04:00
Evgeny Poberezkin	f7d038ef20	agent: more batched commands (#782 ) * agent: more batched commands * layout	2023-06-28 19:50:11 +01:00
Evgeny Poberezkin	4a927d1ae2	ntf server: better batching and logging (#780 ) * ntf server: better batching and logging * reduce batch delay for ntf server * comments * 5.1.3, ntf 1.4.2 * more logging * more logging * split large batches, more logging * remove some logs	2023-06-26 20:14:35 +01:00
spaced4ndy	3a74558e84	fix connection switch status db encoding (#781 )	2023-06-26 21:03:46 +04:00