From 3dab33048012be3e78005482b661be29211875a0 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 5 Jun 2024 11:20:50 +0100
Subject: [PATCH 001/195] use throwE instead of throwError (#1187)

* use throwE instead of throwError

* test delay
---
 src/Simplex/FileTransfer/Agent.hs             | 41 +++++-----
 src/Simplex/FileTransfer/Client.hs            | 20 ++---
 src/Simplex/FileTransfer/Client/Agent.hs      |  3 +-
 src/Simplex/FileTransfer/Client/Main.hs       | 25 +++---
 src/Simplex/FileTransfer/Crypto.hs            | 13 +--
 src/Simplex/FileTransfer/Server.hs            | 11 +--
 src/Simplex/FileTransfer/Transport.hs         |  2 +-
 src/Simplex/Messaging/Agent.hs                | 82 +++++++++----------
 src/Simplex/Messaging/Agent/Client.hs         | 22 ++---
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  3 +-
 src/Simplex/Messaging/Client.hs               |  4 +-
 src/Simplex/Messaging/Crypto/File.hs          |  7 +-
 src/Simplex/Messaging/Crypto/Ratchet.hs       |  2 +-
 .../Notifications/Server/Push/APNS.hs         | 17 ++--
 .../Messaging/Notifications/Transport.hs      |  4 +-
 src/Simplex/Messaging/Util.hs                 |  7 +-
 src/Simplex/RemoteControl/Client.hs           | 35 ++++----
 tests/AgentTests/FunctionalAPITests.hs        |  2 +-
 18 files changed, 155 insertions(+), 145 deletions(-)

diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index c8030b206..654a83207 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -32,6 +32,7 @@ import Control.Logger.Simple (logError)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
+import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -141,7 +142,7 @@ xftpReceiveFile' c userId (ValidFileDescription fd@FileDescription {chunks, redi
 downloadChunk :: AgentClient -> FileChunk -> AM ()
 downloadChunk c FileChunk {replicas = (FileChunkReplica {server} : _)} = do
   lift . void $ getXFTPRcvWorker True c (Just server)
-downloadChunk _ _ = throwError $ INTERNAL "no replicas"
+downloadChunk _ _ = throwE $ INTERNAL "no replicas"
 
 getPrefixPath :: String -> AM' FilePath
 getPrefixPath suffix = do
@@ -194,7 +195,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
             retryDone = rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath)
     downloadFileChunk :: RcvFileChunk -> RcvFileChunkReplica -> Bool -> AM ()
     downloadFileChunk RcvFileChunk {userId, rcvFileId, rcvFileEntityId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath} replica approvedRelays = do
-      unlessM ((approvedRelays ||) <$> ipAddressProtected') $ throwError $ XFTP "" XFTP.NOT_APPROVED
+      unlessM ((approvedRelays ||) <$> ipAddressProtected') $ throwE $ XFTP "" XFTP.NOT_APPROVED
       fsFileTmpPath <- lift $ toFSFilePath fileTmpPath
       chunkPath <- uniqueCombine fsFileTmpPath $ show chunkNo
       let chunkSpec = XFTPRcvChunkSpec chunkPath (unFileSize chunkSize) (unFileDigest digest)
@@ -267,9 +268,9 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
       withStore' c $ \db -> updateRcvFileStatus db rcvFileId RFSDecrypting
       chunkPaths <- getChunkPaths chunks
       encSize <- liftIO $ foldM (\s path -> (s +) . fromIntegral <$> getFileSize path) 0 chunkPaths
-      when (FileSize encSize /= size) $ throwError $ XFTP "" XFTP.SIZE
+      when (FileSize encSize /= size) $ throwE $ XFTP "" XFTP.SIZE
       encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
-      when (FileDigest encDigest /= digest) $ throwError $ XFTP "" XFTP.DIGEST
+      when (FileDigest encDigest /= digest) $ throwE $ XFTP "" XFTP.DIGEST
       let destFile = CryptoFile fsSavePath cfArgs
       void $ liftError (INTERNAL . show) $ decryptChunks encSize chunkPaths key nonce $ \_ -> pure destFile
       case redirect of
@@ -287,10 +288,10 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
           yaml <- liftError (INTERNAL . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `agentFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
           next@FileDescription {chunks = nextChunks} <- case strDecode (LB.toStrict yaml) of
             -- TODO switch to another error constructor
-            Left _ -> throwError . XFTP "" $ XFTP.REDIRECT "decode error"
+            Left _ -> throwE . XFTP "" $ XFTP.REDIRECT "decode error"
             Right (ValidFileDescription fd@FileDescription {size = dstSize, digest = dstDigest})
-              | dstSize /= redirectSize -> throwError . XFTP "" $ XFTP.REDIRECT "size mismatch"
-              | dstDigest /= redirectDigest -> throwError . XFTP "" $ XFTP.REDIRECT "digest mismatch"
+              | dstSize /= redirectSize -> throwE . XFTP "" $ XFTP.REDIRECT "size mismatch"
+              | dstDigest /= redirectDigest -> throwE . XFTP "" $ XFTP.REDIRECT "digest mismatch"
               | otherwise -> pure fd
           -- register and download chunks from the actual file
           withStore c $ \db -> updateRcvFileRedirect db redirectDbId next
@@ -303,7 +304,7 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
           fsPath <- lift $ toFSFilePath path
           pure $ fsPath : ps
         getChunkPaths (RcvFileChunk {chunkTmpPath = Nothing} : _cs) =
-          throwError $ INTERNAL "no chunk path"
+          throwE $ INTERNAL "no chunk path"
 
 xftpDeleteRcvFile' :: AgentClient -> RcvFileId -> AM' ()
 xftpDeleteRcvFile' c rcvFileEntityId = xftpDeleteRcvFiles' c [rcvFileEntityId]
@@ -379,7 +380,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
           prepareFile cfg f `catchAgentError` (sndWorkerInternalError c sndFileId sndFileEntityId prefixPath . show)
     prepareFile :: AgentConfig -> SndFile -> AM ()
     prepareFile _ SndFile {prefixPath = Nothing} =
-      throwError $ INTERNAL "no prefix path"
+      throwE $ INTERNAL "no prefix path"
     prepareFile cfg sndFile@SndFile {sndFileId, userId, prefixPath = Just ppath, status} = do
       SndFile {numRecipients, chunks} <-
         if status /= SFSEncrypted -- status is SFSNew or SFSEncrypting
@@ -405,14 +406,14 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
           let CryptoFile {filePath} = srcFile
               fileName = takeFileName filePath
           fileSize <- liftIO $ fromInteger <$> CF.getFileContentsSize srcFile
-          when (fileSize > maxFileSizeHard) $ throwError $ INTERNAL "max file size exceeded"
+          when (fileSize > maxFileSizeHard) $ throwE $ INTERNAL "max file size exceeded"
           let fileHdr = smpEncode FileHeader {fileName, fileExtra = Nothing}
               fileSize' = fromIntegral (B.length fileHdr) + fileSize
               payloadSize = fileSize' + fileSizeLen + authTagSize
           chunkSizes <- case redirect of
             Nothing -> pure $ prepareChunkSizes payloadSize
             Just _ -> case singleChunkSize payloadSize of
-              Nothing -> throwError $ INTERNAL "max file size exceeded for redirect"
+              Nothing -> throwE $ INTERNAL "max file size exceeded for redirect"
               Just chunkSize -> pure [chunkSize]
           let encSize = sum $ map fromIntegral chunkSizes
           void $ liftError (INTERNAL . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize fsEncPath
@@ -432,12 +433,12 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
               withRetryInterval (riFast ri) $ \_ loop -> do
                 liftIO $ waitForUserNetwork c
                 createWithNextSrv usedSrvs
-                  `catchAgentError` \e -> retryOnError "XFTP prepare worker" (retryLoop loop) (throwError e) e
+                  `catchAgentError` \e -> retryOnError "XFTP prepare worker" (retryLoop loop) (throwE e) e
               where
                 retryLoop loop = atomically (assertAgentForeground c) >> loop
             createWithNextSrv usedSrvs = do
               deleted <- withStore' c $ \db -> getSndFileDeleted db sndFileId
-              when deleted $ throwError $ INTERNAL "file deleted, aborting chunk creation"
+              when deleted $ throwE $ INTERNAL "file deleted, aborting chunk creation"
               withNextSrv c userId usedSrvs [] $ \srvAuth -> do
                 replica <- agentXFTPNewChunk c ch numRecipients' srvAuth
                 pure (replica, srvAuth)
@@ -479,7 +480,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
     uploadFileChunk AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients} sndFileChunk@SndFileChunk {sndFileId, userId, chunkSpec = chunkSpec@XFTPChunkSpec {filePath}, digest = chunkDigest} replica = do
       replica'@SndFileChunkReplica {sndChunkReplicaId} <- addRecipients sndFileChunk replica
       fsFilePath <- lift $ toFSFilePath filePath
-      unlessM (doesFileExist fsFilePath) $ throwError $ INTERNAL "encrypted file doesn't exist on upload"
+      unlessM (doesFileExist fsFilePath) $ throwE $ INTERNAL "encrypted file doesn't exist on upload"
       let chunkSpec' = chunkSpec {filePath = fsFilePath} :: XFTPChunkSpec
       atomically $ assertAgentForeground c
       agentXFTPUploadChunk c userId chunkDigest replica' chunkSpec'
@@ -499,7 +500,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
       where
         addRecipients :: SndFileChunk -> SndFileChunkReplica -> AM SndFileChunkReplica
         addRecipients ch@SndFileChunk {numRecipients} cr@SndFileChunkReplica {rcvIdsKeys}
-          | length rcvIdsKeys > numRecipients = throwError $ INTERNAL "too many recipients"
+          | length rcvIdsKeys > numRecipients = throwE $ INTERNAL "too many recipients"
           | length rcvIdsKeys == numRecipients = pure cr
           | otherwise = do
               let numRecipients' = min (numRecipients - length rcvIdsKeys) maxRecipients
@@ -507,22 +508,22 @@ runXFTPSndWorker c srv Worker {doWork} = do
               cr' <- withStore' c $ \db -> addSndChunkReplicaRecipients db cr $ L.toList rcvIdsKeys'
               addRecipients ch cr'
         sndFileToDescrs :: SndFile -> AM (ValidFileDescription 'FSender, [ValidFileDescription 'FRecipient])
-        sndFileToDescrs SndFile {digest = Nothing} = throwError $ INTERNAL "snd file has no digest"
-        sndFileToDescrs SndFile {chunks = []} = throwError $ INTERNAL "snd file has no chunks"
+        sndFileToDescrs SndFile {digest = Nothing} = throwE $ INTERNAL "snd file has no digest"
+        sndFileToDescrs SndFile {chunks = []} = throwE $ INTERNAL "snd file has no chunks"
         sndFileToDescrs SndFile {digest = Just digest, key, nonce, chunks = chunks@(fstChunk : _), redirect} = do
           let chunkSize = FileSize $ sndChunkSize fstChunk
               size = FileSize $ sum $ map (fromIntegral . sndChunkSize) chunks
           -- snd description
           sndDescrChunks <- mapM toSndDescrChunk chunks
           let fdSnd = FileDescription {party = SFSender, size, digest, key, nonce, chunkSize, chunks = sndDescrChunks, redirect = Nothing}
-          validFdSnd <- either (throwError . INTERNAL) pure $ validateFileDescription fdSnd
+          validFdSnd <- either (throwE . INTERNAL) pure $ validateFileDescription fdSnd
           -- rcv descriptions
           let fdRcv = FileDescription {party = SFRecipient, size, digest, key, nonce, chunkSize, chunks = [], redirect}
               fdRcvs = createRcvFileDescriptions fdRcv chunks
-          validFdRcvs <- either (throwError . INTERNAL) pure $ mapM validateFileDescription fdRcvs
+          validFdRcvs <- either (throwE . INTERNAL) pure $ mapM validateFileDescription fdRcvs
           pure (validFdSnd, validFdRcvs)
         toSndDescrChunk :: SndFileChunk -> AM FileChunk
-        toSndDescrChunk SndFileChunk {replicas = []} = throwError $ INTERNAL "snd file chunk has no replicas"
+        toSndDescrChunk SndFileChunk {replicas = []} = throwE $ INTERNAL "snd file chunk has no replicas"
         toSndDescrChunk ch@SndFileChunk {chunkNo, digest = chDigest, replicas = (SndFileChunkReplica {server, replicaId, replicaKey} : _)} = do
           let chunkSize = FileSize $ sndChunkSize ch
               replicas = [FileChunkReplica {server, replicaId, replicaKey}]
diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs
index 44d1b596b..445def724 100644
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -138,9 +138,9 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
       liftTransportErr (TEHandshake PARSE) . smpDecode =<< liftTransportErr TEBadBlock (C.unPad shsBody)
     processServerHandshake :: XFTPServerHandshake -> ExceptT XFTPClientError IO (VersionRangeXFTP, C.PublicKeyX25519)
     processServerHandshake XFTPServerHandshake {xftpVersionRange, sessionId = serverSessId, authPubKey = serverAuth} = do
-      unless (sessionId == serverSessId) $ throwError $ PCETransportError TEBadSession
+      unless (sessionId == serverSessId) $ throwE $ PCETransportError TEBadSession
       case xftpVersionRange `compatibleVRange` serverVRange of
-        Nothing -> throwError $ PCETransportError TEVersion
+        Nothing -> throwE $ PCETransportError TEVersion
         Just (Compatible vr) ->
           fmap (vr,) . liftTransportErr (TEHandshake BAD_AUTH) $ do
             let (X.CertificateChain cert, exact) = serverAuth
@@ -154,7 +154,7 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
       chs' <- liftTransportErr TELargeMsg $ C.pad (smpEncode chs) xftpBlockSize
       let chsReq = H.requestBuilder "POST" "/" [] $ byteString chs'
       HTTP2Response {respBody = HTTP2Body {bodyHead}} <- liftError' xftpClientError $ sendRequest c chsReq Nothing
-      unless (B.null bodyHead) $ throwError $ PCETransportError TEBadBlock
+      unless (B.null bodyHead) $ throwE $ PCETransportError TEBadBlock
     liftTransportErr e = liftEitherWith (const $ PCETransportError e)
 
 closeXFTPClient :: XFTPClient -> IO ()
@@ -200,14 +200,14 @@ sendXFTPTransmission XFTPClient {config, thParams, http2Client} t chunkSpec_ = d
   let req = H.requestStreaming N.methodPost "/" [] streamBody
       reqTimeout = xftpReqTimeout config $ (\XFTPChunkSpec {chunkSize} -> chunkSize) <$> chunkSpec_
   HTTP2Response {respBody = body@HTTP2Body {bodyHead}} <- withExceptT xftpClientError . ExceptT $ sendRequest http2Client req (Just reqTimeout)
-  when (B.length bodyHead /= xftpBlockSize) $ throwError $ PCEResponseError BLOCK
+  when (B.length bodyHead /= xftpBlockSize) $ throwE $ PCEResponseError BLOCK
   -- TODO validate that the file ID is the same as in the request?
   (_, _, (_, _fId, respOrErr)) <- liftEither . first PCEResponseError $ xftpDecodeTransmission thParams bodyHead
   case respOrErr of
     Right r -> case protocolError r of
-      Just e -> throwError $ PCEProtocolError e
+      Just e -> throwE $ PCEProtocolError e
       _ -> pure (r, body)
-    Left e -> throwError $ PCEResponseError e
+    Left e -> throwE $ PCEResponseError e
   where
     streamBody :: (Builder -> IO ()) -> IO () -> IO ()
     streamBody send done = do
@@ -250,7 +250,7 @@ downloadXFTPChunk g c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {
         let dhSecret = C.dh' sDhKey rpDhKey
         cbState <- liftEither . first PCECryptoError $ LC.cbInit dhSecret cbNonce
         let t = chunkTimeout config chunkSize
-        ExceptT (sequence <$> (t `timeout` (download cbState `catches` errors))) >>= maybe (throwError PCEResponseTimeout) pure
+        ExceptT (sequence <$> (t `timeout` (download cbState `catches` errors))) >>= maybe (throwE PCEResponseTimeout) pure
         where
           errors =
             [ Handler $ \(_e :: H.HTTP2Error) -> pure $ Left PCENetworkError,
@@ -260,8 +260,8 @@ downloadXFTPChunk g c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {
           download cbState =
             runExceptT . withExceptT PCEResponseError $
               receiveEncFile chunkPart cbState chunkSpec `catchError` \e ->
-                whenM (doesFileExist filePath) (removeFile filePath) >> throwError e
-      _ -> throwError $ PCEResponseError NO_FILE
+                whenM (doesFileExist filePath) (removeFile filePath) >> throwE e
+      _ -> throwE $ PCEResponseError NO_FILE
     (r, _) -> throwE $ unexpectedResponse r
 
 xftpReqTimeout :: XFTPClientConfig -> Maybe Word32 -> Int
@@ -296,7 +296,7 @@ okResponse = \case
 -- TODO this currently does not check anything because response size is not set and bodyPart is always Just
 noFile :: HTTP2Body -> a -> ExceptT XFTPClientError IO a
 noFile HTTP2Body {bodyPart} a = case bodyPart of
-  Just _ -> pure a -- throwError $ PCEResponseError HAS_FILE
+  Just _ -> pure a -- throwE $ PCEResponseError HAS_FILE
   _ -> pure a
 
 -- FACK :: FileCommand Recipient
diff --git a/src/Simplex/FileTransfer/Client/Agent.hs b/src/Simplex/FileTransfer/Client/Agent.hs
index c17790c2d..86b093ee7 100644
--- a/src/Simplex/FileTransfer/Client/Agent.hs
+++ b/src/Simplex/FileTransfer/Client/Agent.hs
@@ -11,6 +11,7 @@ import Control.Logger.Simple (logInfo)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Trans (lift)
+import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Char8 as B
 import Data.Text (Text)
@@ -108,7 +109,7 @@ getXFTPServerClient XFTPClientAgent {xftpClients, config} srv = do
                 else atomically $ do
                   putTMVar clientVar r
                   TM.delete srv xftpClients
-              throwError e
+              throwE e
         tryConnectAsync :: ME ()
         tryConnectAsync = void . lift . async . runExceptT $ do
           withRetryInterval (reconnectInterval config) $ \_ loop -> void $ tryConnectClient loop
diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs
index 0acc6d3c9..aeac956e6 100644
--- a/src/Simplex/FileTransfer/Client/Main.hs
+++ b/src/Simplex/FileTransfer/Client/Main.hs
@@ -30,6 +30,7 @@ where
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
+import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
@@ -292,7 +293,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
     encryptFileForUpload :: TVar ChaChaDRG -> String -> ExceptT CLIError IO (FilePath, FileDescription 'FRecipient, FileDescription 'FSender, [XFTPChunkSpec], Int64)
     encryptFileForUpload g fileName = do
       fileSize <- fromInteger <$> getFileSize filePath
-      when (fileSize > maxFileSize) $ throwError $ CLIError $ "Files bigger than " <> maxFileSizeStr <> " are not supported"
+      when (fileSize > maxFileSize) $ throwE $ CLIError $ "Files bigger than " <> maxFileSizeStr <> " are not supported"
       encPath <- getEncPath tempPath "xftp"
       key <- atomically $ C.randomSbKey g
       nonce <- atomically $ C.randomCbNonce g
@@ -323,7 +324,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
       -- upload doesn't allow other requests within the same client until complete (but download does allow).
       logInfo $ "uploading " <> tshow (length chunks) <> " chunks..."
       (errs, rs) <- partitionEithers . concat <$> liftIO (pooledForConcurrentlyN 16 chunks' . mapM $ runExceptT . uploadFileChunk a)
-      mapM_ throwError errs
+      mapM_ throwE errs
       pure $ map snd (sortOn fst rs)
       where
         uploadFileChunk :: XFTPClientAgent -> (Int, XFTPChunkSpec, XFTPServerWithAuth) -> ExceptT CLIError IO (Int, SentFileChunk)
@@ -437,12 +438,12 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
           srvChunks = groupAllOn srv chunks
       g <- liftIO C.newRandom
       (errs, rs) <- partitionEithers . concat <$> liftIO (pooledForConcurrentlyN 16 srvChunks $ mapM $ runExceptT . downloadFileChunk g a encPath size downloadedChunks)
-      mapM_ throwError errs
+      mapM_ throwE errs
       let chunkPaths = map snd $ sortOn fst rs
       encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
-      when (encDigest /= unFileDigest digest) $ throwError $ CLIError "File digest mismatch"
+      when (encDigest /= unFileDigest digest) $ throwE $ CLIError "File digest mismatch"
       encSize <- liftIO $ foldM (\s path -> (s +) . fromIntegral <$> getFileSize path) 0 chunkPaths
-      when (FileSize encSize /= size) $ throwError $ CLIError "File size mismatch"
+      when (FileSize encSize /= size) $ throwE $ CLIError "File size mismatch"
       liftIO $ printNoNewLine "Decrypting file..."
       CryptoFile path _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ fmap CF.plain . getFilePath
       forM_ chunks $ acknowledgeFileChunk a
@@ -464,20 +465,20 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
         printProgress "Downloaded" downloaded encSize
         when verbose $ putStrLn ""
       pure (chunkNo, chunkPath)
-    downloadFileChunk _ _ _ _ _ _ = throwError $ CLIError "chunk has no replicas"
+    downloadFileChunk _ _ _ _ _ _ = throwE $ CLIError "chunk has no replicas"
     getFilePath :: String -> ExceptT String IO FilePath
     getFilePath name =
       case filePath of
         Just path ->
           ifM (doesDirectoryExist path) (uniqueCombine path name) $
-            ifM (doesFileExist path) (throwError "File already exists") (pure path)
+            ifM (doesFileExist path) (throwE "File already exists") (pure path)
         _ -> (`uniqueCombine` name) . (</> "Downloads") =<< getHomeDirectory
     acknowledgeFileChunk :: XFTPClientAgent -> FileChunk -> ExceptT CLIError IO ()
     acknowledgeFileChunk a FileChunk {replicas = replica : _} = do
       let FileChunkReplica {server, replicaId, replicaKey} = replica
       c <- withRetry retryCount $ getXFTPServerClient a server
       withRetry retryCount $ ackXFTPChunk c replicaKey (unChunkReplicaId replicaId)
-    acknowledgeFileChunk _ _ = throwError $ CLIError "chunk has no replicas"
+    acknowledgeFileChunk _ _ = throwE $ CLIError "chunk has no replicas"
 
 printProgress :: String -> Int64 -> Int64 -> IO ()
 printProgress s part total = printNoNewLine $ s <> " " <> show ((part * 100) `div` total) <> "%"
@@ -503,7 +504,7 @@ cliDeleteFile DeleteOptions {fileDescription, retryCount, yes} = do
       let FileChunkReplica {server, replicaId, replicaKey} = replica
       withReconnect a server retryCount $ \c -> deleteXFTPChunk c replicaKey (unChunkReplicaId replicaId)
       logInfo $ "deleted chunk " <> tshow chunkNo <> " from " <> showServer server
-    deleteFileChunk _ _ = throwError $ CLIError "chunk has no replicas"
+    deleteFileChunk _ _ = throwE $ CLIError "chunk has no replicas"
 
 cliFileDescrInfo :: InfoOptions -> ExceptT CLIError IO ()
 cliFileDescrInfo InfoOptions {fileDescription} = do
@@ -533,7 +534,7 @@ getFileDescription path =
 getFileDescription' :: FilePartyI p => FilePath -> ExceptT CLIError IO (ValidFileDescription p)
 getFileDescription' path =
   getFileDescription path >>= \case
-    AVFD fd -> either (throwError . CLIError) pure $ checkParty fd
+    AVFD fd -> either (throwE . CLIError) pure $ checkParty fd
 
 singleChunkSize :: Int64 -> Maybe Word32
 singleChunkSize size' =
@@ -574,13 +575,13 @@ withReconnect a srv n run = withRetry n $ do
   c <- withRetry n $ getXFTPServerClient a srv
   withExceptT (CLIError . show) (run c) `catchError` \e -> do
     liftIO $ closeXFTPServerClient a srv
-    throwError e
+    throwE e
 
 withRetry :: Show e => Int -> ExceptT e IO a -> ExceptT CLIError IO a
 withRetry retryCount = withRetry' retryCount . withExceptT (CLIError . show)
   where
     withRetry' :: Int -> ExceptT CLIError IO a -> ExceptT CLIError IO a
-    withRetry' 0 _ = throwError $ CLIError "internal: no retry attempts"
+    withRetry' 0 _ = throwE $ CLIError "internal: no retry attempts"
     withRetry' 1 a = a
     withRetry' n a =
       a `catchError` \e -> do
diff --git a/src/Simplex/FileTransfer/Crypto.hs b/src/Simplex/FileTransfer/Crypto.hs
index 547a5675a..72344f3c0 100644
--- a/src/Simplex/FileTransfer/Crypto.hs
+++ b/src/Simplex/FileTransfer/Crypto.hs
@@ -8,6 +8,7 @@ module Simplex.FileTransfer.Crypto where
 
 import Control.Monad
 import Control.Monad.Except
+import Control.Monad.Trans.Except
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import qualified Data.ByteArray as BA
@@ -48,17 +49,17 @@ encryptFile srcFile fileHdr key nonce fileSize' encSize encFile = do
       | otherwise = do
           let chSize = min len 65536
           ch <- liftIO $ get chSize
-          when (B.length ch /= fromIntegral chSize) $ throwError $ FTCEFileIOError "encrypting file: unexpected EOF"
+          when (B.length ch /= fromIntegral chSize) $ throwE $ FTCEFileIOError "encrypting file: unexpected EOF"
           let (ch', sb') = LC.sbEncryptChunk sb ch
           liftIO $ B.hPut w ch'
           encryptChunks_ get w (sb', len - chSize)
 
 decryptChunks :: Int64 -> [FilePath] -> C.SbKey -> C.CbNonce -> (String -> ExceptT String IO CryptoFile) -> ExceptT FTCryptoError IO CryptoFile
-decryptChunks _ [] _ _ _ = throwError $ FTCEInvalidHeader "empty"
+decryptChunks _ [] _ _ _ = throwE $ FTCEInvalidHeader "empty"
 decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse chPaths of
   [] -> do
     (!authOk, !f) <- liftEither . first FTCECryptoError . LC.sbDecryptTailTag key nonce (encSize - authTagSize) =<< liftIO (LB.readFile chPath)
-    unless authOk $ throwError FTCEInvalidAuthTag
+    unless authOk $ throwE FTCEInvalidAuthTag
     (FileHeader {fileName}, !f') <- parseFileHeader f
     destFile <- withExceptT FTCEFileIOError $ getDestFile fileName
     CF.writeFile destFile f'
@@ -73,7 +74,7 @@ decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse ch
       decryptLastChunk h state' expectedLen
     unless authOk $ do
       removeFile path
-      throwError FTCEInvalidAuthTag
+      throwE FTCEInvalidAuthTag
     pure destFile
     where
       decryptFirstChunk = do
@@ -105,8 +106,8 @@ decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse ch
     parseFileHeader s = do
       let (hdrStr, s') = LB.splitAt 1024 s
       case A.parse smpP $ LB.toStrict hdrStr of
-        A.Fail _ _ e -> throwError $ FTCEInvalidHeader e
-        A.Partial _ -> throwError $ FTCEInvalidHeader "incomplete"
+        A.Fail _ _ e -> throwE $ FTCEInvalidHeader e
+        A.Partial _ -> throwE $ FTCEInvalidHeader "incomplete"
         A.Done rest hdr -> pure (hdr, LB.fromStrict rest <> s')
 
 readChunks :: [FilePath] -> IO LB.ByteString
diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index 1ed4894ec..24dcc5e38 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -18,6 +18,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
+import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Builder (Builder, byteString)
@@ -136,7 +137,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
       either sendError pure r
       where
         processHello = do
-          unless (B.null bodyHead) $ throwError HANDSHAKE
+          unless (B.null bodyHead) $ throwE HANDSHAKE
           (k, pk) <- atomically . C.generateKeyPair =<< asks random
           atomically $ TM.insert sessionId (HandshakeSent pk) sessions
           let authPubKey = (chain, C.signX509 serverSignKey $ C.publicToX509 k)
@@ -148,11 +149,11 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
           liftIO . sendResponse $ H.responseBuilder N.ok200 [] shs
           pure Nothing
         processClientHandshake pk = do
-          unless (B.length bodyHead == xftpBlockSize) $ throwError HANDSHAKE
+          unless (B.length bodyHead == xftpBlockSize) $ throwE HANDSHAKE
           body <- liftHS $ C.unPad bodyHead
           XFTPClientHandshake {xftpVersion = v, keyHash} <- liftHS $ smpDecode body
           kh <- asks serverIdentity
-          unless (keyHash == kh) $ throwError HANDSHAKE
+          unless (keyHash == kh) $ throwE HANDSHAKE
           case compatibleVRange' xftpServerVRange v of
             Just (Compatible vr) -> do
               let auth = THAuthServer {serverPrivKey = pk, sessSecret' = Nothing}
@@ -163,7 +164,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
 #endif
               liftIO . sendResponse $ H.responseNoBody N.ok200 []
               pure Nothing
-            Nothing -> throwError HANDSHAKE
+            Nothing -> throwE HANDSHAKE
         sendError :: XFTPErrorType -> M (Maybe (THandleParams XFTPVersion 'TServer))
         sendError err = do
           runExceptT (encodeXftp err) >>= \case
@@ -395,7 +396,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
       st <- asks store
       r <- runExceptT $ do
         sizes <- asks $ allowedChunkSizes . config
-        unless (size file `elem` sizes) $ throwError SIZE
+        unless (size file `elem` sizes) $ throwE SIZE
         ts <- liftIO getSystemTime
         -- TODO validate body empty
         sId <- ExceptT $ addFileRetry st file 3 ts
diff --git a/src/Simplex/FileTransfer/Transport.hs b/src/Simplex/FileTransfer/Transport.hs
index 935fa1c42..678d39d52 100644
--- a/src/Simplex/FileTransfer/Transport.hs
+++ b/src/Simplex/FileTransfer/Transport.hs
@@ -194,7 +194,7 @@ receiveFile_ :: (Handle -> Word32 -> IO (Either XFTPErrorType ())) -> XFTPRcvChu
 receiveFile_ receive XFTPRcvChunkSpec {filePath, chunkSize, chunkDigest} = do
   ExceptT $ withFile filePath WriteMode (`receive` chunkSize)
   digest' <- liftIO $ LC.sha256Hash <$> LB.readFile filePath
-  when (digest' /= chunkDigest) $ throwError DIGEST
+  when (digest' /= chunkDigest) $ throwE DIGEST
 
 data XFTPErrorType
   = -- | incorrect block format, encoding or signature size
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 8e9020b7d..07b893b42 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -649,7 +649,7 @@ joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup
         connId <- withStore c $ \db -> createNewConn db g cData SCMInvitation
         enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
         pure connId
-      Nothing -> throwError $ AGENT A_VERSION
+      Nothing -> throwE $ AGENT A_VERSION
 joinConnAsync _c _userId _corrId _enableNtfs (CRContactUri _) _subMode _cInfo _pqEncryption =
   throwE $ CMD PROHIBITED "joinConnAsync"
 
@@ -668,7 +668,7 @@ acceptContactAsync' c corrId enableNtfs invId ownConnInfo pqSupport subMode = do
       withStore' c $ \db -> acceptInvitation db invId ownConnInfo
       joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do
         withStore' c (`unacceptInvitation` invId)
-        throwError err
+        throwE err
     _ -> throwE $ CMD PROHIBITED "acceptContactAsync"
 
 ackMessageAsync' :: AgentClient -> ACorrId -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AM ()
@@ -677,7 +677,7 @@ ackMessageAsync' c corrId connId msgId rcptInfo_ = do
   case cType of
     SCDuplex -> enqueueAck
     SCRcv -> enqueueAck
-    SCSnd -> throwError $ CONN SIMPLEX
+    SCSnd -> throwE $ CONN SIMPLEX
     SCContact -> throwE $ CMD PROHIBITED "ackMessageAsync: SCContact"
     SCNew -> throwE $ CMD PROHIBITED "ackMessageAsync: SCNew"
   where
@@ -740,7 +740,7 @@ newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv
     (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv"
     _ -> pure ()
   AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
-  (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv smpClientVRange subMode `catchAgentError` \e -> liftIO (print e) >> throwError e
+  (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv smpClientVRange subMode `catchAgentError` \e -> liftIO (print e) >> throwE e
   rq' <- withStore c $ \db -> updateNewConnRcv db connId rq
   lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
   when enableNtfs $ do
@@ -760,11 +760,11 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of
   CRInvitationUri {} ->
     lift (compatibleInvitationUri cReq) >>= \case
       Just (_, (Compatible (CR.E2ERatchetParams v _ _ _)), aVersion) -> create aVersion (Just v)
-      Nothing -> throwError $ AGENT A_VERSION
+      Nothing -> throwE $ AGENT A_VERSION
   CRContactUri {} ->
     lift (compatibleContactUri cReq) >>= \case
       Just (_, aVersion) -> create aVersion Nothing
-      Nothing -> throwError $ AGENT A_VERSION
+      Nothing -> throwE $ AGENT A_VERSION
   where
     create :: Compatible VersionSMPA -> Maybe CR.VersionE2E -> AM ConnId
     create (Compatible connAgentVersion) e2eV_ = do
@@ -796,7 +796,7 @@ startJoinInvitation userId connId enableNtfs cReqUri pqSup =
       q <- lift $ newSndQueue userId "" qInfo
       let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
       pure (cData, q, rc, e2eSndParams)
-    Nothing -> throwError $ AGENT A_VERSION
+    Nothing -> throwE $ AGENT A_VERSION
 
 connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport))
 connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of
@@ -846,14 +846,14 @@ joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo p
       Left e -> do
         -- possible improvement: recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md
         void $ withStore' c $ \db -> deleteConn db Nothing connId'
-        throwError e
+        throwE e
 joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv =
   lift (compatibleContactUri cReqUri) >>= \case
     Just (qInfo, vrsn) -> do
       (connId', cReq) <- newConnSrv c userId connId hasNewConn enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv
       void $ sendInvitation c userId qInfo vrsn cReq cInfo
       pure connId'
-    Nothing -> throwError $ AGENT A_VERSION
+    Nothing -> throwE $ AGENT A_VERSION
 
 joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ()
 joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = do
@@ -899,7 +899,7 @@ acceptContact' c connId enableNtfs invId ownConnInfo pqSupport subMode = withCon
       withStore' c $ \db -> acceptInvitation db invId ownConnInfo
       joinConn c userId connId False enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do
         withStore' c (`unacceptInvitation` invId)
-        throwError err
+        throwE err
     _ -> throwE $ CMD PROHIBITED "acceptContact"
 
 -- | Reject contact (RJCT command) in Reader monad
@@ -916,8 +916,8 @@ subscribeConnection' c connId = toConnResult connId =<< subscribeConnections' c
 toConnResult :: ConnId -> Map ConnId (Either AgentErrorType ()) -> AM ()
 toConnResult connId rs = case M.lookup connId rs of
   Just (Right ()) -> when (M.size rs > 1) $ logError $ T.pack $ "too many results " <> show (M.size rs)
-  Just (Left e) -> throwError e
-  _ -> throwError $ INTERNAL $ "no result for connection " <> B.unpack connId
+  Just (Left e) -> throwE e
+  _ -> throwE $ INTERNAL $ "no result for connection " <> B.unpack connId
 
 type QCmdResult = (QueueStatus, Either AgentErrorType ())
 
@@ -1006,7 +1006,7 @@ getConnectionMessage' c connId = do
     DuplexConnection _ (rq :| _) _ -> getQueueMessage c rq
     RcvConnection _ rq -> getQueueMessage c rq
     ContactConnection _ rq -> getQueueMessage c rq
-    SndConnection _ _ -> throwError $ CONN SIMPLEX
+    SndConnection _ _ -> throwE $ CONN SIMPLEX
     NewConnection _ -> throwE $ CMD PROHIBITED "getConnectionMessage: NewConnection"
 
 getNotificationMessage' :: AgentClient -> C.CbNonce -> ByteString -> AM (NotificationInfo, [SMPMsgMeta])
@@ -1146,7 +1146,7 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
             RcvConnection cData rq -> do
               secure rq senderKey
               mapM_ (connectReplyQueues c cData ownConnInfo) (L.nonEmpty $ smpReplyQueues senderConf)
-            _ -> throwError $ INTERNAL $ "incorrect connection type " <> show (internalCmdTag cmd)
+            _ -> throwE $ INTERNAL $ "incorrect connection type " <> show (internalCmdTag cmd)
         ICDuplexSecure _rId senderKey -> withServer' . tryWithLock "ICDuplexSecure" . withDuplexConn $ \(DuplexConnection cData (rq :| _) (sq :| _)) -> do
           secure rq senderKey
           void $ enqueueMessage c cData sq SMP.MsgFlags {notification = True} HELLO
@@ -1182,8 +1182,8 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
                     tryError (deleteQueue c rq') >>= \case
                       Right () -> finalizeSwitch
                       Left e
-                        | temporaryOrHostError e -> throwError e
-                        | otherwise -> finalizeSwitch >> throwError e
+                        | temporaryOrHostError e -> throwE e
+                        | otherwise -> finalizeSwitch >> throwE e
                 where
                   finalizeSwitch = do
                     withStore' c $ \db -> deleteConnRcvQueue db rq'
@@ -1229,7 +1229,7 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
 
 enqueueMessages :: AgentClient -> ConnData -> NonEmpty SndQueue -> MsgFlags -> AMessage -> AM (AgentMsgId, PQEncryption)
 enqueueMessages c cData sqs msgFlags aMessage = do
-  when (ratchetSyncSendProhibited cData) $ throwError $ INTERNAL "enqueueMessages: ratchet is not synchronized"
+  when (ratchetSyncSendProhibited cData) $ throwE $ INTERNAL "enqueueMessages: ratchet is not synchronized"
   enqueueMessages' c cData sqs msgFlags aMessage
 
 enqueueMessages' :: AgentClient -> ConnData -> NonEmpty SndQueue -> MsgFlags -> AMessage -> AM (AgentMsgId, CR.PQEncryption)
@@ -1482,7 +1482,7 @@ ackMessage' c connId msgId rcptInfo_ = withConnLock c connId "ackMessage" $ do
   case conn of
     DuplexConnection {} -> ack >> sendRcpt conn >> del
     RcvConnection {} -> ack >> del
-    SndConnection {} -> throwError $ CONN SIMPLEX
+    SndConnection {} -> throwE $ CONN SIMPLEX
     ContactConnection {} -> throwE $ CMD PROHIBITED "ackMessage: ContactConnection"
     NewConnection _ -> throwE $ CMD PROHIBITED "ackMessage: NewConnection"
   where
@@ -1566,7 +1566,7 @@ abortConnectionSwitch' c connId =
                   let rqs'' = updatedQs rq' rqs'
                       conn' = DuplexConnection cData rqs'' sqs
                   pure $ connectionStats conn'
-                _ -> throwError $ INTERNAL "won't delete all rcv queues in connection"
+                _ -> throwE $ INTERNAL "won't delete all rcv queues in connection"
           | otherwise -> throwE $ CMD PROHIBITED "abortConnectionSwitch: no rcv queues left"
         _ -> throwE $ CMD PROHIBITED "abortConnectionSwitch: not allowed"
       _ -> throwE $ CMD PROHIBITED "abortConnectionSwitch: not duplex"
@@ -1596,7 +1596,7 @@ ackQueueMessage :: AgentClient -> RcvQueue -> SMP.MsgId -> AM ()
 ackQueueMessage c rq srvMsgId =
   sendAck c rq srvMsgId `catchAgentError` \case
     SMP _ SMP.NO_MSG -> pure ()
-    e -> throwError e
+    e -> throwE e
 
 -- | Suspend SMP agent connection (OFF command) in Reader monad
 suspendConnection' :: AgentClient -> ConnId -> AM ()
@@ -1606,7 +1606,7 @@ suspendConnection' c connId = withConnLock c connId "suspendConnection" $ do
     DuplexConnection _ rqs _ -> mapM_ (suspendQueue c) rqs
     RcvConnection _ rq -> suspendQueue c rq
     ContactConnection _ rq -> suspendQueue c rq
-    SndConnection _ _ -> throwError $ CONN SIMPLEX
+    SndConnection _ _ -> throwE $ CONN SIMPLEX
     NewConnection _ -> throwE $ CMD PROHIBITED "suspendConnection"
 
 -- | Delete SMP agent connection (DEL command) in Reader monad
@@ -1818,7 +1818,7 @@ registerNtfToken' c suppliedDeviceToken suppliedNtfMode =
           ns <- asks ntfSupervisor
           tryReplace ns `catchAgentError` \e ->
             if temporaryOrHostError e
-              then throwError e
+              then throwE e
               else do
                 withStore' c $ \db -> removeNtfToken db tkn
                 atomically $ nsRemoveNtfToken ns
@@ -1906,7 +1906,7 @@ toggleConnectionNtfs' c connId enable = do
     DuplexConnection cData _ _ -> toggle cData
     RcvConnection cData _ -> toggle cData
     ContactConnection cData _ -> toggle cData
-    _ -> throwError $ CONN SIMPLEX
+    _ -> throwE $ CONN SIMPLEX
   where
     toggle :: ConnData -> AM ()
     toggle cData
@@ -1926,7 +1926,7 @@ deleteToken_ c tkn@NtfToken {ntfTokenId, ntfTknStatus} = do
     atomically $ nsUpdateToken ns tkn {ntfTknStatus, ntfTknAction}
     agentNtfDeleteToken c tknId tkn `catchAgentError` \case
       NTF _ AUTH -> pure ()
-      e -> throwError e
+      e -> throwE e
   withStore' c $ \db -> removeNtfToken db tkn
   atomically $ nsRemoveNtfToken ns
 
@@ -1946,8 +1946,8 @@ withToken c tkn@NtfToken {deviceToken, ntfMode} from_ (toStatus, toAction_) f =
       withStore' c $ \db -> removeNtfToken db tkn
       atomically $ nsRemoveNtfToken ns
       void $ registerNtfToken' c deviceToken ntfMode
-      throwError e
-    Left e -> throwError e
+      throwE e
+    Left e -> throwE e
 
 initializeNtfSubs :: AgentClient -> AM ()
 initializeNtfSubs c = sendNtfConnCommands c NSCCreate
@@ -2179,7 +2179,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                 clientMsg@SMP.ClientMsgEnvelope {cmHeader = SMP.PubHeader phVer e2ePubKey_} <-
                   parseMessage msgBody
                 clientVRange <- asks $ smpClientVRange . config
-                unless (phVer `isCompatible` clientVRange) . throwError $ AGENT A_VERSION
+                unless (phVer `isCompatible` clientVRange) . throwE $ AGENT A_VERSION
                 case (e2eDhSecret, e2ePubKey_) of
                   (Nothing, Just e2ePubKey) -> do
                     let e2eDh = C.dh' e2ePubKey e2ePrivKey
@@ -2275,7 +2275,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                           checkDuplicateHash :: AgentErrorType -> ByteString -> AM ()
                           checkDuplicateHash e encryptedMsgHash =
                             unlessM (withStore' c $ \db -> checkRcvMsgHashExists db connId encryptedMsgHash) $
-                              throwError e
+                              throwE e
                           updateTotalMsgCount :: STM ()
                           updateTotalMsgCount =
                             TM.lookup connId (msgCounts c) >>= \case
@@ -2368,7 +2368,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
             -- aVRange <- asks $ smpAgentVRange . config
             -- if agentVersion agentEnvelope `isCompatible` aVRange
             --   then pure (privHeader, agentEnvelope)
-            --   else throwError $ AGENT A_VERSION
+            --   else throwE $ AGENT A_VERSION
             pure (privHeader, agentEnvelope)
 
           parseMessage :: Encoding a => ByteString -> AM a
@@ -2381,12 +2381,12 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
             let ConnData {pqSupport} = toConnData conn'
             unless
               (agentVersion `isCompatible` smpAgentVRange && smpClientVersion `isCompatible` smpClientVRange)
-              (throwError $ AGENT A_VERSION)
+              (throwE $ AGENT A_VERSION)
             case status of
               New -> case (conn', e2eEncryption) of
                 -- party initiating connection
                 (RcvConnection _ _, Just (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _))) -> do
-                  unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwError $ AGENT A_VERSION)
+                  unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwE $ AGENT A_VERSION)
                   (pk1, rcDHRs, pKem) <- withStore c (`getRatchetX3dhKeys` connId)
                   rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 rcDHRs pKem e2eSndParams
                   let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange}
@@ -2482,7 +2482,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
           qAddMsg :: SMP.MsgId -> NonEmpty (SMPQueueUri, Maybe SndQAddr) -> Connection 'CDuplex -> AM ()
           qAddMsg _ ((_, Nothing) :| _) _ = qError "adding queue without switching is not supported"
           qAddMsg srvMsgId ((qUri, Just addr) :| _) (DuplexConnection cData' rqs sqs) = do
-            when (ratchetSyncSendProhibited cData') $ throwError $ AGENT (A_QUEUE "ratchet is not synchronized")
+            when (ratchetSyncSendProhibited cData') $ throwE $ AGENT (A_QUEUE "ratchet is not synchronized")
             clientVRange <- asks $ smpClientVRange . config
             case qUri `compatibleVersion` clientVRange of
               Just qInfo@(Compatible sqInfo@SMPQueueInfo {queueAddress}) ->
@@ -2509,14 +2509,14 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                           _ -> qError "absent sender keys"
                       _ -> qError "QADD: won't delete all snd queues in connection"
                   _ -> qError "QADD: replaced queue address is not found in connection"
-              _ -> throwError $ AGENT A_VERSION
+              _ -> throwE $ AGENT A_VERSION
 
           -- processed by queue recipient
           qKeyMsg :: SMP.MsgId -> NonEmpty (SMPQueueInfo, SndPublicAuthKey) -> Connection 'CDuplex -> AM ()
           qKeyMsg srvMsgId ((qInfo, senderKey) :| _) conn'@(DuplexConnection cData' rqs _) = do
-            when (ratchetSyncSendProhibited cData') $ throwError $ AGENT (A_QUEUE "ratchet is not synchronized")
+            when (ratchetSyncSendProhibited cData') $ throwE $ AGENT (A_QUEUE "ratchet is not synchronized")
             clientVRange <- asks $ smpClientVRange . config
-            unless (qInfo `isCompatible` clientVRange) . throwError $ AGENT A_VERSION
+            unless (qInfo `isCompatible` clientVRange) . throwE $ AGENT A_VERSION
             case findRQ (smpServer, senderId) rqs of
               Just rq'@RcvQueue {rcvId, e2ePrivKey = dhPrivKey, smpClientVersion = cVer, status = status'}
                 | status' == New || status' == Confirmed -> do
@@ -2536,7 +2536,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
           qUseMsg :: SMP.MsgId -> NonEmpty ((SMPServer, SMP.SenderId), Bool) -> Connection 'CDuplex -> AM ()
           -- NOTE: does not yet support the change of the primary status during the rotation
           qUseMsg srvMsgId ((addr, _primary) :| _) (DuplexConnection cData' rqs sqs) = do
-            when (ratchetSyncSendProhibited cData') $ throwError $ AGENT (A_QUEUE "ratchet is not synchronized")
+            when (ratchetSyncSendProhibited cData') $ throwE $ AGENT (A_QUEUE "ratchet is not synchronized")
             case findQ addr sqs of
               Just sq'@SndQueue {dbReplaceQueueId = Just replaceQId} -> do
                 case find ((replaceQId ==) . dbQId) sqs of
@@ -2555,7 +2555,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
               _ -> qError "QUSE: switched queue address not found in connection"
 
           qError :: String -> AM a
-          qError = throwError . AGENT . A_QUEUE
+          qError = throwE . AGENT . A_QUEUE
 
           ereadyMsg :: CR.RatchetX448 -> Connection 'CDuplex -> AM ()
           ereadyMsg rcPrev (DuplexConnection cData'@ConnData {lastExternalSndId} _ sqs) = do
@@ -2591,7 +2591,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
           newRatchetKey e2eOtherPartyParams@(CR.E2ERatchetParams e2eVersion k1Rcv k2Rcv _) conn'@(DuplexConnection cData'@ConnData {lastExternalSndId, pqSupport} _ sqs) =
             unlessM ratchetExists $ do
               AgentConfig {e2eEncryptVRange} <- asks config
-              unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwError $ AGENT A_VERSION)
+              unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwE $ AGENT A_VERSION)
               keys <- getSendRatchetKeys
               let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange}
               initRatchet rcVs keys
@@ -2616,7 +2616,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                   -- can communicate for other client to reset to RSRequired
                   -- - need to add new AgentMsgEnvelope, AgentMessage, AgentMessageType
                   -- - need to deduplicate on receiving side
-                  throwError $ AGENT (A_CRYPTO RATCHET_SYNC)
+                  throwE $ AGENT (A_CRYPTO RATCHET_SYNC)
                 where
                   sendReplyKey = do
                     g <- asks random
@@ -2671,7 +2671,7 @@ checkSQSwchStatus sq@SndQueue {sndSwchStatus} expected =
 
 switchStatusError :: (SMPQueueRec q, Show a) => q -> a -> Maybe a -> AM ()
 switchStatusError q expected actual =
-  throwError . INTERNAL $
+  throwE . INTERNAL $
     ("unexpected switch status, queueId=" <> show (queueId q))
       <> (", expected=" <> show expected)
       <> (", actual=" <> show actual)
@@ -2680,7 +2680,7 @@ connectReplyQueues :: AgentClient -> ConnData -> ConnInfo -> NonEmpty SMPQueueIn
 connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo (qInfo :| _) = do
   clientVRange <- asks $ smpClientVRange . config
   case qInfo `proveCompatible` clientVRange of
-    Nothing -> throwError $ AGENT A_VERSION
+    Nothing -> throwE $ AGENT A_VERSION
     Just qInfo' -> do
       sq <- lift $ newSndQueue userId connId qInfo'
       sq' <- withStore c $ \db -> upgradeRcvConnToDuplex db connId sq
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index e18888244..c28c95a0f 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -586,7 +586,7 @@ instance ProtocolServerClient XFTPVersion XFTPErrorType FileResponse where
 
 getSMPServerClient :: AgentClient -> SMPTransportSession -> AM SMPConnectedClient
 getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
-  unlessM (readTVarIO active) . throwError $ INACTIVE
+  unlessM (readTVarIO active) . throwE $ INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess smpClients ts)
     >>= either newClient (waitForProtocolClient c tSess smpClients)
@@ -597,7 +597,7 @@ getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
 
 getSMPProxyClient :: AgentClient -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
 getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq} destSess@(userId, destSrv, qId) = do
-  unlessM (readTVarIO active) . throwError $ INACTIVE
+  unlessM (readTVarIO active) . throwE $ INACTIVE
   proxySrv <- getNextServer c userId [destSrv]
   ts <- liftIO getCurrentTime
   atomically (getClientVar proxySrv ts) >>= \(tSess, auth, v) ->
@@ -652,7 +652,7 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
 smpConnectClient :: AgentClient -> SMPTransportSession -> TMap SMPServer ProxiedRelayVar -> SMPClientVar -> AM SMPConnectedClient
 smpConnectClient c@AgentClient {smpClients, msgQ} tSess@(_, srv, _) prs v =
   newProtocolClient c tSess smpClients connectClient v
-    `catchAgentError` \e -> lift (resubscribeSMPSession c tSess) >> throwError e
+    `catchAgentError` \e -> lift (resubscribeSMPSession c tSess) >> throwE e
   where
     connectClient :: SMPClientVar -> AM SMPConnectedClient
     connectClient v' = do
@@ -748,7 +748,7 @@ reconnectSMPClient c tSess@(_, srv, _) qs = handleNotify $ do
 
 getNtfServerClient :: AgentClient -> NtfTransportSession -> AM NtfClient
 getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(userId, srv, _) = do
-  unlessM (readTVarIO active) . throwError $ INACTIVE
+  unlessM (readTVarIO active) . throwE $ INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess ntfClients ts)
     >>= either
@@ -772,7 +772,7 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(userId,
 
 getXFTPServerClient :: AgentClient -> XFTPTransportSession -> AM XFTPClient
 getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(userId, srv, _) = do
-  unlessM (readTVarIO active) . throwError $ INACTIVE
+  unlessM (readTVarIO active) . throwE $ INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess xftpClients ts)
     >>= either
@@ -988,7 +988,7 @@ withClient_ c tSess@(userId, srv, _) statCmd action = do
     logServerError cl e = do
       logServer "<--" c srv "" $ strEncode e
       stat cl $ strEncode e
-      throwError e
+      throwE e
 
 withProxySession :: AgentClient -> SMPTransportSession -> SMP.SenderId -> ByteString -> ((SMPConnectedClient, ProxiedRelay) -> AM a) -> AM a
 withProxySession c destSess@(userId, destSrv, _) entId cmdStr action = do
@@ -1007,7 +1007,7 @@ withProxySession c destSess@(userId, destSrv, _) entId cmdStr action = do
     logServerError cl e = do
       logServer ("<-- " <> proxySrv cl <> " <") c destSrv "" $ strEncode e
       stat cl $ strEncode e
-      throwError e
+      throwE e
 
 withLogClient_ :: ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> EntityId -> ByteString -> (Client msg -> AM a) -> AM a
 withLogClient_ c tSess@(_, srv, _) entId cmdStr action = do
@@ -1192,7 +1192,7 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
           liftError (testErr TSUploadFile) $ X.uploadXFTPChunk xftp spKey sId chunkSpec
           liftError (testErr TSDownloadFile) $ X.downloadXFTPChunk g xftp rpKey rId $ XFTPRcvChunkSpec rcvPath chSize digest
           rcvDigest <- liftIO $ C.sha256Hash <$> B.readFile rcvPath
-          unless (digest == rcvDigest) $ throwError $ ProtocolTestFailure TSCompareFile $ XFTP (B.unpack $ strEncode srv) DIGEST
+          unless (digest == rcvDigest) $ throwE $ ProtocolTestFailure TSCompareFile $ XFTP (B.unpack $ strEncode srv) DIGEST
           liftError (testErr TSDeleteFile) $ X.deleteXFTPChunk xftp spKey sId
         ok <- tcpTimeout xftpNetworkConfig `timeout` X.closeXFTPClient xftp
         incClientStat c userId xftp "XFTP_TEST" "OK"
@@ -1486,7 +1486,7 @@ sendConfirmation c sq@SndQueue {userId, server, sndId, sndPublicKey = Just sndPu
   let clientMsg = SMP.ClientMessage (SMP.PHConfirmation sndPublicKey) agentConfirmation
   msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
   sendOrProxySMPMessage c userId server "<CONF>" Nothing sndId (MsgFlags {notification = True}) msg
-sendConfirmation _ _ _ = throwError $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
+sendConfirmation _ _ _ = throwE $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
 
 sendInvitation :: AgentClient -> UserId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM (Maybe SMPServer)
 sendInvitation c userId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) connReq connInfo = do
@@ -1657,7 +1657,7 @@ xftpRcvKeys n = do
   rKeys <- atomically . replicateM n . C.generateAuthKeyPair C.SEd25519 =<< asks random
   case L.nonEmpty rKeys of
     Just rKeys' -> pure rKeys'
-    _ -> throwError $ INTERNAL "non-positive number of recipients"
+    _ -> throwE $ INTERNAL "non-positive number of recipients"
 
 xftpRcvIdsKeys :: NonEmpty ByteString -> NonEmpty C.AAuthKeyPair -> NonEmpty (ChunkReplicaId, C.APrivateAuthKey)
 xftpRcvIdsKeys rIds rKeys = L.map ChunkReplicaId rIds `L.zip` L.map snd rKeys
@@ -1895,7 +1895,7 @@ withUserServers :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient
 withUserServers c userId action =
   atomically (TM.lookup userId $ userServers c) >>= \case
     Just srvs -> action srvs
-    _ -> throwError $ INTERNAL "unknown userId - no user servers"
+    _ -> throwE $ INTERNAL "unknown userId - no user servers"
 
 withNextSrv :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> TVar [ProtocolServer p] -> [ProtocolServer p] -> (ProtoServerWithAuth p -> AM a) -> AM a
 withNextSrv c userId usedSrvs initUsed action = do
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 6c2c5906d..a8b18c5b7 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -225,6 +225,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -1045,7 +1046,7 @@ getWorkItem :: Show i => ByteString -> IO (Maybe i) -> (i -> IO (Either StoreErr
 getWorkItem itemName getId getItem markFailed =
   runExceptT $ handleErr "getId" getId >>= mapM tryGetItem
   where
-    tryGetItem itemId = ExceptT (getItem itemId) `catchStoreErrors` \e -> mark itemId >> throwError e
+    tryGetItem itemId = ExceptT (getItem itemId) `catchStoreErrors` \e -> mark itemId >> throwE e
     mark itemId = handleErr ("markFailed ID " <> bshow itemId) $ markFailed itemId
     catchStoreErrors = catchAllErrors (SEInternal . bshow)
     -- Errors caught by this function will suspend worker as if there is no more work,
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 56ebf7a3f..e4413d595 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -933,8 +933,8 @@ forwardSMPMessage :: SMPClient -> CorrId -> VersionSMP -> C.PublicKeyX25519 -> E
 forwardSMPMessage c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdVersion fwdKey fwdTransmission = do
   -- prepare params
   sessSecret <- case thAuth thParams of
-    Nothing -> throwError $ PCETransportError TENoServerAuth
-    Just THAuthClient {sessSecret} -> maybe (throwError $ PCETransportError TENoServerAuth) pure sessSecret
+    Nothing -> throwE $ PCETransportError TENoServerAuth
+    Just THAuthClient {sessSecret} -> maybe (throwE $ PCETransportError TENoServerAuth) pure sessSecret
   nonce <- liftIO . atomically $ C.randomCbNonce g
   -- wrap
   let fwdT = FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission}
diff --git a/src/Simplex/Messaging/Crypto/File.hs b/src/Simplex/Messaging/Crypto/File.hs
index 9608d21b7..3ab491946 100644
--- a/src/Simplex/Messaging/Crypto/File.hs
+++ b/src/Simplex/Messaging/Crypto/File.hs
@@ -23,6 +23,7 @@ where
 import Control.Exception
 import Control.Monad
 import Control.Monad.Except
+import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.ByteArray as BA
@@ -56,10 +57,10 @@ readFile (CryptoFile path cfArgs) = do
   case cfArgs of
     Just (CFArgs (C.SbKey key) (C.CbNonce nonce)) -> do
       let len = LB.length s - fromIntegral C.authTagSize
-      when (len < 0) $ throwError FTCEInvalidFileSize
+      when (len < 0) $ throwE FTCEInvalidFileSize
       let (s', tag') = LB.splitAt len s
       (tag :| cs) <- liftEitherWith FTCECryptoError $ LC.secretBox LC.sbDecryptChunk key nonce s'
-      unless (BA.constEq (LB.toStrict tag') tag) $ throwError FTCEInvalidAuthTag
+      unless (BA.constEq (LB.toStrict tag') tag) $ throwE FTCEInvalidAuthTag
       pure $ LB.fromChunks cs
     Nothing -> pure s
 
@@ -96,7 +97,7 @@ hGetTag :: CryptoFileHandle -> ExceptT FTCryptoError IO ()
 hGetTag (CFHandle h sb_) = forM_ sb_ $ \sb -> do
   tag <- liftIO $ B.hGet h C.authTagSize
   tag' <- LC.sbAuth <$> readTVarIO sb
-  unless (BA.constEq tag tag') $ throwError FTCEInvalidAuthTag
+  unless (BA.constEq tag tag') $ throwE FTCEInvalidAuthTag
 
 data FTCryptoError
   = FTCECryptoError C.CryptoError
diff --git a/src/Simplex/Messaging/Crypto/Ratchet.hs b/src/Simplex/Messaging/Crypto/Ratchet.hs
index 14f567820..148d931a9 100644
--- a/src/Simplex/Messaging/Crypto/Ratchet.hs
+++ b/src/Simplex/Messaging/Crypto/Ratchet.hs
@@ -447,7 +447,7 @@ pqX3dhRcv rpk1 rpk2 rpKem_ (E2ERatchetParams v sk1 sk2 sKem_) = do
         Just (PrivateRKParamsProposed ks@(_, pk)) -> do
           shared <- liftIO $ sntrup761Dec ct pk
           pure $ Just (ks, RatchetKEMAccepted k' shared ct)
-        Nothing -> throwError CERatchetKEMState
+        Nothing -> throwE CERatchetKEMState
       _ -> pure Nothing -- both parties can send "proposal" in case of ratchet renegotiation
 
 pqX3dh :: DhAlgorithm a => (PublicKey a, PublicKey a) -> DhSecret a -> DhSecret a -> DhSecret a -> Maybe RatchetKEMAccepted -> RatchetInitParams
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index 151f5e044..2632ff4b4 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -15,6 +15,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
 import Crypto.Hash.Algorithms (SHA256 (..))
 import qualified Crypto.PubKey.ECC.ECDSA as EC
 import qualified Crypto.PubKey.ECC.Types as ECT
@@ -353,18 +354,18 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {toke
       | status == Just N.ok200 = pure ()
       | status == Just N.badRequest400 =
           case reason' of
-            "BadDeviceToken" -> throwError PPTokenInvalid
-            "DeviceTokenNotForTopic" -> throwError PPTokenInvalid
-            "TopicDisallowed" -> throwError PPPermanentError
+            "BadDeviceToken" -> throwE PPTokenInvalid
+            "DeviceTokenNotForTopic" -> throwE PPTokenInvalid
+            "TopicDisallowed" -> throwE PPPermanentError
             _ -> err status reason'
       | status == Just N.forbidden403 = case reason' of
-          "ExpiredProviderToken" -> throwError PPPermanentError -- there should be no point retrying it as the token was refreshed
-          "InvalidProviderToken" -> throwError PPPermanentError
+          "ExpiredProviderToken" -> throwE PPPermanentError -- there should be no point retrying it as the token was refreshed
+          "InvalidProviderToken" -> throwE PPPermanentError
           _ -> err status reason'
-      | status == Just N.gone410 = throwError PPTokenInvalid
-      | status == Just N.serviceUnavailable503 = liftIO (disconnectApnsHTTP2Client c) >> throwError PPRetryLater
+      | status == Just N.gone410 = throwE PPTokenInvalid
+      | status == Just N.serviceUnavailable503 = liftIO (disconnectApnsHTTP2Client c) >> throwE PPRetryLater
       -- Just tooManyRequests429 -> TooManyRequests - too many requests for the same token
       | otherwise = err status reason'
     err :: Maybe Status -> Text -> ExceptT PushProviderError IO ()
-    err s r = throwError $ PPResponseError s r
+    err s r = throwE $ PPResponseError s r
     liftHTTPS2 a = ExceptT $ first PPConnection <$> a
diff --git a/src/Simplex/Messaging/Notifications/Transport.hs b/src/Simplex/Messaging/Notifications/Transport.hs
index 077ce634e..77a598c5c 100644
--- a/src/Simplex/Messaging/Notifications/Transport.hs
+++ b/src/Simplex/Messaging/Notifications/Transport.hs
@@ -116,7 +116,7 @@ ntfServerHandshake serverSignKey c (k, pk) kh ntfVRange = do
   getHandshake th >>= \case
     NtfClientHandshake {ntfVersion = v, keyHash}
       | keyHash /= kh ->
-          throwError $ TEHandshake IDENTITY
+          throwE $ TEHandshake IDENTITY
       | otherwise ->
           case compatibleVRange' ntfVersionRange v of
             Just (Compatible vr) -> pure $ ntfThHandleServer th v vr pk
@@ -128,7 +128,7 @@ ntfClientHandshake c keyHash ntfVRange = do
   let th@THandle {params = THandleParams {sessionId}} = ntfTHandle c
   NtfServerHandshake {sessionId = sessId, ntfVersionRange, authPubKey = sk'} <- getHandshake th
   if sessionId /= sessId
-    then throwError TEBadSession
+    then throwE TEBadSession
     else case ntfVersionRange `compatibleVRange` ntfVRange of
       Just (Compatible vr) -> do
         ck_ <- forM sk' $ \signedKey -> liftEitherWith (const $ TEHandshake BAD_AUTH) $ do
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index ef2cc6933..37557cd23 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -7,6 +7,7 @@ import qualified Control.Exception as E
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
+import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -114,11 +115,11 @@ catchAllErrors' err action handler = tryAllErrors' err action >>= either handler
 {-# INLINE catchAllErrors' #-}
 
 catchThrow :: MonadUnliftIO m => ExceptT e m a -> (E.SomeException -> e) -> ExceptT e m a
-catchThrow action err = catchAllErrors err action throwError
+catchThrow action err = catchAllErrors err action throwE
 {-# INLINE catchThrow #-}
 
 allFinally :: MonadUnliftIO m => (E.SomeException -> e) -> ExceptT e m a -> ExceptT e m b -> ExceptT e m a
-allFinally err action final = tryAllErrors err action >>= \r -> final >> either throwError pure r
+allFinally err action final = tryAllErrors err action >>= \r -> final >> either throwE pure r
 {-# INLINE allFinally #-}
 
 eitherToMaybe :: Either a b -> Maybe b
@@ -149,7 +150,7 @@ safeDecodeUtf8 = decodeUtf8With onError
     onError _ _ = Just '?'
 
 timeoutThrow :: MonadUnliftIO m => e -> Int -> ExceptT e m a -> ExceptT e m a
-timeoutThrow e ms action = ExceptT (sequence <$> (ms `timeout` runExceptT action)) >>= maybe (throwError e) pure
+timeoutThrow e ms action = ExceptT (sequence <$> (ms `timeout` runExceptT action)) >>= maybe (throwE e) pure
 
 threadDelay' :: Int64 -> IO ()
 threadDelay' = loop
diff --git a/src/Simplex/RemoteControl/Client.hs b/src/Simplex/RemoteControl/Client.hs
index 9ef1f820a..a21630454 100644
--- a/src/Simplex/RemoteControl/Client.hs
+++ b/src/Simplex/RemoteControl/Client.hs
@@ -30,6 +30,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
 import Data.ByteString (ByteString)
@@ -106,9 +107,9 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct
   action <- liftIO $ runClient c r hostKeys
   -- wait for the port to make invitation
   portNum <- atomically $ readTMVar startedPort
-  signedInv@RCSignedInvitation {invitation} <- maybe (throwError RCETLSStartFailed) (liftIO . mkInvitation hostKeys address) portNum
+  signedInv@RCSignedInvitation {invitation} <- maybe (throwE RCETLSStartFailed) (liftIO . mkInvitation hostKeys address) portNum
   when multicast $ case knownHost of
-    Nothing -> throwError RCENewController
+    Nothing -> throwE RCENewController
     Just KnownHostPairing {hostDhPubKey} -> do
       ann <- liftIO . async . runExceptT $ announceRC drg 60 idPrivKey hostDhPubKey hostKeys invitation
       atomically $ putTMVar announcer ann
@@ -117,7 +118,7 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct
     findCtrlAddress :: ExceptT RCErrorType IO (NonEmpty RCCtrlAddress)
     findCtrlAddress = do
       found' <- liftIO $ getLocalAddress rcAddrPrefs_
-      maybe (throwError RCENoLocalAddress) pure $ L.nonEmpty found'
+      maybe (throwE RCENoLocalAddress) pure $ L.nonEmpty found'
     mkClient :: IO RCHClient_
     mkClient = do
       startedPort <- newEmptyTMVarIO
@@ -211,10 +212,10 @@ prepareHostSession
     let sharedKey = C.dh' dhPubKey dhPrivKey
     helloBody <- liftEitherWith (const RCEDecrypt) $ C.cbDecrypt sharedKey nonce encBody
     hostHello@RCHostHello {v, ca, kem = kemPubKey} <- liftEitherWith RCESyntax $ J.eitherDecodeStrict helloBody
-    unless (ca == tlsHostFingerprint) $ throwError RCEIdentity
+    unless (ca == tlsHostFingerprint) $ throwE RCEIdentity
     (kemCiphertext, kemSharedKey) <- liftIO $ sntrup761Enc drg kemPubKey
     let hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey
-    unless (isCompatible v supportedRCPVRange) $ throwError RCEVersion
+    unless (isCompatible v supportedRCPVRange) $ throwE RCEVersion
     let keys = HostSessKeys {hybridKey, idPrivKey, sessPrivKey}
     knownHost' <- updateKnownHost ca dhPubKey
     let ctrlHello = RCCtrlHello {}
@@ -227,7 +228,7 @@ prepareHostSession
       updateKnownHost :: C.KeyHash -> C.PublicKeyX25519 -> ExceptT RCErrorType IO KnownHostPairing
       updateKnownHost ca hostDhPubKey = case knownHost_ of
         Just h -> do
-          unless (hostFingerprint h == tlsHostFingerprint) . throwError $
+          unless (hostFingerprint h == tlsHostFingerprint) . throwE $
             RCEInternal "TLS host CA is different from host pairing, should be caught in TLS handshake"
           pure (h :: KnownHostPairing) {hostDhPubKey}
         Nothing -> pure KnownHostPairing {hostFingerprint = ca, hostDhPubKey}
@@ -257,7 +258,7 @@ connectRCCtrl drg (RCVerifiedInvitation inv@RCInvitation {ca, idkey}) pairing_ h
       pure RCCtrlPairing {caKey, caCert, ctrlFingerprint = ca, idPubKey = idkey, dhPrivKey, prevDhPrivKey = Nothing}
     updateCtrlPairing :: RCCtrlPairing -> ExceptT RCErrorType IO RCCtrlPairing
     updateCtrlPairing pairing@RCCtrlPairing {ctrlFingerprint, idPubKey, dhPrivKey = currDhPrivKey} = do
-      unless (ca == ctrlFingerprint && idPubKey == idkey) $ throwError RCEIdentity
+      unless (ca == ctrlFingerprint && idPubKey == idkey) $ throwE RCEIdentity
       (_, dhPrivKey) <- atomically $ C.generateKeyPair drg
       pure pairing {dhPrivKey, prevDhPrivKey = Just currDhPrivKey}
 
@@ -278,7 +279,7 @@ connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca,
       clientCredentials <-
         liftIO (genTLSCredentials drg caKey caCert) >>= \case
           TLS.Credentials (creds : _) -> pure $ Just creds
-          _ -> throwError $ RCEInternal "genTLSCredentials must generate credentials"
+          _ -> throwE $ RCEInternal "genTLSCredentials must generate credentials"
       let clientConfig = defaultTransportClientConfig {clientCredentials}
       ExceptT . runTransportClient clientConfig Nothing host (show port) (Just ca) $ \tls@TLS {tlsBuffer, tlsContext} -> runExceptT $ do
         -- pump socket to detect connection problems
@@ -307,7 +308,7 @@ catchRCError = catchAllErrors (RCEException . show)
 {-# INLINE catchRCError #-}
 
 putRCError :: ExceptT RCErrorType IO a -> TMVar (Either RCErrorType b) -> ExceptT RCErrorType IO a
-a `putRCError` r = a `catchRCError` \e -> atomically (tryPutTMVar r $ Left e) >> throwError e
+a `putRCError` r = a `catchRCError` \e -> atomically (tryPutTMVar r $ Left e) >> throwE e
 
 sendRCPacket :: Encoding a => TLS -> a -> ExceptT RCErrorType IO ()
 sendRCPacket tls pkt = do
@@ -317,7 +318,7 @@ sendRCPacket tls pkt = do
 receiveRCPacket :: Encoding a => TLS -> ExceptT RCErrorType IO a
 receiveRCPacket tls = do
   b <- liftIO $ cGet tls xrcpBlockSize
-  when (B.length b /= xrcpBlockSize) $ throwError RCEBlockSize
+  when (B.length b /= xrcpBlockSize) $ throwE RCEBlockSize
   b' <- liftEitherWith (const RCEBlockSize) $ C.unPad b
   liftEitherWith RCESyntax $ smpDecode b'
 
@@ -329,7 +330,7 @@ prepareHostHello
   hostAppInfo = do
     logDebug "Preparing session"
     case compatibleVersion v supportedRCPVRange of
-      Nothing -> throwError RCEVersion
+      Nothing -> throwE RCEVersion
       Just (Compatible v') -> do
         nonce <- liftIO . atomically $ C.randomCbNonce drg
         (kemPubKey, kemPrivKey) <- liftIO $ sntrup761Keypair drg
@@ -355,7 +356,7 @@ prepareCtrlSession
       pure CtrlSessKeys {hybridKey, idPubKey, sessPubKey = skey}
     RCCtrlEncError {nonce, encMessage} -> do
       message <- liftEitherWith (const RCEDecrypt) $ C.cbDecrypt sharedKey nonce encMessage
-      throwError $ RCECtrlError $ T.unpack $ safeDecodeUtf8 message
+      throwE $ RCECtrlError $ T.unpack $ safeDecodeUtf8 message
 
 -- * Multicast discovery
 
@@ -382,7 +383,7 @@ discoverRCCtrl subscribers pairings =
       r@(_, RCVerifiedInvitation RCInvitation {host}) <- findRCCtrlPairing pairings encInvitation
       case source of
         SockAddrInet _ ha | THIPv4 (hostAddressToTuple ha) == host -> pure ()
-        _ -> throwError RCEInvitation
+        _ -> throwE RCEInvitation
       pure r
   where
     loop :: ExceptT RCErrorType IO a -> ExceptT RCErrorType IO a
@@ -392,8 +393,8 @@ findRCCtrlPairing :: NonEmpty RCCtrlPairing -> RCEncInvitation -> ExceptT RCErro
 findRCCtrlPairing pairings RCEncInvitation {dhPubKey, nonce, encInvitation} = do
   (pairing, signedInvStr) <- liftEither $ decrypt (L.toList pairings)
   signedInv <- liftEitherWith RCESyntax $ strDecode signedInvStr
-  inv@(RCVerifiedInvitation RCInvitation {dh = invDh}) <- maybe (throwError RCEInvitation) pure $ verifySignedInvitation signedInv
-  unless (invDh == dhPubKey) $ throwError RCEInvitation
+  inv@(RCVerifiedInvitation RCInvitation {dh = invDh}) <- maybe (throwE RCEInvitation) pure $ verifySignedInvitation signedInv
+  unless (invDh == dhPubKey) $ throwE RCEInvitation
   pure (pairing, inv)
   where
     decrypt :: [RCCtrlPairing] -> Either RCErrorType (RCCtrlPairing, ByteString)
@@ -433,7 +434,7 @@ rcEncryptBody drg hybridKey s = do
 rcDecryptBody :: KEMHybridSecret -> C.CbNonce -> LazyByteString -> ExceptT RCErrorType IO LazyByteString
 rcDecryptBody hybridKey nonce ct = do
   let len = LB.length ct - 16
-  when (len < 0) $ throwError RCEDecrypt
+  when (len < 0) $ throwE RCEDecrypt
   (ok, s) <- liftEitherWith (const RCEDecrypt) $ LC.kcbDecryptTailTag hybridKey nonce len ct
-  unless ok $ throwError RCEDecrypt
+  unless ok $ throwE RCEDecrypt
   pure s
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index c2badea63..25bbdb260 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -2134,7 +2134,7 @@ testSwitchAsync servers = do
     withB = withAgent 2 agentCfg servers testDB2
 
 withAgent :: HasCallStack => Int -> AgentConfig -> InitialAgentServers -> FilePath -> (HasCallStack => AgentClient -> IO a) -> IO a
-withAgent clientId cfg' servers dbPath = bracket (getSMPAgentClient' clientId cfg' servers dbPath) disposeAgentClient
+withAgent clientId cfg' servers dbPath = bracket (getSMPAgentClient' clientId cfg' servers dbPath) (\a -> disposeAgentClient a >> threadDelay 100000)
 
 sessionSubscribe :: (forall a. (AgentClient -> IO a) -> IO a) -> [ConnId] -> (AgentClient -> ExceptT AgentErrorType IO ()) -> IO ()
 sessionSubscribe withC connIds a =

From 3d605310ed1bb4910e4e5f75487277a064e64e66 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 5 Jun 2024 14:34:40 +0100
Subject: [PATCH 002/195] agent: remove protocol encodings and agent TCP server
 (#1189)

* rfc: remove agent protocol encodings

* agent: remove protocol encodings and agent TCP server

* update

* remove unused code

* remove

* move tests

* add delay to tests

* stabilize test

* test

* more delays

* reduce delays

* enable all tests

* delays

* style
---
 package.yaml                                  |   9 -
 rfcs/2024-06-01-agent-protocol.md             |  19 +
 simplexmq.cabal                               |  77 --
 src/Simplex/FileTransfer/Agent.hs             |   4 +-
 src/Simplex/Messaging/Agent.hs                |  90 +-
 src/Simplex/Messaging/Agent/Client.hs         |  49 +-
 .../Messaging/Agent/NtfSubSupervisor.hs       |   4 +-
 src/Simplex/Messaging/Agent/Protocol.hs       | 808 +++---------------
 src/Simplex/Messaging/Agent/Server.hs         |  85 --
 src/Simplex/Messaging/Agent/Store.hs          |  11 +-
 tests/AgentTests.hs                           | 623 +-------------
 tests/AgentTests/FunctionalAPITests.hs        | 299 +++++--
 tests/AgentTests/NotificationTests.hs         |  17 +-
 tests/AgentTests/SQLiteTests.hs               |   2 +-
 tests/CoreTests/ProtocolErrorTests.hs         | 111 ---
 tests/SMPAgentClient.hs                       | 182 +---
 tests/Test.hs                                 |   2 -
 tests/XFTPAgent.hs                            |   2 +-
 18 files changed, 468 insertions(+), 1926 deletions(-)
 create mode 100644 rfcs/2024-06-01-agent-protocol.md
 delete mode 100644 src/Simplex/Messaging/Agent/Server.hs
 delete mode 100644 tests/CoreTests/ProtocolErrorTests.hs

diff --git a/package.yaml b/package.yaml
index 662cf8a0a..ef747da0d 100644
--- a/package.yaml
+++ b/package.yaml
@@ -147,15 +147,6 @@ executables:
       - -threaded
       - -rtsopts
 
-  smp-agent:
-    source-dirs: apps/smp-agent
-    main: Main.hs
-    dependencies:
-      - simplexmq
-    ghc-options:
-      - -threaded
-      - -rtsopts
-
   xftp:
     source-dirs: apps/xftp
     main: Main.hs
diff --git a/rfcs/2024-06-01-agent-protocol.md b/rfcs/2024-06-01-agent-protocol.md
new file mode 100644
index 000000000..616aed33f
--- /dev/null
+++ b/rfcs/2024-06-01-agent-protocol.md
@@ -0,0 +1,19 @@
+# Evolving agent API
+
+## Problem
+
+Historically, agent API started as a TCP protocol with encoding. We do not use the actual protocol and maintaining the encoding complicates the evolution of the API.
+
+Currently, I was trying to add ERRS event to combine multiple subscription errors into one to prevent overloading the UI with processing multiple subscription errors (e.g.):
+
+```haskell
+ERRS :: (ConnId, AgentErrorType) -> ACommand Agent AEConn
+```
+
+This constructor is not possible to encode/parse in a sensible way other than including lengths of errors.
+
+## Proposal
+
+Remove commands type and encodings for commands and events.
+
+Only keep encodings for the commands that are saved to the database: NEW, JOIN, LET, ACK, SWCH, DEL (this one is no longer used but needs to be supported for backwards compatibility).
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 4974e9f75..bbe7583fa 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -95,7 +95,6 @@ library
       Simplex.Messaging.Agent.Protocol
       Simplex.Messaging.Agent.QueryString
       Simplex.Messaging.Agent.RetryInterval
-      Simplex.Messaging.Agent.Server
       Simplex.Messaging.Agent.Store
       Simplex.Messaging.Agent.Store.SQLite
       Simplex.Messaging.Agent.Store.SQLite.Common
@@ -352,81 +351,6 @@ executable ntf-server
       , template-haskell ==2.16.*
       , text >=1.2.3.0 && <1.3
 
-executable smp-agent
-  main-is: Main.hs
-  other-modules:
-      Paths_simplexmq
-  hs-source-dirs:
-      apps/smp-agent
-  default-extensions:
-      StrictData
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
-  build-depends:
-      aeson ==2.2.*
-    , ansi-terminal >=0.10 && <0.12
-    , asn1-encoding ==0.9.*
-    , asn1-types ==0.3.*
-    , async ==2.2.*
-    , attoparsec ==0.14.*
-    , base >=4.14 && <5
-    , base64-bytestring >=1.0 && <1.3
-    , case-insensitive ==1.2.*
-    , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , crypton ==0.34.*
-    , crypton-x509 ==1.7.*
-    , crypton-x509-store ==1.6.*
-    , crypton-x509-validation ==1.6.*
-    , cryptostore ==0.3.*
-    , data-default ==0.7.*
-    , direct-sqlcipher ==2.3.*
-    , directory ==1.3.*
-    , filepath ==1.4.*
-    , hourglass ==0.2.*
-    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
-    , ini ==0.4.1
-    , iproute ==1.7.*
-    , iso8601-time ==0.1.*
-    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
-    , network >=3.1.2.7 && <3.2
-    , network-info ==0.2.*
-    , network-transport ==0.5.6
-    , network-udp ==0.0.*
-    , optparse-applicative >=0.15 && <0.17
-    , process ==1.6.*
-    , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
-    , simplexmq
-    , socks ==0.6.*
-    , sqlcipher-simple ==0.4.*
-    , stm ==2.5.*
-    , temporary ==1.3.*
-    , time ==1.12.*
-    , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
-    , transformers ==0.6.*
-    , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
-    , websockets ==0.12.*
-    , yaml ==0.11.*
-    , zstd ==0.1.3.*
-  default-language: Haskell2010
-  if flag(swift)
-    cpp-options: -DswiftJSON
-  if impl(ghc >= 9.6.2)
-    build-depends:
-        bytestring ==0.11.*
-      , template-haskell ==2.20.*
-      , text >=2.0.1 && <2.2
-  if impl(ghc < 9.6.2)
-    build-depends:
-        bytestring ==0.10.*
-      , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
-
 executable smp-server
   main-is: Main.hs
   other-modules:
@@ -677,7 +601,6 @@ test-suite simplexmq-test
       CoreTests.CryptoFileTests
       CoreTests.CryptoTests
       CoreTests.EncodingTests
-      CoreTests.ProtocolErrorTests
       CoreTests.RetryIntervalTests
       CoreTests.TRcvQueuesTests
       CoreTests.UtilTests
diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 654a83207..8da29d28b 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -324,8 +324,8 @@ xftpDeleteRcvFiles' c rcvFileEntityIds = do
     batchFiles :: (DB.Connection -> DBRcvFileId -> IO a) -> [RcvFile] -> AM' [Either AgentErrorType a]
     batchFiles f rcvFiles = withStoreBatch' c $ \db -> map (\RcvFile {rcvFileId} -> f db rcvFileId) rcvFiles
 
-notify :: forall m e. (MonadIO m, AEntityI e) => AgentClient -> EntityId -> ACommand 'Agent e -> m ()
-notify c entId cmd = atomically $ writeTBQueue (subQ c) ("", entId, APC (sAEntity @e) cmd)
+notify :: forall m e. (MonadIO m, AEntityI e) => AgentClient -> EntityId -> AEvent e -> m ()
+notify c entId cmd = atomically $ writeTBQueue (subQ c) ("", entId, AEvt (sAEntity @e) cmd)
 
 xftpSendFile' :: AgentClient -> UserId -> CryptoFile -> Int -> AM SndFileId
 xftpSendFile' c userId file numRecipients = do
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 07b893b42..7bc638496 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -29,10 +29,7 @@
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md
 module Simplex.Messaging.Agent
-  ( -- * queue-based SMP agent
-    runAgentClient,
-
-    -- * SMP agent functional API
+  ( -- * SMP agent functional API
     AgentClient (..),
     AE,
     SubscriptionsInfo (..),
@@ -185,7 +182,6 @@ import Simplex.RemoteControl.Client
 import Simplex.RemoteControl.Invitation
 import Simplex.RemoteControl.Types
 import System.Mem.Weak (deRefWeak)
-import UnliftIO.Async (race_)
 import UnliftIO.Concurrent (forkFinally, forkIO, killThread, mkWeakThreadId, threadDelay)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
@@ -219,7 +215,7 @@ getSMPAgentClient_ clientId cfg initServers store backgroundMode =
     run AgentClient {subQ, acThread} name a =
       a `E.catchAny` \e -> whenM (isJust <$> readTVarIO acThread) $ do
         logError $ "Agent thread " <> name <> " crashed: " <> tshow e
-        atomically $ writeTBQueue subQ ("", "", APC SAEConn $ ERR $ CRITICAL True $ show e)
+        atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ CRITICAL True $ show e)
 
 disconnectAgentClient :: AgentClient -> IO ()
 disconnectAgentClient c@AgentClient {agentEnv = Env {ntfSupervisor = ns, xftpAgent = xa}} = do
@@ -573,40 +569,6 @@ logConnection c connected =
   let event = if connected then "connected to" else "disconnected from"
    in logInfo $ T.unwords ["client", tshow (clientId c), event, "Agent"]
 
--- | Runs an SMP agent instance that receives commands and sends responses via 'TBQueue's.
-runAgentClient :: AgentClient -> AM' ()
-runAgentClient c = race_ (subscriber c) (client c)
-{-# INLINE runAgentClient #-}
-
-client :: AgentClient -> AM' ()
-client c@AgentClient {rcvQ, subQ} = forever $ do
-  (corrId, entId, cmd) <- atomically $ readTBQueue rcvQ
-  runExceptT (processCommand c (entId, cmd))
-    >>= atomically . writeTBQueue subQ . \case
-      Left e -> (corrId, entId, APC SAEConn $ ERR e)
-      Right (entId', resp) -> (corrId, entId', resp)
-
--- | execute any SMP agent command
-processCommand :: AgentClient -> (EntityId, APartyCmd 'Client) -> AM (EntityId, APartyCmd 'Agent)
-processCommand c (connId, APC e cmd) =
-  second (APC e) <$> case cmd of
-    NEW enableNtfs (ACM cMode) pqIK subMode -> second (INV . ACR cMode) <$> newConn c userId connId enableNtfs cMode Nothing pqIK subMode
-    JOIN enableNtfs (ACR _ cReq) pqEnc subMode connInfo -> (,OK) <$> joinConn c userId connId False enableNtfs cReq connInfo pqEnc subMode
-    LET confId ownCInfo -> allowConnection' c connId confId ownCInfo $> (connId, OK)
-    ACPT invId pqEnc ownCInfo -> (,OK) <$> acceptContact' c connId True invId ownCInfo pqEnc SMSubscribe
-    RJCT invId -> rejectContact' c connId invId $> (connId, OK)
-    SUB -> subscribeConnection' c connId $> (connId, OK)
-    SEND pqEnc msgFlags msgBody -> (connId,) . uncurry MID <$> sendMessage' c connId pqEnc msgFlags msgBody
-    ACK msgId rcptInfo_ -> ackMessage' c connId msgId rcptInfo_ $> (connId, OK)
-    SWCH -> switchConnection' c connId $> (connId, OK)
-    OFF -> suspendConnection' c connId $> (connId, OK)
-    DEL -> deleteConnection' c connId $> (connId, OK)
-    CHK -> (connId,) . STAT <$> getConnectionServers' c connId
-  where
-    -- command interface does not support different users
-    userId :: UserId
-    userId = 1
-
 createUser' :: AgentClient -> NonEmpty SMPServerWithAuth -> NonEmpty XFTPServerWithAuth -> AM UserId
 createUser' c smp xftp = do
   userId <- withStore' c createUserRecord
@@ -623,12 +585,12 @@ deleteUser' c userId delSMPQueues = do
   where
     delUser =
       whenM (withStore' c (`deleteUserWithoutConns` userId)) . atomically $
-        writeTBQueue (subQ c) ("", "", APC SAENone $ DEL_USER userId)
+        writeTBQueue (subQ c) ("", "", AEvt SAENone $ DEL_USER userId)
 
 newConnAsync :: ConnectionModeI c => AgentClient -> UserId -> ACorrId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AM ConnId
 newConnAsync c userId corrId enableNtfs cMode pqInitKeys subMode = do
   connId <- newConnNoQueues c userId "" enableNtfs cMode (CR.connPQEncryption pqInitKeys)
-  enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn $ NEW enableNtfs (ACM cMode) pqInitKeys subMode
+  enqueueCommand c corrId connId Nothing $ AClientCommand $ NEW enableNtfs (ACM cMode) pqInitKeys subMode
   pure connId
 
 newConnNoQueues :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> PQSupport -> AM ConnId
@@ -647,7 +609,7 @@ joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup
         let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v)
             cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
         connId <- withStore c $ \db -> createNewConn db g cData SCMInvitation
-        enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
+        enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
         pure connId
       Nothing -> throwE $ AGENT A_VERSION
 joinConnAsync _c _userId _corrId _enableNtfs (CRContactUri _) _subMode _cInfo _pqEncryption =
@@ -657,7 +619,7 @@ allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> C
 allowConnectionAsync' c corrId connId confId ownConnInfo =
   withStore c (`getConn` connId) >>= \case
     SomeConn _ (RcvConnection _ RcvQueue {server}) ->
-      enqueueCommand c corrId connId (Just server) $ AClientCommand $ APC SAEConn $ LET confId ownConnInfo
+      enqueueCommand c corrId connId (Just server) $ AClientCommand $ LET confId ownConnInfo
     _ -> throwE $ CMD PROHIBITED "allowConnectionAsync"
 
 acceptContactAsync' :: AgentClient -> ACorrId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
@@ -687,7 +649,7 @@ ackMessageAsync' c corrId connId msgId rcptInfo_ = do
       RcvMsg {msgType} <- withStore c $ \db -> getRcvMsg db connId mId
       when (isJust rcptInfo_ && msgType /= AM_A_MSG_) $ throwE $ CMD PROHIBITED "ackMessageAsync: receipt not allowed"
       (RcvQueue {server}, _) <- withStore c $ \db -> setMsgUserAck db connId mId
-      enqueueCommand c corrId connId (Just server) . AClientCommand $ APC SAEConn $ ACK msgId rcptInfo_
+      enqueueCommand c corrId connId (Just server) . AClientCommand $ ACK msgId rcptInfo_
 
 deleteConnectionAsync' :: AgentClient -> Bool -> ConnId -> AM ()
 deleteConnectionAsync' c waitDelivery connId = deleteConnectionsAsync' c waitDelivery [connId]
@@ -717,7 +679,7 @@ switchConnectionAsync' c corrId connId =
         | otherwise -> do
             when (ratchetSyncSendProhibited cData) $ throwE $ CMD PROHIBITED "switchConnectionAsync: send prohibited"
             rq1 <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSwitchStarted
-            enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn SWCH
+            enqueueCommand c corrId connId Nothing $ AClientCommand SWCH
             let rqs' = updatedQs rq1 rqs
             pure . connectionStats $ DuplexConnection cData rqs' sqs
       _ -> throwE $ CMD PROHIBITED "switchConnectionAsync: not duplex"
@@ -984,7 +946,7 @@ subscribeConnections' c connIds = do
       let actual = M.size rs
           expected = length connIds
       when (actual /= expected) . atomically $
-        writeTBQueue (subQ c) ("", "", APC SAEConn $ ERR $ INTERNAL $ "subscribeConnections result size: " <> show actual <> ", expected " <> show expected)
+        writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ INTERNAL $ "subscribeConnections result size: " <> show actual <> ", expected " <> show expected)
 
 resubscribeConnection' :: AgentClient -> ConnId -> AM ()
 resubscribeConnection' c connId = toConnResult connId =<< resubscribeConnections' c [connId]
@@ -1114,7 +1076,7 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
   where
     processCmd :: RetryInterval -> PendingCommand -> AM ()
     processCmd ri PendingCommand {cmdId, corrId, userId, connId, command} = case command of
-      AClientCommand (APC _ cmd) -> case cmd of
+      AClientCommand cmd -> case cmd of
         NEW enableNtfs (ACM cMode) pqEnc subMode -> noServer $ do
           usedSrvs <- newTVarIO ([] :: [SMPServer])
           tryCommand . withNextSrv c userId usedSrvs [] $ \srv -> do
@@ -1223,8 +1185,8 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
         tryWithLock name = tryCommand . withConnLock c connId name
         internalErr s = cmdError $ INTERNAL $ s <> ": " <> show (agentCommandTag command)
         cmdError e = notify (ERR e) >> withStore' c (`deleteCommand` cmdId)
-        notify :: forall e. AEntityI e => ACommand 'Agent e -> AM ()
-        notify cmd = atomically $ writeTBQueue subQ (corrId, connId, APC (sAEntity @e) cmd)
+        notify :: forall e. AEntityI e => AEvent e -> AM ()
+        notify cmd = atomically $ writeTBQueue subQ (corrId, connId, AEvt (sAEntity @e) cmd)
 -- ^ ^ ^ async command processing /
 
 enqueueMessages :: AgentClient -> ConnData -> NonEmpty SndQueue -> MsgFlags -> AMessage -> AM (AgentMsgId, PQEncryption)
@@ -1460,9 +1422,9 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork
     delMsg = delMsgKeep False
     delMsgKeep :: Bool -> InternalId -> AM ()
     delMsgKeep keepForReceipt msgId = withStore' c $ \db -> deleteSndMsgDelivery db connId sq msgId keepForReceipt
-    notify :: forall e. AEntityI e => ACommand 'Agent e -> AM ()
-    notify cmd = atomically $ writeTBQueue subQ ("", connId, APC (sAEntity @e) cmd)
-    notifyDel :: AEntityI e => InternalId -> ACommand 'Agent e -> AM ()
+    notify :: forall e. AEntityI e => AEvent e -> AM ()
+    notify cmd = atomically $ writeTBQueue subQ ("", connId, AEvt (sAEntity @e) cmd)
+    notifyDel :: AEntityI e => InternalId -> AEvent e -> AM ()
     notifyDel msgId cmd = notify cmd >> delMsg msgId
     connError msgId = notifyDel msgId . ERR . CONN
     qError msgId = notifyDel msgId . ERR . AGENT . A_QUEUE
@@ -1663,7 +1625,7 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do
   -- ! between completed deletions of connections, and deletions delayed due to wait for delivery (see deleteConn)
   deliveryTimeout <- if waitDelivery then asks (Just . connDeleteDeliveryTimeout . config) else pure Nothing
   rs' <- lift $ catMaybes . rights <$> withStoreBatch' c (\db -> map (deleteConn db deliveryTimeout) (M.keys delRs))
-  forM_ rs' $ \cId -> notify ("", cId, APC SAEConn DEL_CONN)
+  forM_ rs' $ \cId -> notify ("", cId, AEvt SAEConn DEL_CONN)
   pure (errs' <> delRs, rqs, connIds')
   where
     rcvQueues :: SomeConn -> Either (Either AgentErrorType ()) [RcvQueue]
@@ -1678,7 +1640,7 @@ deleteConnQueues c waitDelivery ntf rqs = do
   let connIds = M.keys $ M.filter isRight rs
   deliveryTimeout <- if waitDelivery then asks (Just . connDeleteDeliveryTimeout . config) else pure Nothing
   rs' <- catMaybes . rights <$> withStoreBatch' c (\db -> map (deleteConn db deliveryTimeout) connIds)
-  forM_ rs' $ \cId -> notify ("", cId, APC SAEConn DEL_CONN)
+  forM_ rs' $ \cId -> notify ("", cId, AEvt SAEConn DEL_CONN)
   pure rs
   where
     deleteQueueRecs :: [(RcvQueue, Either AgentErrorType ())] -> AM' [(RcvQueue, Either AgentErrorType ())]
@@ -1698,7 +1660,7 @@ deleteConnQueues c waitDelivery ntf rqs = do
           Left e
             | temporaryOrHostError e && deleteErrors rq + 1 < maxErrs -> incRcvDeleteErrors db rq $> ((rq, r), Nothing)
             | otherwise -> deleteConnRcvQueue db rq $> ((rq, Right ()), Just (notifyRQ rq (Just e)))
-    notifyRQ rq e_ = notify ("", qConnId rq, APC SAEConn $ DEL_RCVQ (qServer rq) (queueId rq) e_)
+    notifyRQ rq e_ = notify ("", qConnId rq, AEvt SAEConn $ DEL_RCVQ (qServer rq) (queueId rq) e_)
     notify = when ntf . atomically . writeTBQueue (subQ c)
     connResults :: [(RcvQueue, Either AgentErrorType ())] -> Map ConnId (Either AgentErrorType ())
     connResults = M.map snd . foldl' addResult M.empty
@@ -1735,7 +1697,7 @@ deleteConnections_ getConnections ntf waitDelivery c connIds = do
       let actual = M.size rs
           expected = length connIds
       when (actual /= expected) . atomically $
-        writeTBQueue (subQ c) ("", "", APC SAEConn $ ERR $ INTERNAL $ "deleteConnections result size: " <> show actual <> ", expected " <> show expected)
+        writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ INTERNAL $ "deleteConnections result size: " <> show actual <> ", expected " <> show expected)
 
 getConnectionServers' :: AgentClient -> ConnId -> AM ConnectionStats
 getConnectionServers' c connId = do
@@ -1968,7 +1930,7 @@ sendNtfConnCommands c cmd = do
       Just (ConnData {enableNtfs}, _) ->
         when enableNtfs . atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)
       _ ->
-        atomically $ writeTBQueue (subQ c) ("", connId, APC SAEConn $ ERR $ INTERNAL "no connection data")
+        atomically $ writeTBQueue (subQ c) ("", connId, AEvt SAEConn $ ERR $ INTERNAL "no connection data")
 
 setNtfServers :: AgentClient -> [NtfServer] -> IO ()
 setNtfServers c = atomically . writeTVar (ntfServers c)
@@ -2050,7 +2012,7 @@ cleanupManager c@AgentClient {subQ} = do
     run SFERR deleteExpiredReplicasForDeletion
     liftIO $ threadDelay' int
   where
-    run :: forall e. AEntityI e => (AgentErrorType -> ACommand 'Agent e) -> AM () -> AM' ()
+    run :: forall e. AEntityI e => (AgentErrorType -> AEvent e) -> AM () -> AM' ()
     run err a = do
       waitActive . runExceptT $ a `catchAgentError` (notify "" . err)
       step <- asks $ cleanupStepInterval . config
@@ -2097,8 +2059,8 @@ cleanupManager c@AgentClient {subQ} = do
     deleteExpiredReplicasForDeletion = do
       rcvFilesTTL <- asks $ rcvFilesTTL . config
       withStore' c (`deleteDeletedSndChunkReplicasExpired` rcvFilesTTL)
-    notify :: forall e. AEntityI e => EntityId -> ACommand 'Agent e -> AM ()
-    notify entId cmd = atomically $ writeTBQueue subQ ("", entId, APC (sAEntity @e) cmd)
+    notify :: forall e. AEntityI e => EntityId -> AEvent e -> AM ()
+    notify entId cmd = atomically $ writeTBQueue subQ ("", entId, AEvt (sAEntity @e) cmd)
 
 data ACKd = ACKd | ACKPending
 
@@ -2151,8 +2113,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
       atomically . whenM (isPendingSub connId) $ failSubscription c rq e
       lift $ notifyErr connId e
     isPendingSub connId = (&&) <$> hasPendingSubscription c connId <*> activeClientSession c tSess sessId
-    notify' :: forall e m. (AEntityI e, MonadIO m) => ConnId -> ACommand 'Agent e -> m ()
-    notify' connId msg = atomically $ writeTBQueue subQ ("", connId, APC (sAEntity @e) msg)
+    notify' :: forall e m. (AEntityI e, MonadIO m) => ConnId -> AEvent e -> m ()
+    notify' connId msg = atomically $ writeTBQueue subQ ("", connId, AEvt (sAEntity @e) msg)
     notifyErr :: ConnId -> SMPClientError -> AM' ()
     notifyErr connId = notify' connId . ERR . protocolClientError SMP (B.unpack $ strEncode srv)
     processSMP :: forall c. RcvQueue -> Connection c -> ConnData -> BrokerMsg -> AM ()
@@ -2343,7 +2305,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
           SMP.ERR e -> notify $ ERR $ SMP (B.unpack $ strEncode srv) e
           r -> unexpected r
         where
-          notify :: forall e m. (AEntityI e, MonadIO m) => ACommand 'Agent e -> m ()
+          notify :: forall e m. (AEntityI e, MonadIO m) => AEvent e -> m ()
           notify = notify' connId
 
           prohibited :: String -> AM ()
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index c28c95a0f..303bb55be 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -273,8 +273,7 @@ type XFTPTransportSession = TransportSession FileResponse
 data AgentClient = AgentClient
   { acThread :: TVar (Maybe (Weak ThreadId)),
     active :: TVar Bool,
-    rcvQ :: TBQueue (ATransmission 'Client),
-    subQ :: TBQueue (ATransmission 'Agent),
+    subQ :: TBQueue ATransmission,
     msgQ :: TBQueue (ServerTransmissionBatch SMPVersion ErrorType BrokerMsg),
     smpServers :: TMap UserId (NonEmpty SMPServerWithAuth),
     smpClients :: TMap SMPTransportSession SMPClientVar,
@@ -373,7 +372,7 @@ getAgentWorker' toW fromW name hasWork c key ws work = do
                 notifyErr err = do
                   let e = either ((", error: " <>) . show) (\_ -> ", no error") e_
                       msg = "Worker " <> name <> " for " <> show key <> " terminated " <> show (restartCount rc) <> " times" <> e
-                  writeTBQueue (subQ c) ("", "", APC SAEConn $ ERR $ err msg)
+                  writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err msg)
 
 newWorker :: AgentClient -> STM Worker
 newWorker c = do
@@ -449,7 +448,6 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv =
       qSize = tbqSize cfg
   acThread <- newTVar Nothing
   active <- newTVar True
-  rcvQ <- newTBQueue qSize
   subQ <- newTBQueue qSize
   msgQ <- newTBQueue qSize
   smpServers <- newTVar smp
@@ -487,7 +485,6 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv =
     AgentClient
       { acThread,
         active,
-        rcvQ,
         subQ,
         msgQ,
         smpServers,
@@ -586,7 +583,7 @@ instance ProtocolServerClient XFTPVersion XFTPErrorType FileResponse where
 
 getSMPServerClient :: AgentClient -> SMPTransportSession -> AM SMPConnectedClient
 getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
-  unlessM (readTVarIO active) . throwE $ INACTIVE
+  unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess smpClients ts)
     >>= either newClient (waitForProtocolClient c tSess smpClients)
@@ -597,7 +594,7 @@ getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
 
 getSMPProxyClient :: AgentClient -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
 getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq} destSess@(userId, destSrv, qId) = do
-  unlessM (readTVarIO active) . throwE $ INACTIVE
+  unlessM (readTVarIO active) $ throwE INACTIVE
   proxySrv <- getNextServer c userId [destSrv]
   ts <- liftIO getCurrentTime
   atomically (getClientVar proxySrv ts) >>= \(tSess, auth, v) ->
@@ -633,7 +630,7 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
           liftIO $ incClientStat c userId clnt "PROXY" "OK"
           pure $ Right sess
         Left e -> do
-          liftIO $ incClientStat c userId clnt "PROXY" $ strEncode e
+          liftIO $ incClientStat c userId clnt "PROXY" $ bshow e
           atomically $ do
             unless (serverHostError e) $ do
               removeSessVar rv destSrv prs
@@ -692,8 +689,8 @@ smpClientDisconnected c@AgentClient {active, smpClients, smpProxiedRelays} tSess
         atomically $ mapM_ (releaseGetLock c) qs
         runReaderT (resubscribeSMPSession c tSess) env
 
-    notifySub :: forall e. AEntityI e => ConnId -> ACommand 'Agent e -> IO ()
-    notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, APC (sAEntity @e) cmd)
+    notifySub :: forall e. AEntityI e => ConnId -> AEvent e -> IO ()
+    notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, AEvt (sAEntity @e) cmd)
 
 resubscribeSMPSession :: AgentClient -> SMPTransportSession -> AM' ()
 resubscribeSMPSession c@AgentClient {smpSubWorkers, workerSeq} tSess = do
@@ -743,12 +740,12 @@ reconnectSMPClient c tSess@(_, srv, _) qs = handleNotify $ do
   where
     handleNotify :: AM' () -> AM' ()
     handleNotify = E.handleAny $ notifySub "" . ERR . INTERNAL . show
-    notifySub :: forall e. AEntityI e => ConnId -> ACommand 'Agent e -> AM' ()
-    notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, APC (sAEntity @e) cmd)
+    notifySub :: forall e. AEntityI e => ConnId -> AEvent e -> AM' ()
+    notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, AEvt (sAEntity @e) cmd)
 
 getNtfServerClient :: AgentClient -> NtfTransportSession -> AM NtfClient
 getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(userId, srv, _) = do
-  unlessM (readTVarIO active) . throwE $ INACTIVE
+  unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess ntfClients ts)
     >>= either
@@ -767,12 +764,12 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(userId,
     clientDisconnected v client = do
       atomically $ removeSessVar v tSess ntfClients
       incClientStat c userId client "DISCONNECT" ""
-      atomically $ writeTBQueue (subQ c) ("", "", APC SAENone $ hostEvent DISCONNECT client)
+      atomically $ writeTBQueue (subQ c) ("", "", AEvt SAENone $ hostEvent DISCONNECT client)
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
 getXFTPServerClient :: AgentClient -> XFTPTransportSession -> AM XFTPClient
 getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(userId, srv, _) = do
-  unlessM (readTVarIO active) . throwE $ INACTIVE
+  unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess xftpClients ts)
     >>= either
@@ -791,7 +788,7 @@ getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(userId
     clientDisconnected v client = do
       atomically $ removeSessVar v tSess xftpClients
       incClientStat c userId client "DISCONNECT" ""
-      atomically $ writeTBQueue (subQ c) ("", "", APC SAENone $ hostEvent DISCONNECT client)
+      atomically $ writeTBQueue (subQ c) ("", "", AEvt SAENone $ hostEvent DISCONNECT client)
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
 waitForProtocolClient ::
@@ -831,10 +828,10 @@ newProtocolClient c tSess@(userId, srv, entityId_) clients connectClient v =
       logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv <> " (user " <> bshow userId <> maybe "" (" for entity " <>) entityId_ <> ")"
       atomically $ putTMVar (sessionVar v) (Right client)
       liftIO $ incClientStat c userId client "CLIENT" "OK"
-      atomically $ writeTBQueue (subQ c) ("", "", APC SAENone $ hostEvent CONNECT client)
+      atomically $ writeTBQueue (subQ c) ("", "", AEvt SAENone $ hostEvent CONNECT client)
       pure client
     Left e -> do
-      liftIO $ incServerStat c userId srv "CLIENT" $ strEncode e
+      liftIO $ incServerStat c userId srv "CLIENT" $ bshow e
       ei <- asks $ persistErrorInterval . config
       if ei == 0
         then atomically $ do
@@ -845,11 +842,11 @@ newProtocolClient c tSess@(userId, srv, entityId_) clients connectClient v =
           atomically $ putTMVar (sessionVar v) (Left (e, Just ts))
       throwE e -- signal error to caller
 
-hostEvent :: forall v err msg. (ProtocolTypeI (ProtoType msg), ProtocolServerClient v err msg) => (AProtocolType -> TransportHost -> ACommand 'Agent 'AENone) -> Client msg -> ACommand 'Agent 'AENone
+hostEvent :: forall v err msg. (ProtocolTypeI (ProtoType msg), ProtocolServerClient v err msg) => (AProtocolType -> TransportHost -> AEvent 'AENone) -> Client msg -> AEvent 'AENone
 hostEvent event = hostEvent' event . protocolClient
 {-# INLINE hostEvent #-}
 
-hostEvent' :: forall v err msg. (ProtocolTypeI (ProtoType msg), ProtocolServerClient v err msg) => (AProtocolType -> TransportHost -> ACommand 'Agent 'AENone) -> ProtoClient msg -> ACommand 'Agent 'AENone
+hostEvent' :: forall v err msg. (ProtocolTypeI (ProtoType msg), ProtocolServerClient v err msg) => (AProtocolType -> TransportHost -> AEvent 'AENone) -> ProtoClient msg -> AEvent 'AENone
 hostEvent' event = event (AProtocolType $ protocolTypeI @(ProtoType msg)) . clientTransportHost
 
 getClientConfig :: AgentClient -> (AgentConfig -> ProtocolClientConfig v) -> AM' (ProtocolClientConfig v)
@@ -986,8 +983,8 @@ withClient_ c tSess@(userId, srv, _) statCmd action = do
     stat cl = liftIO . incClientStat c userId cl statCmd
     logServerError :: Client msg -> AgentErrorType -> AM a
     logServerError cl e = do
-      logServer "<--" c srv "" $ strEncode e
-      stat cl $ strEncode e
+      logServer "<--" c srv "" $ bshow e
+      stat cl $ bshow e
       throwE e
 
 withProxySession :: AgentClient -> SMPTransportSession -> SMP.SenderId -> ByteString -> ((SMPConnectedClient, ProxiedRelay) -> AM a) -> AM a
@@ -1005,8 +1002,8 @@ withProxySession c destSess@(userId, destSrv, _) entId cmdStr action = do
     proxySrv = showServer . protocolClientServer' . protocolClient
     logServerError :: SMPConnectedClient -> AgentErrorType -> AM a
     logServerError cl e = do
-      logServer ("<-- " <> proxySrv cl <> " <") c destSrv "" $ strEncode e
-      stat cl $ strEncode e
+      logServer ("<-- " <> proxySrv cl <> " <") c destSrv "" $ bshow e
+      stat cl $ bshow e
       throwE e
 
 withLogClient_ :: ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> EntityId -> ByteString -> (Client msg -> AM a) -> AM a
@@ -1719,7 +1716,7 @@ withWork c doWork getWork action =
     Left e -> notifyErr INTERNAL e
   where
     noWork = liftIO $ noWorkToDo doWork
-    notifyErr err e = atomically $ writeTBQueue (subQ c) ("", "", APC SAEConn $ ERR $ err $ show e)
+    notifyErr err e = atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
 
 noWorkToDo :: TMVar () -> IO ()
 noWorkToDo = void . atomically . tryTakeTMVar
@@ -1762,7 +1759,7 @@ suspendOperation c op endedAction = do
 notifySuspended :: AgentClient -> STM ()
 notifySuspended c = do
   -- unsafeIOToSTM $ putStrLn "notifySuspended"
-  writeTBQueue (subQ c) ("", "", APC SAENone SUSPENDED)
+  writeTBQueue (subQ c) ("", "", AEvt SAENone SUSPENDED)
   writeTVar (agentState c) ASSuspended
 
 endOperation :: AgentClient -> AgentOperation -> STM () -> STM ()
diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
index 1e2c7cb00..a239768b0 100644
--- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
+++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
@@ -29,7 +29,7 @@ import Data.Time (UTCTime, addUTCTime, getCurrentTime)
 import Data.Time.Clock (diffUTCTime)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
-import Simplex.Messaging.Agent.Protocol (ACommand (..), APartyCmd (..), AgentErrorType (..), BrokerErrorType (..), ConnId, NotificationsMode (..), SAEntity (..))
+import Simplex.Messaging.Agent.Protocol (AEvent (..), AEvt (..), AgentErrorType (..), BrokerErrorType (..), ConnId, NotificationsMode (..), SAEntity (..))
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
@@ -306,7 +306,7 @@ workerInternalError c connId internalErrStr = do
 
 -- TODO change error
 notifyInternalError :: MonadIO m => AgentClient -> ConnId -> String -> m ()
-notifyInternalError AgentClient {subQ} connId internalErrStr = atomically $ writeTBQueue subQ ("", connId, APC SAEConn $ ERR $ INTERNAL internalErrStr)
+notifyInternalError AgentClient {subQ} connId internalErrStr = atomically $ writeTBQueue subQ ("", connId, AEvt SAEConn $ ERR $ INTERNAL internalErrStr)
 {-# INLINE notifyInternalError #-}
 
 getNtfToken :: AM' (Maybe NtfToken)
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index e44c2c0f7..447658cfe 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -49,18 +49,15 @@ module Simplex.Messaging.Agent.Protocol
     -- * SMP agent protocol types
     ConnInfo,
     ACommand (..),
-    APartyCmd (..),
+    AEvent (..),
+    AEvt (..),
     ACommandTag (..),
+    AEventTag (..),
+    AEvtTag (..),
     aCommandTag,
-    aPartyCmdTag,
-    ACmd (..),
-    APartyCmdTag (..),
-    ACmdTag (..),
-    AParty (..),
+    aEventTag,
     AEntity (..),
-    SAParty (..),
     SAEntity (..),
-    APartyI (..),
     AEntityI (..),
     MsgHash,
     MsgMeta (..),
@@ -117,8 +114,6 @@ module Simplex.Messaging.Agent.Protocol
     AgentCryptoError (..),
     cryptoErrToSyncState,
     ATransmission,
-    ATransmissionOrError,
-    ARawTransmission,
     ConnId,
     RcvFileId,
     SndFileId,
@@ -137,34 +132,21 @@ module Simplex.Messaging.Agent.Protocol
     serializeCommand,
     connMode,
     connMode',
-    networkCommandP,
     dbCommandP,
-    commandP,
     connModeT,
     serializeQueueStatus,
     queueStatusT,
     agentMessageType,
     extraSMPServerHosts,
     updateSMPServerHosts,
-    checkParty,
-
-    -- * TCP transport functions
-    tPut,
-    tGet,
-    tPutRaw,
-    tGetRaw,
   )
 where
 
 import Control.Applicative (optional, (<|>))
-import Control.Monad (unless)
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Except
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson.TH as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
@@ -176,11 +158,9 @@ import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
-import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.System (SystemTime)
-import Data.Time.ISO8601
 import Data.Type.Equality
 import Data.Typeable ()
 import Data.Word (Word16, Word32)
@@ -199,7 +179,6 @@ import Simplex.Messaging.Crypto.Ratchet
     RcvE2ERatchetParams,
     RcvE2ERatchetParamsUri,
     SndE2ERatchetParams,
-    pattern PQEncOff,
     pattern PQSupportOff,
     pattern PQSupportOn,
   )
@@ -236,13 +215,11 @@ import Simplex.Messaging.Protocol
   )
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme
-import Simplex.Messaging.Transport (Transport (..))
 import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts_ (..))
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
 import Simplex.RemoteControl.Types
-import Text.Read
 import UnliftIO.Exception (Exception)
 
 -- SMP agent protocol version history:
@@ -296,41 +273,13 @@ e2eEncAgentMsgLength v = \case
   PQSupportOn | v >= pqdrSMPAgentVersion -> 13634
   _ -> 15856
 
--- | Raw (unparsed) SMP agent protocol transmission.
-type ARawTransmission = (ByteString, ByteString, ByteString)
-
--- | Parsed SMP agent protocol transmission.
-type ATransmission p = (ACorrId, EntityId, APartyCmd p)
-
--- | SMP agent protocol transmission or transmission error.
-type ATransmissionOrError p = (ACorrId, EntityId, Either AgentErrorType (APartyCmd p))
+-- | SMP agent event
+type ATransmission = (ACorrId, EntityId, AEvt)
 
 type UserId = Int64
 
 type ACorrId = ByteString
 
--- | SMP agent protocol participants.
-data AParty = Agent | Client
-  deriving (Eq, Show)
-
--- | Singleton types for SMP agent protocol participants.
-data SAParty :: AParty -> Type where
-  SAgent :: SAParty Agent
-  SClient :: SAParty Client
-
-deriving instance Show (SAParty p)
-
-instance TestEquality SAParty where
-  testEquality SAgent SAgent = Just Refl
-  testEquality SClient SClient = Just Refl
-  testEquality _ _ = Nothing
-
-class APartyI (p :: AParty) where sAParty :: SAParty p
-
-instance APartyI Agent where sAParty = SAgent
-
-instance APartyI Client where sAParty = SClient
-
 data AEntity = AEConn | AERcvFile | AESndFile | AENone
   deriving (Eq, Show)
 
@@ -359,155 +308,142 @@ instance AEntityI AESndFile where sAEntity = SAESndFile
 
 instance AEntityI AENone where sAEntity = SAENone
 
-data ACmd = forall p e. (APartyI p, AEntityI e) => ACmd (SAParty p) (SAEntity e) (ACommand p e)
+data AEvt = forall e. AEntityI e => AEvt (SAEntity e) (AEvent e)
 
-deriving instance Show ACmd
-
-data APartyCmd p = forall e. AEntityI e => APC (SAEntity e) (ACommand p e)
-
-instance Eq (APartyCmd p) where
-  APC e cmd == APC e' cmd' = case testEquality e e' of
-    Just Refl -> cmd == cmd'
+instance Eq AEvt where
+  AEvt e evt == AEvt e' evt' = case testEquality e e' of
+    Just Refl -> evt == evt'
     Nothing -> False
 
-deriving instance Show (APartyCmd p)
+deriving instance Show AEvt
 
 type ConnInfo = ByteString
 
--- | Parameterized type for SMP agent protocol commands and responses from all participants.
-data ACommand (p :: AParty) (e :: AEntity) where
-  NEW :: Bool -> AConnectionMode -> InitialKeys -> SubscriptionMode -> ACommand Client AEConn -- response INV
-  INV :: AConnectionRequestUri -> ACommand Agent AEConn
-  JOIN :: Bool -> AConnectionRequestUri -> PQSupport -> SubscriptionMode -> ConnInfo -> ACommand Client AEConn -- response OK
-  CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> ACommand Agent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake
-  LET :: ConfirmationId -> ConnInfo -> ACommand Client AEConn -- ConnInfo is from client
-  REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> ACommand Agent AEConn -- ConnInfo is from sender
-  ACPT :: InvitationId -> PQSupport -> ConnInfo -> ACommand Client AEConn -- ConnInfo is from client
-  RJCT :: InvitationId -> ACommand Client AEConn
-  INFO :: PQSupport -> ConnInfo -> ACommand Agent AEConn
-  CON :: PQEncryption -> ACommand Agent AEConn -- notification that connection is established
-  SUB :: ACommand Client AEConn
-  END :: ACommand Agent AEConn
-  CONNECT :: AProtocolType -> TransportHost -> ACommand Agent AENone
-  DISCONNECT :: AProtocolType -> TransportHost -> ACommand Agent AENone
-  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 :: PQEncryption -> MsgFlags -> MsgBody -> ACommand Client AEConn
-  MID :: AgentMsgId -> PQEncryption -> ACommand Agent AEConn
-  SENT :: AgentMsgId -> Maybe SMPServer -> ACommand Agent AEConn
-  MWARN :: AgentMsgId -> AgentErrorType -> ACommand Agent AEConn
-  MERR :: AgentMsgId -> AgentErrorType -> ACommand Agent AEConn
-  MERRS :: NonEmpty AgentMsgId -> AgentErrorType -> ACommand Agent AEConn
-  MSG :: MsgMeta -> MsgFlags -> MsgBody -> ACommand Agent AEConn
-  MSGNTF :: SMPMsgMeta -> ACommand Agent AEConn
-  ACK :: AgentMsgId -> Maybe MsgReceiptInfo -> ACommand Client AEConn
-  RCVD :: MsgMeta -> NonEmpty MsgReceipt -> ACommand Agent AEConn
-  QCONT :: ACommand Agent AEConn
-  SWCH :: ACommand Client AEConn
-  OFF :: ACommand Client AEConn
-  DEL :: ACommand Client AEConn
-  DEL_RCVQ :: SMPServer -> SMP.RecipientId -> Maybe AgentErrorType -> ACommand Agent AEConn
-  DEL_CONN :: ACommand Agent AEConn
-  DEL_USER :: Int64 -> ACommand Agent AENone
-  CHK :: ACommand Client AEConn
-  STAT :: ConnectionStats -> ACommand Agent AEConn
-  OK :: ACommand Agent AEConn
-  ERR :: AgentErrorType -> ACommand Agent AEConn
-  SUSPENDED :: ACommand Agent AENone
-  -- XFTP commands and responses
-  RFPROG :: Int64 -> Int64 -> ACommand Agent AERcvFile
-  RFDONE :: FilePath -> ACommand Agent AERcvFile
-  RFERR :: AgentErrorType -> ACommand Agent AERcvFile
-  SFPROG :: Int64 -> Int64 -> ACommand Agent AESndFile
-  SFDONE :: ValidFileDescription 'FSender -> [ValidFileDescription 'FRecipient] -> ACommand Agent AESndFile
-  SFERR :: AgentErrorType -> ACommand Agent AESndFile
+-- | Parameterized type for SMP agent events
+data AEvent (e :: AEntity) where
+  INV :: AConnectionRequestUri -> AEvent AEConn
+  CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake
+  REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender
+  INFO :: PQSupport -> ConnInfo -> AEvent AEConn
+  CON :: PQEncryption -> AEvent AEConn -- notification that connection is established
+  END :: AEvent AEConn
+  CONNECT :: AProtocolType -> TransportHost -> AEvent AENone
+  DISCONNECT :: AProtocolType -> TransportHost -> AEvent AENone
+  DOWN :: SMPServer -> [ConnId] -> AEvent AENone
+  UP :: SMPServer -> [ConnId] -> AEvent AENone
+  SWITCH :: QueueDirection -> SwitchPhase -> ConnectionStats -> AEvent AEConn
+  RSYNC :: RatchetSyncState -> Maybe AgentCryptoError -> ConnectionStats -> AEvent AEConn
+  MID :: AgentMsgId -> PQEncryption -> AEvent AEConn
+  SENT :: AgentMsgId -> Maybe SMPServer -> AEvent AEConn
+  MWARN :: AgentMsgId -> AgentErrorType -> AEvent AEConn
+  MERR :: AgentMsgId -> AgentErrorType -> AEvent AEConn
+  MERRS :: NonEmpty AgentMsgId -> AgentErrorType -> AEvent AEConn
+  MSG :: MsgMeta -> MsgFlags -> MsgBody -> AEvent AEConn
+  MSGNTF :: SMPMsgMeta -> AEvent AEConn
+  RCVD :: MsgMeta -> NonEmpty MsgReceipt -> AEvent AEConn
+  QCONT :: AEvent AEConn
+  DEL_RCVQ :: SMPServer -> SMP.RecipientId -> Maybe AgentErrorType -> AEvent AEConn
+  DEL_CONN :: AEvent AEConn
+  DEL_USER :: Int64 -> AEvent AENone
+  STAT :: ConnectionStats -> AEvent AEConn
+  OK :: AEvent AEConn
+  ERR :: AgentErrorType -> AEvent AEConn
+  SUSPENDED :: AEvent AENone
+  RFPROG :: Int64 -> Int64 -> AEvent AERcvFile
+  RFDONE :: FilePath -> AEvent AERcvFile
+  RFERR :: AgentErrorType -> AEvent AERcvFile
+  SFPROG :: Int64 -> Int64 -> AEvent AESndFile
+  SFDONE :: ValidFileDescription 'FSender -> [ValidFileDescription 'FRecipient] -> AEvent AESndFile
+  SFERR :: AgentErrorType -> AEvent AESndFile
 
-deriving instance Eq (ACommand p e)
+deriving instance Eq (AEvent e)
 
-deriving instance Show (ACommand p e)
+deriving instance Show (AEvent e)
 
-data ACmdTag = forall p e. (APartyI p, AEntityI e) => ACmdTag (SAParty p) (SAEntity e) (ACommandTag p e)
+data AEvtTag = forall e. AEntityI e => AEvtTag (SAEntity e) (AEventTag e)
 
-data APartyCmdTag p = forall e. AEntityI e => APCT (SAEntity e) (ACommandTag p e)
-
-instance Eq (APartyCmdTag p) where
-  APCT e cmd == APCT e' cmd' = case testEquality e e' of
-    Just Refl -> cmd == cmd'
+instance Eq AEvtTag where
+  AEvtTag e evt == AEvtTag e' evt' = case testEquality e e' of
+    Just Refl -> evt == evt'
     Nothing -> False
 
-deriving instance Show (APartyCmdTag p)
+deriving instance Show AEvtTag
 
-data ACommandTag (p :: AParty) (e :: AEntity) where
-  NEW_ :: ACommandTag Client AEConn
-  INV_ :: ACommandTag Agent AEConn
-  JOIN_ :: ACommandTag Client AEConn
-  CONF_ :: ACommandTag Agent AEConn
-  LET_ :: ACommandTag Client AEConn
-  REQ_ :: ACommandTag Agent AEConn
-  ACPT_ :: ACommandTag Client AEConn
-  RJCT_ :: ACommandTag Client AEConn
-  INFO_ :: ACommandTag Agent AEConn
-  CON_ :: ACommandTag Agent AEConn
-  SUB_ :: ACommandTag Client AEConn
-  END_ :: ACommandTag Agent AEConn
-  CONNECT_ :: ACommandTag Agent AENone
-  DISCONNECT_ :: ACommandTag Agent AENone
-  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
-  MWARN_ :: ACommandTag Agent AEConn
-  MERR_ :: ACommandTag Agent AEConn
-  MERRS_ :: ACommandTag Agent AEConn
-  MSG_ :: ACommandTag Agent AEConn
-  MSGNTF_ :: ACommandTag Agent AEConn
-  ACK_ :: ACommandTag Client AEConn
-  RCVD_ :: ACommandTag Agent AEConn
-  QCONT_ :: ACommandTag Agent AEConn
-  SWCH_ :: ACommandTag Client AEConn
-  OFF_ :: ACommandTag Client AEConn
-  DEL_ :: ACommandTag Client AEConn
-  DEL_RCVQ_ :: ACommandTag Agent AEConn
-  DEL_CONN_ :: ACommandTag Agent AEConn
-  DEL_USER_ :: ACommandTag Agent AENone
-  CHK_ :: ACommandTag Client AEConn
-  STAT_ :: ACommandTag Agent AEConn
-  OK_ :: ACommandTag Agent AEConn
-  ERR_ :: ACommandTag Agent AEConn
-  SUSPENDED_ :: ACommandTag Agent AENone
+data ACommand
+  = NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV
+  | JOIN Bool AConnectionRequestUri PQSupport SubscriptionMode ConnInfo
+  | LET ConfirmationId ConnInfo -- ConnInfo is from client
+  | ACK AgentMsgId (Maybe MsgReceiptInfo)
+  | SWCH
+  | DEL
+  deriving (Eq, Show)
+
+data ACommandTag
+  = NEW_
+  | JOIN_
+  | LET_
+  | ACK_
+  | SWCH_
+  | DEL_
+  deriving (Show)
+
+data AEventTag (e :: AEntity) where
+  INV_ :: AEventTag AEConn
+  CONF_ :: AEventTag AEConn
+  REQ_ :: AEventTag AEConn
+  INFO_ :: AEventTag AEConn
+  CON_ :: AEventTag AEConn
+  END_ :: AEventTag AEConn
+  CONNECT_ :: AEventTag AENone
+  DISCONNECT_ :: AEventTag AENone
+  DOWN_ :: AEventTag AENone
+  UP_ :: AEventTag AENone
+  SWITCH_ :: AEventTag AEConn
+  RSYNC_ :: AEventTag AEConn
+  MID_ :: AEventTag AEConn
+  SENT_ :: AEventTag AEConn
+  MWARN_ :: AEventTag AEConn
+  MERR_ :: AEventTag AEConn
+  MERRS_ :: AEventTag AEConn
+  MSG_ :: AEventTag AEConn
+  MSGNTF_ :: AEventTag AEConn
+  RCVD_ :: AEventTag AEConn
+  QCONT_ :: AEventTag AEConn
+  DEL_RCVQ_ :: AEventTag AEConn
+  DEL_CONN_ :: AEventTag AEConn
+  DEL_USER_ :: AEventTag AENone
+  STAT_ :: AEventTag AEConn
+  OK_ :: AEventTag AEConn
+  ERR_ :: AEventTag AEConn
+  SUSPENDED_ :: AEventTag AENone
   -- XFTP commands and responses
-  RFDONE_ :: ACommandTag Agent AERcvFile
-  RFPROG_ :: ACommandTag Agent AERcvFile
-  RFERR_ :: ACommandTag Agent AERcvFile
-  SFPROG_ :: ACommandTag Agent AESndFile
-  SFDONE_ :: ACommandTag Agent AESndFile
-  SFERR_ :: ACommandTag Agent AESndFile
+  RFDONE_ :: AEventTag AERcvFile
+  RFPROG_ :: AEventTag AERcvFile
+  RFERR_ :: AEventTag AERcvFile
+  SFPROG_ :: AEventTag AESndFile
+  SFDONE_ :: AEventTag AESndFile
+  SFERR_ :: AEventTag AESndFile
 
-deriving instance Eq (ACommandTag p e)
+deriving instance Eq (AEventTag e)
 
-deriving instance Show (ACommandTag p e)
+deriving instance Show (AEventTag e)
 
-aPartyCmdTag :: APartyCmd p -> APartyCmdTag p
-aPartyCmdTag (APC e cmd) = APCT e $ aCommandTag cmd
-
-aCommandTag :: ACommand p e -> ACommandTag p e
+aCommandTag :: ACommand -> ACommandTag
 aCommandTag = \case
   NEW {} -> NEW_
-  INV _ -> INV_
   JOIN {} -> JOIN_
-  CONF {} -> CONF_
   LET {} -> LET_
+  ACK {} -> ACK_
+  SWCH -> SWCH_
+  DEL -> DEL_
+
+aEventTag :: AEvent e -> AEventTag e
+aEventTag = \case
+  INV _ -> INV_
+  CONF {} -> CONF_
   REQ {} -> REQ_
-  ACPT {} -> ACPT_
-  RJCT _ -> RJCT_
   INFO {} -> INFO_
   CON _ -> CON_
-  SUB -> SUB_
   END -> END_
   CONNECT {} -> CONNECT_
   DISCONNECT {} -> DISCONNECT_
@@ -515,7 +451,6 @@ aCommandTag = \case
   UP {} -> UP_
   SWITCH {} -> SWITCH_
   RSYNC {} -> RSYNC_
-  SEND {} -> SEND_
   MID {} -> MID_
   SENT {} -> SENT_
   MWARN {} -> MWARN_
@@ -523,16 +458,11 @@ aCommandTag = \case
   MERRS {} -> MERRS_
   MSG {} -> MSG_
   MSGNTF {} -> MSGNTF_
-  ACK {} -> ACK_
   RCVD {} -> RCVD_
   QCONT -> QCONT_
-  SWCH -> SWCH_
-  OFF -> OFF_
-  DEL -> DEL_
   DEL_RCVQ {} -> DEL_RCVQ_
   DEL_CONN -> DEL_CONN_
   DEL_USER _ -> DEL_USER_
-  CHK -> CHK_
   STAT _ -> STAT_
   OK -> OK_
   ERR _ -> ERR_
@@ -547,47 +477,9 @@ aCommandTag = \case
 data QueueDirection = QDRcv | QDSnd
   deriving (Eq, Show)
 
-instance StrEncoding QueueDirection where
-  strEncode = \case
-    QDRcv -> "rcv"
-    QDSnd -> "snd"
-  strP =
-    A.takeTill (== ' ') >>= \case
-      "rcv" -> pure QDRcv
-      "snd" -> pure QDSnd
-      _ -> fail "bad QueueDirection"
-
-instance ToJSON QueueDirection where
-  toEncoding = strToJEncoding
-  toJSON = strToJSON
-
-instance FromJSON QueueDirection where
-  parseJSON = strParseJSON "QueueDirection"
-
 data SwitchPhase = SPStarted | SPConfirmed | SPSecured | SPCompleted
   deriving (Eq, Show)
 
-instance StrEncoding SwitchPhase where
-  strEncode = \case
-    SPStarted -> "started"
-    SPConfirmed -> "confirmed"
-    SPSecured -> "secured"
-    SPCompleted -> "completed"
-  strP =
-    A.takeTill (== ' ') >>= \case
-      "started" -> pure SPStarted
-      "confirmed" -> pure SPConfirmed
-      "secured" -> pure SPSecured
-      "completed" -> pure SPCompleted
-      _ -> fail "bad SwitchPhase"
-
-instance ToJSON SwitchPhase where
-  toEncoding = strToJEncoding
-  toJSON = strToJSON
-
-instance FromJSON SwitchPhase where
-  parseJSON = strParseJSON "SwitchPhase"
-
 data RcvSwitchStatus
   = RSSwitchStarted
   | RSSendingQADD
@@ -688,31 +580,12 @@ data RcvQueueInfo = RcvQueueInfo
   }
   deriving (Eq, Show)
 
-instance StrEncoding RcvQueueInfo where
-  strEncode RcvQueueInfo {rcvServer, rcvSwitchStatus, canAbortSwitch} =
-    ("srv=" <> strEncode rcvServer)
-      <> maybe "" (\switch -> ";switch=" <> strEncode switch) rcvSwitchStatus
-      <> (";can_abort_switch=" <> strEncode canAbortSwitch)
-  strP = do
-    rcvServer <- "srv=" *> strP
-    rcvSwitchStatus <- optional $ ";switch=" *> strP
-    canAbortSwitch <- ";can_abort_switch=" *> strP
-    pure RcvQueueInfo {rcvServer, rcvSwitchStatus, canAbortSwitch}
-
 data SndQueueInfo = SndQueueInfo
   { sndServer :: SMPServer,
     sndSwitchStatus :: Maybe SndSwitchStatus
   }
   deriving (Eq, Show)
 
-instance StrEncoding SndQueueInfo where
-  strEncode SndQueueInfo {sndServer, sndSwitchStatus} =
-    "srv=" <> strEncode sndServer <> maybe "" (\switch -> ";switch=" <> strEncode switch) sndSwitchStatus
-  strP = do
-    sndServer <- "srv=" *> strP
-    sndSwitchStatus <- optional $ ";switch=" *> strP
-    pure SndQueueInfo {sndServer, sndSwitchStatus}
-
 data ConnectionStats = ConnectionStats
   { connAgentVersion :: VersionSMPA,
     rcvQueuesInfo :: [RcvQueueInfo],
@@ -722,21 +595,6 @@ data ConnectionStats = ConnectionStats
   }
   deriving (Eq, Show)
 
-instance StrEncoding ConnectionStats where
-  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
-    connAgentVersion <- "agent_version=" *> strP
-    rcvQueuesInfo <- " rcv=" *> strListP
-    sndQueuesInfo <- " snd=" *> strListP
-    ratchetSyncState <- " sync=" *> strP
-    ratchetSyncSupported <- " sync_supported=" *> strP
-    pure ConnectionStats {connAgentVersion, rcvQueuesInfo, sndQueuesInfo, ratchetSyncState, ratchetSyncSupported}
-
 data NotificationsMode = NMPeriodic | NMInstant
   deriving (Eq, Show)
 
@@ -823,27 +681,6 @@ data MsgMeta = MsgMeta
   }
   deriving (Eq, Show)
 
-instance StrEncoding MsgMeta where
-  strEncode MsgMeta {integrity, recipient = (rmId, rTs), broker = (bmId, bTs), sndMsgId, pqEncryption} =
-    B.unwords
-      [ strEncode integrity,
-        "R=" <> bshow rmId <> "," <> showTs rTs,
-        "B=" <> encode bmId <> "," <> showTs bTs,
-        "S=" <> bshow sndMsgId,
-        "PQ=" <> strEncode pqEncryption
-      ]
-    where
-      showTs = B.pack . formatISO8601Millis
-  strP = do
-    integrity <- strP
-    recipient <- " R=" *> partyMeta A.decimal
-    broker <- " B=" *> partyMeta base64P
-    sndMsgId <- " S=" *> A.decimal
-    pqEncryption <- " PQ=" *> strP
-    pure MsgMeta {integrity, recipient, broker, sndMsgId, pqEncryption}
-    where
-      partyMeta idParser = (,) <$> idParser <* A.char ',' <*> tsISO8601P
-
 data SMPConfirmation = SMPConfirmation
   { -- | sender's public key to use for authentication of sender's commands at the recepient's server
     senderKey :: SndPublicAuthKey,
@@ -1154,14 +991,6 @@ instance Encoding AMessageReceipt where
     (agentMsgId, msgHash, Large rcptInfo) <- smpP
     pure AMessageReceipt {agentMsgId, msgHash, rcptInfo}
 
-instance StrEncoding MsgReceipt where
-  strEncode MsgReceipt {agentMsgId, msgRcptStatus} =
-    strEncode agentMsgId <> ":" <> strEncode msgRcptStatus
-  strP = do
-    agentMsgId <- strP <* A.char ':'
-    msgRcptStatus <- strP
-    pure MsgReceipt {agentMsgId, msgRcptStatus}
-
 instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where
   strEncode = \case
     CRInvitationUri crData e2eParams -> crEncode "invitation" crData (Just e2eParams)
@@ -1209,7 +1038,7 @@ connReqUriP overrideScheme = do
     crModeP = "invitation" $> CMInvitation <|> "contact" $> CMContact
     adjustAgentVRange vr =
       let v = max duplexHandshakeSMPAgentVersion $ minVersion vr
-        in fromMaybe vr $ safeVersionRange v (max v $ maxVersion vr)
+       in fromMaybe vr $ safeVersionRange v (max v $ maxVersion vr)
 
 instance ConnectionModeI m => FromJSON (ConnectionRequestUri m) where
   parseJSON = strParseJSON "ConnectionRequestUri"
@@ -1563,81 +1392,6 @@ data AgentCryptoError
     RATCHET_SYNC
   deriving (Eq, Read, Show, Exception)
 
-instance StrEncoding AgentCryptoError where
-  strP =
-    A.takeTill (== ' ') >>= \case
-      "DECRYPT_AES" -> pure DECRYPT_AES
-      "DECRYPT_CB" -> pure DECRYPT_CB
-      "RATCHET_HEADER" -> pure RATCHET_HEADER
-      "RATCHET_EARLIER" -> RATCHET_EARLIER <$> _strP
-      "RATCHET_SKIPPED" -> RATCHET_SKIPPED <$> _strP
-      "RATCHET_SYNC" -> pure RATCHET_SYNC
-      _ -> fail "AgentCryptoError"
-  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
-    RATCHET_SYNC -> "RATCHET_SYNC"
-
-instance StrEncoding AgentErrorType where
-  strP =
-    A.takeTill (== ' ')
-      >>= \case
-        "CMD" -> CMD <$> (A.space *> parseRead1) <*> (A.space *> textP)
-        "CONN" -> CONN <$> (A.space *> parseRead1)
-        "SMP" -> SMP <$> (A.space *> srvP) <*> _strP
-        "NTF" -> NTF <$> (A.space *> srvP) <*> _strP
-        "XFTP" -> XFTP <$> (A.space *> srvP) <*> _strP
-        "PROXY" -> PROXY <$> (A.space *> srvP) <* A.space <*> srvP <*> _strP
-        "RCP" -> RCP <$> _strP
-        "BROKER" -> BROKER <$> (A.space *> srvP) <*> _strP
-        "AGENT" -> AGENT <$> _strP
-        "INTERNAL" -> INTERNAL <$> (A.space *> textP)
-        "CRITICAL" -> CRITICAL <$> (A.space *> parseRead1) <*> (A.space *> textP)
-        "INACTIVE" -> pure INACTIVE
-        _ -> fail "bad AgentErrorType"
-    where
-      srvP = T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' ')
-  strEncode = \case
-    CMD e cxt -> "CMD " <> bshow e <> " " <> text cxt
-    CONN e -> "CONN " <> bshow e
-    SMP srv e -> "SMP " <> text srv <> " " <> strEncode e
-    NTF srv e -> "NTF " <> text srv <> " " <> strEncode e
-    XFTP srv e -> "XFTP " <> text srv <> " " <> strEncode e
-    PROXY pxy srv e -> B.unwords ["PROXY", text pxy, text srv, strEncode e]
-    RCP e -> "RCP " <> strEncode e
-    BROKER srv e -> B.unwords ["BROKER", text srv, strEncode e]
-    AGENT e -> "AGENT " <> strEncode e
-    INTERNAL e -> "INTERNAL " <> encodeUtf8 (T.pack e)
-    CRITICAL restart e -> "CRITICAL " <> bshow restart <> " " <> encodeUtf8 (T.pack e)
-    INACTIVE -> "INACTIVE"
-    where
-      text = encodeUtf8 . T.pack
-
-instance StrEncoding SMPAgentError where
-  strP =
-    A.takeTill (== ' ')
-      >>= \case
-        "MESSAGE" -> pure A_MESSAGE
-        "PROHIBITED" -> A_PROHIBITED <$> (A.space *> textP)
-        "VERSION" -> pure A_VERSION
-        "CRYPTO" -> A_CRYPTO <$> _strP
-        "DUPLICATE" -> pure A_DUPLICATE
-        "QUEUE" -> A_QUEUE <$> (A.space *> textP)
-        _ -> fail "bad SMPAgentError"
-  strEncode = \case
-    A_MESSAGE -> "MESSAGE"
-    A_PROHIBITED e -> "PROHIBITED " <> encodeUtf8 (T.pack e)
-    A_VERSION -> "VERSION"
-    A_CRYPTO e -> "CRYPTO " <> strEncode e
-    A_DUPLICATE -> "DUPLICATE"
-    A_QUEUE e -> "QUEUE " <> encodeUtf8 (T.pack e)
-
-textP :: Parser String
-textP = T.unpack . safeDecodeUtf8 <$> A.takeByteString
-
 cryptoErrToSyncState :: AgentCryptoError -> RatchetSyncState
 cryptoErrToSyncState = \case
   DECRYPT_AES -> RSAllowed
@@ -1647,190 +1401,38 @@ cryptoErrToSyncState = \case
   RATCHET_SKIPPED _ -> RSRequired
   RATCHET_SYNC -> RSRequired
 
--- | SMP agent command and response parser for commands passed via network (only parses binary length)
-networkCommandP :: Parser ACmd
-networkCommandP = commandP A.takeByteString
-
 -- | SMP agent command and response parser for commands stored in db (fully parses binary bodies)
-dbCommandP :: Parser ACmd
+dbCommandP :: Parser ACommand
 dbCommandP = commandP $ A.take =<< (A.decimal <* "\n")
 
-instance StrEncoding ACmdTag where
-  strEncode (ACmdTag _ _ cmd) = strEncode cmd
+instance StrEncoding ACommandTag where
   strP =
     A.takeTill (== ' ') >>= \case
-      "NEW" -> t NEW_
-      "INV" -> ct INV_
-      "JOIN" -> t JOIN_
-      "CONF" -> ct CONF_
-      "LET" -> t LET_
-      "REQ" -> ct REQ_
-      "ACPT" -> t ACPT_
-      "RJCT" -> t RJCT_
-      "INFO" -> ct INFO_
-      "CON" -> ct CON_
-      "SUB" -> t SUB_
-      "END" -> ct END_
-      "CONNECT" -> nt CONNECT_
-      "DISCONNECT" -> nt DISCONNECT_
-      "DOWN" -> nt DOWN_
-      "UP" -> nt UP_
-      "SWITCH" -> ct SWITCH_
-      "RSYNC" -> ct RSYNC_
-      "SEND" -> t SEND_
-      "MID" -> ct MID_
-      "SENT" -> ct SENT_
-      "MWARN" -> ct MWARN_
-      "MERR" -> ct MERR_
-      "MERRS" -> ct MERRS_
-      "MSG" -> ct MSG_
-      "MSGNTF" -> ct MSGNTF_
-      "ACK" -> t ACK_
-      "RCVD" -> ct RCVD_
-      "QCONT" -> ct QCONT_
-      "SWCH" -> t SWCH_
-      "OFF" -> t OFF_
-      "DEL" -> t DEL_
-      "DEL_RCVQ" -> ct DEL_RCVQ_
-      "DEL_CONN" -> ct DEL_CONN_
-      "DEL_USER" -> nt DEL_USER_
-      "CHK" -> t CHK_
-      "STAT" -> ct STAT_
-      "OK" -> ct OK_
-      "ERR" -> ct ERR_
-      "SUSPENDED" -> nt SUSPENDED_
-      "RFPROG" -> at SAERcvFile RFPROG_
-      "RFDONE" -> at SAERcvFile RFDONE_
-      "RFERR" -> at SAERcvFile RFERR_
-      "SFPROG" -> at SAESndFile SFPROG_
-      "SFDONE" -> at SAESndFile SFDONE_
-      "SFERR" -> at SAESndFile SFERR_
-      _ -> fail "bad ACmdTag"
-    where
-      t = pure . ACmdTag SClient SAEConn
-      at e = pure . ACmdTag SAgent e
-      ct = at SAEConn
-      nt = at SAENone
-
-instance APartyI p => StrEncoding (APartyCmdTag p) where
-  strEncode (APCT _ cmd) = strEncode cmd
-  strP = (\(ACmdTag _ e t) -> checkParty $ APCT e t) <$?> strP
-
-instance (APartyI p, AEntityI e) => StrEncoding (ACommandTag p e) where
+      "NEW" -> pure NEW_
+      "JOIN" -> pure JOIN_
+      "LET" -> pure LET_
+      "ACK" -> pure ACK_
+      "SWCH" -> pure SWCH_
+      "DEL" -> pure DEL_
+      _ -> fail "bad ACommandTag"
   strEncode = \case
     NEW_ -> "NEW"
-    INV_ -> "INV"
     JOIN_ -> "JOIN"
-    CONF_ -> "CONF"
     LET_ -> "LET"
-    REQ_ -> "REQ"
-    ACPT_ -> "ACPT"
-    RJCT_ -> "RJCT"
-    INFO_ -> "INFO"
-    CON_ -> "CON"
-    SUB_ -> "SUB"
-    END_ -> "END"
-    CONNECT_ -> "CONNECT"
-    DISCONNECT_ -> "DISCONNECT"
-    DOWN_ -> "DOWN"
-    UP_ -> "UP"
-    SWITCH_ -> "SWITCH"
-    RSYNC_ -> "RSYNC"
-    SEND_ -> "SEND"
-    MID_ -> "MID"
-    SENT_ -> "SENT"
-    MWARN_ -> "MWARN"
-    MERR_ -> "MERR"
-    MERRS_ -> "MERRS"
-    MSG_ -> "MSG"
-    MSGNTF_ -> "MSGNTF"
     ACK_ -> "ACK"
-    RCVD_ -> "RCVD"
-    QCONT_ -> "QCONT"
     SWCH_ -> "SWCH"
-    OFF_ -> "OFF"
     DEL_ -> "DEL"
-    DEL_RCVQ_ -> "DEL_RCVQ"
-    DEL_CONN_ -> "DEL_CONN"
-    DEL_USER_ -> "DEL_USER"
-    CHK_ -> "CHK"
-    STAT_ -> "STAT"
-    OK_ -> "OK"
-    ERR_ -> "ERR"
-    SUSPENDED_ -> "SUSPENDED"
-    RFPROG_ -> "RFPROG"
-    RFDONE_ -> "RFDONE"
-    RFERR_ -> "RFERR"
-    SFPROG_ -> "SFPROG"
-    SFDONE_ -> "SFDONE"
-    SFERR_ -> "SFERR"
-  strP = (\(APCT _ t) -> checkEntity t) <$?> strP
 
-checkParty :: forall t p p'. (APartyI p, APartyI p') => t p' -> Either String (t p)
-checkParty x = case testEquality (sAParty @p) (sAParty @p') of
-  Just Refl -> Right x
-  Nothing -> Left "bad party"
-
-checkEntity :: forall t e e'. (AEntityI e, AEntityI e') => t e' -> Either String (t e)
-checkEntity x = case testEquality (sAEntity @e) (sAEntity @e') of
-  Just Refl -> Right x
-  Nothing -> Left "bad entity"
-
--- | SMP agent command and response parser
-commandP :: Parser ByteString -> Parser ACmd
+commandP :: Parser ByteString -> Parser ACommand
 commandP binaryP =
   strP
     >>= \case
-      ACmdTag SClient e cmd ->
-        ACmd SClient e <$> case cmd of
-          NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe))
-          JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqSupP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP)
-          LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP)
-          ACPT_ -> s (ACPT <$> A.takeTill (== ' ') <* A.space <*> pqSupP <*> binaryP)
-          RJCT_ -> s (RJCT <$> A.takeByteString)
-          SUB_ -> pure SUB
-          SEND_ -> s (SEND <$> pqEncP <*> smpP <* A.space <*> binaryP)
-          ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP))
-          SWCH_ -> pure SWCH
-          OFF_ -> pure OFF
-          DEL_ -> pure DEL
-          CHK_ -> pure CHK
-      ACmdTag SAgent e cmd ->
-        ACmd SAgent e <$> case cmd of
-          INV_ -> s (INV <$> strP)
-          CONF_ -> s (CONF <$> A.takeTill (== ' ') <* A.space <*> pqSupP <*> strListP <* A.space <*> binaryP)
-          REQ_ -> s (REQ <$> A.takeTill (== ' ') <* A.space <*> pqSupP <*> strP_ <*> binaryP)
-          INFO_ -> s (INFO <$> pqSupP <*> binaryP)
-          CON_ -> s (CON <$> strP)
-          END_ -> pure END
-          CONNECT_ -> s (CONNECT <$> strP_ <*> strP)
-          DISCONNECT_ -> s (DISCONNECT <$> strP_ <*> strP)
-          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 <*> _strP)
-          SENT_ -> s (SENT <$> A.decimal <*> _strP)
-          MWARN_ -> s (MWARN <$> A.decimal <* A.space <*> strP)
-          MERR_ -> s (MERR <$> A.decimal <* A.space <*> strP)
-          MERRS_ -> s (MERRS <$> strP_ <*> strP)
-          MSG_ -> s (MSG <$> strP <* A.space <*> smpP <* A.space <*> binaryP)
-          MSGNTF_ -> s (MSGNTF <$> strP)
-          RCVD_ -> s (RCVD <$> strP <* A.space <*> strP)
-          QCONT_ -> pure QCONT
-          DEL_RCVQ_ -> s (DEL_RCVQ <$> strP_ <*> strP_ <*> strP)
-          DEL_CONN_ -> pure DEL_CONN
-          DEL_USER_ -> s (DEL_USER <$> strP)
-          STAT_ -> s (STAT <$> strP)
-          OK_ -> pure OK
-          ERR_ -> s (ERR <$> strP)
-          SUSPENDED_ -> pure SUSPENDED
-          RFPROG_ -> s (RFPROG <$> A.decimal <* A.space <*> A.decimal)
-          RFDONE_ -> s (RFDONE <$> strP)
-          RFERR_ -> s (RFERR <$> strP)
-          SFPROG_ -> s (SFPROG <$> A.decimal <* A.space <*> A.decimal)
-          SFDONE_ -> s (sfDone . safeDecodeUtf8 <$?> binaryP)
-          SFERR_ -> s (SFERR <$> strP)
+      NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe))
+      JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqSupP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP)
+      LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP)
+      ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP))
+      SWCH_ -> pure SWCH
+      DEL_ -> pure DEL
   where
     s :: Parser a -> Parser a
     s p = A.space *> p
@@ -1838,155 +1440,23 @@ commandP binaryP =
     pqIKP = strP_ <|> pure (IKNoPQ PQSupportOff)
     pqSupP :: Parser PQSupport
     pqSupP = strP_ <|> pure PQSupportOff
-    pqEncP :: Parser PQEncryption
-    pqEncP = strP_ <|> pure PQEncOff
-    connections :: Parser [ConnId]
-    connections = strP `A.sepBy'` A.char ','
-    sfDone :: Text -> Either String (ACommand 'Agent 'AESndFile)
-    sfDone t =
-      let ds = T.splitOn fdSeparator t
-       in case ds of
-            [] -> Left "no sender file description"
-            sd : rds -> SFDONE <$> strDecode (encodeUtf8 sd) <*> mapM (strDecode . encodeUtf8) rds
-
-parseCommand :: ByteString -> Either AgentErrorType ACmd
-parseCommand = parse (commandP A.takeByteString) $ CMD SYNTAX "parseCommand"
 
 -- | Serialize SMP agent command.
-serializeCommand :: ACommand p e -> ByteString
+serializeCommand :: ACommand -> ByteString
 serializeCommand = \case
   NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode)
-  INV cReq -> s (INV_, cReq)
   JOIN ntfs cReq pqSup subMode cInfo -> s (JOIN_, ntfs, cReq, pqSup, subMode, Str $ serializeBinary cInfo)
-  CONF confId pqSup srvs cInfo -> B.unwords [s CONF_, confId, s pqSup, strEncodeList srvs, serializeBinary cInfo]
   LET confId cInfo -> B.unwords [s LET_, confId, serializeBinary cInfo]
-  REQ invId pqSup srvs cInfo -> B.unwords [s REQ_, invId, s pqSup, s srvs, serializeBinary cInfo]
-  ACPT invId pqSup cInfo -> B.unwords [s ACPT_, invId, s pqSup, serializeBinary cInfo]
-  RJCT invId -> B.unwords [s RJCT_, invId]
-  INFO pqSup cInfo -> B.unwords [s INFO_, s pqSup, serializeBinary cInfo]
-  SUB -> s SUB_
-  END -> s END_
-  CONNECT p h -> s (CONNECT_, p, h)
-  DISCONNECT p h -> s (DISCONNECT_, p, h)
-  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 pqEnc msgFlags msgBody -> B.unwords [s SEND_, s pqEnc, smpEncode msgFlags, serializeBinary msgBody]
-  MID mId pqEnc -> s (MID_, mId, pqEnc)
-  SENT mId proxySrv_ -> s (SENT_, mId, proxySrv_)
-  MWARN mId e -> s (MWARN_, mId, e)
-  MERR mId e -> s (MERR_, mId, e)
-  MERRS mIds e -> s (MERRS_, mIds, e)
-  MSG msgMeta msgFlags msgBody -> B.unwords [s MSG_, s msgMeta, smpEncode msgFlags, serializeBinary msgBody]
-  MSGNTF smpMsgMeta -> s (MSGNTF_, smpMsgMeta)
   ACK mId rcptInfo_ -> s (ACK_, mId) <> maybe "" (B.cons ' ' . serializeBinary) rcptInfo_
-  RCVD msgMeta rcpts -> s (RCVD_, msgMeta, rcpts)
-  QCONT -> s QCONT_
   SWCH -> s SWCH_
-  OFF -> s OFF_
   DEL -> s DEL_
-  DEL_RCVQ srv rcvId err_ -> s (DEL_RCVQ_, srv, rcvId, err_)
-  DEL_CONN -> s DEL_CONN_
-  DEL_USER userId -> s (DEL_USER_, userId)
-  CHK -> s CHK_
-  STAT srvs -> s (STAT_, srvs)
-  CON pqEnc -> s (CON_, pqEnc)
-  ERR e -> s (ERR_, e)
-  OK -> s OK_
-  SUSPENDED -> s SUSPENDED_
-  RFPROG rcvd total -> s (RFPROG_, rcvd, total)
-  RFDONE fPath -> s (RFDONE_, fPath)
-  RFERR e -> s (RFERR_, e)
-  SFPROG sent total -> s (SFPROG_, sent, total)
-  SFDONE sd rds -> B.unwords [s SFDONE_, serializeBinary (sfDone sd rds)]
-  SFERR e -> s (SFERR_, e)
   where
     s :: StrEncoding a => a -> ByteString
     s = strEncode
-    connections :: [ConnId] -> ByteString
-    connections = B.intercalate "," . map strEncode
-    sfDone sd rds = B.intercalate fdSeparator $ strEncode sd : map strEncode rds
 
 serializeBinary :: ByteString -> ByteString
 serializeBinary body = bshow (B.length body) <> "\n" <> body
 
--- | Send raw (unparsed) SMP agent protocol transmission to TCP connection.
-tPutRaw :: Transport c => c -> ARawTransmission -> IO ()
-tPutRaw h (corrId, entity, command) = do
-  putLn h corrId
-  putLn h entity
-  putLn h command
-
--- | Receive raw (unparsed) SMP agent protocol transmission from TCP connection.
-tGetRaw :: Transport c => c -> IO ARawTransmission
-tGetRaw h = (,,) <$> getLn h <*> getLn h <*> getLn h
-
--- | Send SMP agent protocol command (or response) to TCP connection.
-tPut :: Transport c => c -> ATransmission p -> IO ()
-tPut h (corrId, connId, APC _ cmd) =
-  tPutRaw h (corrId, connId, serializeCommand cmd)
-
--- | Receive client and agent transmissions from TCP connection.
-tGet :: forall c p. Transport c => SAParty p -> c -> IO (ATransmissionOrError p)
-tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
-  where
-    tParseLoadBody :: ARawTransmission -> IO (ATransmissionOrError p)
-    tParseLoadBody t@(corrId, entId, command) = do
-      let cmd = parseCommand command >>= fromParty >>= tConnId t
-      fullCmd <- either (return . Left) cmdWithMsgBody cmd
-      return (corrId, entId, fullCmd)
-
-    fromParty :: ACmd -> Either AgentErrorType (APartyCmd p)
-    fromParty (ACmd (p :: p1) e cmd) = case testEquality party p of
-      Just Refl -> Right $ APC e cmd
-      _ -> Left $ CMD PROHIBITED "fromParty"
-
-    tConnId :: ARawTransmission -> APartyCmd p -> Either AgentErrorType (APartyCmd p)
-    tConnId (_, entId, _) (APC e cmd) =
-      APC e <$> case cmd of
-        -- NEW, JOIN and ACPT have optional connection ID
-        NEW {} -> Right cmd
-        JOIN {} -> Right cmd
-        ACPT {} -> Right cmd
-        -- ERROR response does not always have connection ID
-        ERR _ -> Right cmd
-        CONNECT {} -> Right cmd
-        DISCONNECT {} -> Right cmd
-        DOWN {} -> Right cmd
-        UP {} -> Right cmd
-        SUSPENDED {} -> Right cmd
-        -- other responses must have connection ID
-        _
-          | B.null entId -> Left $ CMD NO_CONN "tConnId"
-          | otherwise -> Right cmd
-
-    cmdWithMsgBody :: APartyCmd p -> IO (Either AgentErrorType (APartyCmd p))
-    cmdWithMsgBody (APC e cmd) =
-      APC e <$$> case cmd of
-        SEND pqEnc msgFlags body -> SEND pqEnc msgFlags <$$> getBody body
-        MSG msgMeta msgFlags body -> MSG msgMeta msgFlags <$$> getBody body
-        JOIN ntfs qUri pqSup subMode cInfo -> JOIN ntfs qUri pqSup subMode <$$> getBody cInfo
-        CONF confId pqSup srvs cInfo -> CONF confId pqSup srvs <$$> getBody cInfo
-        LET confId cInfo -> LET confId <$$> getBody cInfo
-        REQ invId pqSup srvs cInfo -> REQ invId pqSup srvs <$$> getBody cInfo
-        ACPT invId pqSup cInfo -> ACPT invId pqSup <$$> getBody cInfo
-        INFO pqSup cInfo -> INFO pqSup <$$> getBody cInfo
-        _ -> pure $ Right cmd
-
-    getBody :: ByteString -> IO (Either AgentErrorType ByteString)
-    getBody binary =
-      case B.unpack binary of
-        ':' : body -> return . Right $ B.pack body
-        str -> case readMaybe str :: Maybe Int of
-          Just size -> runExceptT $ do
-            body <- liftIO $ cGet h size
-            unless (B.length body == size) $ throwE $ CMD SIZE "getBody"
-            s <- liftIO $ getLn h
-            unless (B.null s) $ throwE $ CMD SIZE "getBody"
-            pure body
-          Nothing -> pure . Left $ CMD SYNTAX "getBody"
-
 $(J.deriveJSON defaultJSON ''RcvQueueInfo)
 
 $(J.deriveJSON defaultJSON ''SndQueueInfo)
@@ -2006,3 +1476,7 @@ $(J.deriveJSON (sumTypeJSON id) ''AgentCryptoError)
 $(J.deriveJSON (sumTypeJSON id) ''SMPAgentError)
 
 $(J.deriveJSON (sumTypeJSON id) ''AgentErrorType)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "QD") ''QueueDirection)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "SP") ''SwitchPhase)
diff --git a/src/Simplex/Messaging/Agent/Server.hs b/src/Simplex/Messaging/Agent/Server.hs
deleted file mode 100644
index da87fde11..000000000
--- a/src/Simplex/Messaging/Agent/Server.hs
+++ /dev/null
@@ -1,85 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Simplex.Messaging.Agent.Server
-  ( -- * SMP agent over TCP
-    runSMPAgent,
-    runSMPAgentBlocking,
-  )
-where
-
-import Control.Logger.Simple (logInfo)
-import Control.Monad
-import Control.Monad.Reader
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
-import Data.Text.Encoding (decodeUtf8)
-import Network.Socket (ServiceName)
-import Simplex.Messaging.Agent
-import Simplex.Messaging.Agent.Client (newAgentClient)
-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 (defaultTransportServerConfig, loadTLSServerParams, runTransportServer)
-import Simplex.Messaging.Util (bshow)
-import UnliftIO.Async (race_)
-import qualified UnliftIO.Exception as E
-import UnliftIO.STM
-
--- | Runs an SMP agent as a TCP service using passed configuration.
---
--- See a full agent executable here: https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-agent/Main.hs
-runSMPAgent :: ATransport -> AgentConfig -> InitialAgentServers -> SQLiteStore -> IO ()
-runSMPAgent t cfg initServers store =
-  runSMPAgentBlocking t cfg initServers store 0 =<< newEmptyTMVarIO
-
--- | Runs an SMP agent as a TCP service using passed configuration with signalling.
---
--- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
--- and when it is disconnected from the TCP socket once the server thread is killed (False).
-runSMPAgentBlocking :: ATransport -> AgentConfig -> InitialAgentServers -> SQLiteStore -> Int -> TMVar Bool -> IO ()
-runSMPAgentBlocking (ATransport t) cfg@AgentConfig {tcpPort, caCertificateFile, certificateFile, privateKeyFile} initServers store initClientId started =
-  case tcpPort of
-    Just port -> newSMPAgentEnv cfg store >>= smpAgent t port
-    Nothing -> E.throwIO $ userError "no agent port"
-  where
-    smpAgent :: forall c. Transport c => TProxy c -> ServiceName -> Env -> IO ()
-    smpAgent _ port env = do
-      -- tlsServerParams is not in Env to avoid breaking functional API w/t key and certificate generation
-      tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile Nothing
-      clientId <- newTVarIO initClientId
-      runTransportServer started port tlsServerParams defaultTransportServerConfig $ \(h :: c) -> do
-        putLn h $ "Welcome to SMP agent v" <> B.pack simplexMQVersion
-        cId <- atomically $ stateTVar clientId $ \i -> (i + 1, i + 1)
-        c <- atomically $ newAgentClient cId initServers env
-        logConnection c True
-        race_ (connectClient h c) (runAgentClient c `runReaderT` env)
-          `E.finally` (disconnectAgentClient c)
-
-connectClient :: Transport c => c -> AgentClient -> IO ()
-connectClient h c = race_ (send h c) (receive h c)
-
-receive :: forall c. Transport c => c -> AgentClient -> IO ()
-receive h c@AgentClient {rcvQ, subQ} = forever $ do
-  (corrId, entId, cmdOrErr) <- tGet SClient h
-  case cmdOrErr of
-    Right cmd -> write rcvQ (corrId, entId, cmd)
-    Left e -> write subQ (corrId, entId, APC SAEConn $ ERR e)
-  where
-    write :: TBQueue (ATransmission p) -> ATransmission p -> IO ()
-    write q t = do
-      logClient c "-->" t
-      atomically $ writeTBQueue q t
-
-send :: Transport c => c -> AgentClient -> IO ()
-send h c@AgentClient {subQ} = forever $ do
-  t <- atomically $ readTBQueue subQ
-  tPut h t
-  logClient c "<--" t
-
-logClient :: AgentClient -> ByteString -> ATransmission a -> IO ()
-logClient AgentClient {clientId} dir (corrId, connId, APC _ cmd) = do
-  logInfo . decodeUtf8 $ B.unwords [bshow clientId, dir, "A :", corrId, connId, B.takeWhile (/= ' ') $ serializeCommand cmd]
diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs
index b3decd8f0..807ca223a 100644
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -47,7 +47,6 @@ import Simplex.Messaging.Protocol
     VersionSMPC,
   )
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Util ((<$?>))
 
 -- * Queue types
 
@@ -344,20 +343,20 @@ instance StrEncoding AgentCmdType where
       _ -> fail "bad AgentCmdType"
 
 data AgentCommand
-  = AClientCommand (APartyCmd 'Client)
+  = AClientCommand ACommand
   | AInternalCommand InternalCommand
 
 instance StrEncoding AgentCommand where
   strEncode = \case
-    AClientCommand (APC _ cmd) -> strEncode (ACClient, Str $ serializeCommand cmd)
+    AClientCommand cmd -> strEncode (ACClient, Str $ serializeCommand cmd)
     AInternalCommand cmd -> strEncode (ACInternal, cmd)
   strP =
     strP_ >>= \case
-      ACClient -> AClientCommand <$> ((\(ACmd _ e cmd) -> checkParty $ APC e cmd) <$?> dbCommandP)
+      ACClient -> AClientCommand <$> dbCommandP
       ACInternal -> AInternalCommand <$> strP
 
 data AgentCommandTag
-  = AClientCommandTag (APartyCmdTag 'Client)
+  = AClientCommandTag ACommandTag
   | AInternalCommandTag InternalCommandTag
   deriving (Show)
 
@@ -436,7 +435,7 @@ instance StrEncoding InternalCommandTag where
 
 agentCommandTag :: AgentCommand -> AgentCommandTag
 agentCommandTag = \case
-  AClientCommand cmd -> AClientCommandTag $ aPartyCmdTag cmd
+  AClientCommand cmd -> AClientCommandTag $ aCommandTag cmd
   AInternalCommand cmd -> AInternalCommandTag $ internalCmdTag cmd
 
 internalCmdTag :: InternalCommand -> InternalCommandTag
diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs
index b200c3933..c9e11f296 100644
--- a/tests/AgentTests.hs
+++ b/tests/AgentTests.hs
@@ -12,32 +12,12 @@ module AgentTests (agentTests) where
 
 import AgentTests.ConnectionRequestTests
 import AgentTests.DoubleRatchetTests (doubleRatchetTests)
-import AgentTests.FunctionalAPITests (functionalAPITests, inAnyOrder, pattern Msg, pattern Msg', pattern SENT)
+import AgentTests.FunctionalAPITests (functionalAPITests)
 import AgentTests.MigrationTests (migrationTests)
 import AgentTests.NotificationTests (notificationTests)
 import AgentTests.SQLiteTests (storeTests)
-import Control.Concurrent
-import Control.Monad (forM_, when)
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
-import Data.Maybe (fromJust)
-import Data.Type.Equality
-import GHC.Stack (withFrozenCallStack)
-import Network.HTTP.Types (urlEncode)
-import SMPAgentClient
-import SMPClient (testKeyHash, testPort, testPort2, testStoreLogFile, withSmpServer, withSmpServerStoreLogOn)
-import Simplex.Messaging.Agent.Protocol hiding (CONF, INFO, MID, REQ, SENT)
-import qualified Simplex.Messaging.Agent.Protocol as A
-import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
-import qualified Simplex.Messaging.Crypto.Ratchet as CR
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (ErrorType (..))
-import Simplex.Messaging.Transport (ATransport (..), TProxy (..), Transport (..))
-import Simplex.Messaging.Util (bshow)
-import System.Directory (removeFile)
-import System.Timeout
+import Simplex.Messaging.Transport (ATransport (..))
 import Test.Hspec
-import Util
 
 agentTests :: ATransport -> Spec
 agentTests (ATransport t) = do
@@ -47,602 +27,3 @@ agentTests (ATransport t) = do
   describe "Notification tests" $ notificationTests (ATransport t)
   describe "SQLite store" storeTests
   describe "Migration tests" migrationTests
-  describe "SMP agent protocol syntax" $ syntaxTests t
-  describe "Establishing duplex connection (via agent protocol)" $ do
-    skip "These tests are disabled because the agent does not work correctly with multiple connected TCP clients" $
-      describe "one agent" $ do
-        it "should connect via one server and one agent" $ do
-          smpAgentTest2_1_1 $ testDuplexConnection t
-        it "should connect via one server and one agent (random IDs)" $ do
-          smpAgentTest2_1_1 $ testDuplexConnRandomIds t
-    it "should connect via one server and 2 agents" $ do
-      smpAgentTest2_2_1 $ testDuplexConnection t
-    it "should connect via one server and 2 agents (random IDs)" $ do
-      smpAgentTest2_2_1 $ testDuplexConnRandomIds t
-    describe "should connect via 2 servers and 2 agents" $ do
-      pqMatrix2 t smpAgentTest2_2_2 testDuplexConnection'
-    describe "should connect via 2 servers and 2 agents (random IDs)" $ do
-      pqMatrix2 t smpAgentTest2_2_2 testDuplexConnRandomIds'
-  describe "Establishing connections via `contact connection`" $ do
-    describe "should connect via contact connection with one server and 3 agents" $ do
-      pqMatrix3 t smpAgentTest3 testContactConnection
-    describe "should connect via contact connection with one server and 2 agents (random IDs)" $ do
-      pqMatrix2NoInv t smpAgentTest2_2_1 testContactConnRandomIds
-    it "should support rejecting contact request" $ do
-      smpAgentTest2_2_1 $ testRejectContactRequest t
-  describe "Connection subscriptions" $ do
-    it "should connect via one server and one agent" $ do
-      smpAgentTest3_1_1 $ testSubscription t
-    it "should send notifications to client when server disconnects" $ do
-      smpAgentServerTest $ testSubscrNotification t
-  describe "Message delivery and server reconnection" $ do
-    describe "should deliver messages after losing server connection and re-connecting" $
-      pqMatrix2 t smpAgentTest2_2_2_needs_server testMsgDeliveryServerRestart
-    it "should connect to the server when server goes up if it initially was down" $ do
-      smpAgentTestN [] $ testServerConnectionAfterError t
-    it "should deliver pending messages after agent restarting" $ do
-      smpAgentTest1_1_1 $ testMsgDeliveryAgentRestart t
-    it "should concurrently deliver messages to connections without blocking" $ do
-      smpAgentTest2_2_1 $ testConcurrentMsgDelivery t
-    it "should deliver messages if one of connections has quota exceeded" $ do
-      smpAgentTest2_2_1 $ testMsgDeliveryQuotaExceeded t
-    it "should resume delivering messages after exceeding quota once all messages are received" $ do
-      smpAgentTest2_2_1 $ testResumeDeliveryQuotaExceeded t
-
-type AEntityTransmission p e = (ACorrId, ConnId, ACommand p e)
-
-type AEntityTransmissionOrError p e = (ACorrId, ConnId, Either AgentErrorType (ACommand p e))
-
-tGetAgent :: Transport c => c -> IO (AEntityTransmissionOrError 'Agent 'AEConn)
-tGetAgent = tGetAgent' True
-
-tGetAgent' :: forall c e. (Transport c, AEntityI e) => Bool -> c -> IO (AEntityTransmissionOrError 'Agent e)
-tGetAgent' skipErr h = do
-  (corrId, connId, cmdOrErr) <- pGetAgent skipErr h
-  case cmdOrErr of
-    Right (APC e cmd) -> case testEquality e (sAEntity @e) of
-      Just Refl -> pure (corrId, connId, Right cmd)
-      _ -> error $ "unexpected command " <> show cmd
-    Left err -> pure (corrId, connId, Left err)
-
-pGetAgent :: forall c. Transport c => Bool -> c -> IO (ATransmissionOrError 'Agent)
-pGetAgent skipErr h = do
-  (corrId, connId, cmdOrErr) <- tGet SAgent h
-  case cmdOrErr of
-    Right (APC _ CONNECT {}) -> pGetAgent skipErr h
-    Right (APC _ DISCONNECT {}) -> pGetAgent skipErr h
-    Right (APC _ (ERR (BROKER _ NETWORK))) | skipErr -> pGetAgent skipErr h
-    cmd -> pure (corrId, connId, cmd)
-
--- | receive message to handle `h`
-(<#:) :: Transport c => c -> IO (AEntityTransmissionOrError 'Agent 'AEConn)
-(<#:) = tGetAgent
-
-(<#:?) :: Transport c => c -> IO (ATransmissionOrError 'Agent)
-(<#:?) = pGetAgent True
-
-(<#:.) :: Transport c => c -> IO (AEntityTransmissionOrError 'Agent 'AENone)
-(<#:.) = tGetAgent' True
-
--- | send transmission `t` to handle `h` and get response
-(#:) :: Transport c => c -> (ByteString, ByteString, ByteString) -> IO (AEntityTransmissionOrError 'Agent 'AEConn)
-h #: t = tPutRaw h t >> (<#:) h
-
-(#:!) :: Transport c => c -> (ByteString, ByteString, ByteString) -> IO (AEntityTransmissionOrError 'Agent 'AEConn)
-h #:! t = tPutRaw h t >> tGetAgent' False h
-
--- | action and expected response
--- `h #:t #> r` is the test that sends `t` to `h` and validates that the response is `r`
-(#>) :: IO (AEntityTransmissionOrError 'Agent 'AEConn) -> AEntityTransmission 'Agent 'AEConn -> Expectation
-action #> (corrId, connId, cmd) = withFrozenCallStack $ action `shouldReturn` (corrId, connId, Right cmd)
-
--- | action and predicate for the response
--- `h #:t =#> p` is the test that sends `t` to `h` and validates the response using `p`
-(=#>) :: IO (AEntityTransmissionOrError 'Agent 'AEConn) -> (AEntityTransmission 'Agent 'AEConn -> Bool) -> Expectation
-action =#> p = withFrozenCallStack $ action >>= (`shouldSatisfy` p . correctTransmission)
-
-pattern MID :: AgentMsgId -> ACommand 'Agent 'AEConn
-pattern MID msgId = A.MID msgId PQEncOn
-
-correctTransmission :: (ACorrId, ConnId, Either AgentErrorType cmd) -> (ACorrId, ConnId, cmd)
-correctTransmission (corrId, connId, cmdOrErr) = case cmdOrErr of
-  Right cmd -> (corrId, connId, cmd)
-  Left e -> error $ show e
-
--- | receive message to handle `h` and validate that it is the expected one
-(<#) :: (HasCallStack, Transport c) => c -> AEntityTransmission 'Agent 'AEConn -> Expectation
-h <# (corrId, connId, cmd) = timeout 5000000 (h <#:) `shouldReturn` Just (corrId, connId, Right cmd)
-
-(<#.) :: (HasCallStack, Transport c) => c -> AEntityTransmission 'Agent 'AENone -> Expectation
-h <#. (corrId, connId, cmd) = timeout 5000000 (h <#:.) `shouldReturn` Just (corrId, connId, Right cmd)
-
--- | receive message to handle `h` and validate it using predicate `p`
-(<#=) :: (HasCallStack, Transport c) => c -> (AEntityTransmission 'Agent 'AEConn -> Bool) -> Expectation
-h <#= p = timeout 5000000 (h <#:) >>= (`shouldSatisfy` p . correctTransmission . fromJust)
-
-(<#=?) :: (HasCallStack, Transport c) => c -> (ATransmission 'Agent -> Bool) -> Expectation
-h <#=? p = timeout 5000000 (h <#:?) >>= (`shouldSatisfy` p . correctTransmission . fromJust)
-
--- | test that nothing is delivered to handle `h` during 10ms
-(#:#) :: Transport c => c -> String -> Expectation
-h #:# err = tryGet `shouldReturn` ()
-  where
-    tryGet =
-      10000 `timeout` tGetAgent h >>= \case
-        Just _ -> error err
-        _ -> return ()
-
-type PQMatrix2 c =
-  HasCallStack =>
-  TProxy c ->
-  (HasCallStack => (c -> c -> IO ()) -> Expectation) ->
-  (HasCallStack => (c, InitialKeys) -> (c, PQSupport) -> IO ()) ->
-  Spec
-
-pqMatrix2 :: PQMatrix2 c
-pqMatrix2 = pqMatrix2_ True
-
-pqMatrix2NoInv :: PQMatrix2 c
-pqMatrix2NoInv = pqMatrix2_ False
-
-pqMatrix2_ :: Bool -> PQMatrix2 c
-pqMatrix2_ pqInv _ smpTest test = do
-  it "dh/dh handshake" $ smpTest $ \a b -> test (a, IKPQOff) (b, PQSupportOff)
-  it "dh/pq handshake" $ smpTest $ \a b -> test (a, IKPQOff) (b, PQSupportOn)
-  it "pq/dh handshake" $ smpTest $ \a b -> test (a, IKPQOn) (b, PQSupportOff)
-  it "pq/pq handshake" $ smpTest $ \a b -> test (a, IKPQOn) (b, PQSupportOn)
-  when pqInv $ do
-    it "pq-inv/dh handshake" $ smpTest $ \a b -> test (a, IKUsePQ) (b, PQSupportOff)
-    it "pq-inv/pq handshake" $ smpTest $ \a b -> test (a, IKUsePQ) (b, PQSupportOn)
-
-pqMatrix3 ::
-  HasCallStack =>
-  TProxy c ->
-  (HasCallStack => (c -> c -> c -> IO ()) -> Expectation) ->
-  (HasCallStack => (c, InitialKeys) -> (c, PQSupport) -> (c, PQSupport) -> IO ()) ->
-  Spec
-pqMatrix3 _ smpTest test = do
-  it "dh" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOff) (c, PQSupportOff)
-  it "dh/dh/pq" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOff) (c, PQSupportOn)
-  it "dh/pq/dh" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOn) (c, PQSupportOff)
-  it "dh/pq/pq" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOn) (c, PQSupportOn)
-  it "pq/dh/dh" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOff) (c, PQSupportOff)
-  it "pq/dh/pq" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOff) (c, PQSupportOn)
-  it "pq/pq/dh" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOn) (c, PQSupportOff)
-  it "pq" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOn) (c, PQSupportOn)
-
-testDuplexConnection :: (HasCallStack, Transport c) => TProxy c -> c -> c -> IO ()
-testDuplexConnection _ alice bob = testDuplexConnection' (alice, IKPQOn) (bob, PQSupportOn)
-
-testDuplexConnection' :: (HasCallStack, Transport c) => (c, InitialKeys) -> (c, PQSupport) -> IO ()
-testDuplexConnection' (alice, aPQ) (bob, bPQ) = do
-  let pq = pqConnectionMode aPQ bPQ
-  ("1", "bob", Right (INV cReq)) <- alice #: ("1", "bob", "NEW T INV" <> pqConnModeStr aPQ <> " subscribe")
-  let cReq' = strEncode cReq
-  bob #: ("11", "alice", "JOIN T " <> cReq' <> enableKEMStr bPQ <> " subscribe 14\nbob's connInfo") #> ("11", "alice", OK)
-  ("", "bob", Right (A.CONF confId pqSup' _ "bob's connInfo")) <- (alice <#:)
-  pqSup' `shouldBe` CR.connPQEncryption aPQ
-  alice #: ("2", "bob", "LET " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
-  bob <# ("", "alice", A.INFO bPQ "alice's connInfo")
-  bob <# ("", "alice", CON pq)
-  alice <# ("", "bob", CON pq)
-  -- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4
-  alice #: ("3", "bob", "SEND F :hello") #> ("3", "bob", A.MID 4 pq)
-  alice <# ("", "bob", SENT 4)
-  bob <#= \case ("", "alice", Msg' 4 pq' "hello") -> pq == pq'; _ -> False
-  bob #: ("12", "alice", "ACK 4") #> ("12", "alice", OK)
-  alice #: ("4", "bob", "SEND F :how are you?") #> ("4", "bob", A.MID 5 pq)
-  alice <# ("", "bob", SENT 5)
-  bob <#= \case ("", "alice", Msg' 5 pq' "how are you?") -> pq == pq'; _ -> False
-  bob #: ("13", "alice", "ACK 5") #> ("13", "alice", OK)
-  bob #: ("14", "alice", "SEND F 9\nhello too") #> ("14", "alice", A.MID 6 pq)
-  bob <# ("", "alice", SENT 6)
-  alice <#= \case ("", "bob", Msg' 6 pq' "hello too") -> pq == pq'; _ -> False
-  alice #: ("3a", "bob", "ACK 6") #> ("3a", "bob", OK)
-  bob #: ("15", "alice", "SEND F 9\nmessage 1") #> ("15", "alice", A.MID 7 pq)
-  bob <# ("", "alice", SENT 7)
-  alice <#= \case ("", "bob", Msg' 7 pq' "message 1") -> pq == pq'; _ -> False
-  alice #: ("4a", "bob", "ACK 7") #> ("4a", "bob", OK)
-  alice #: ("5", "bob", "OFF") #> ("5", "bob", OK)
-  bob #: ("17", "alice", "SEND F 9\nmessage 3") #> ("17", "alice", A.MID 8 pq)
-  bob <#= \case ("", "alice", MERR 8 (SMP _ AUTH)) -> True; _ -> False
-  alice #: ("6", "bob", "DEL") #> ("6", "bob", OK)
-  alice #:# "nothing else should be delivered to alice"
-
-testDuplexConnRandomIds :: (HasCallStack, Transport c) => TProxy c -> c -> c -> IO ()
-testDuplexConnRandomIds _ alice bob = testDuplexConnRandomIds' (alice, IKPQOn) (bob, PQSupportOn)
-
-testDuplexConnRandomIds' :: (HasCallStack, Transport c) => (c, InitialKeys) -> (c, PQSupport) -> IO ()
-testDuplexConnRandomIds' (alice, aPQ) (bob, bPQ) = do
-  let pq = pqConnectionMode aPQ bPQ
-  ("1", bobConn, Right (INV cReq)) <- alice #: ("1", "", "NEW T INV" <> pqConnModeStr aPQ <> " subscribe")
-  let cReq' = strEncode cReq
-  ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN T " <> cReq' <> enableKEMStr bPQ <> " subscribe 14\nbob's connInfo")
-  ("", bobConn', Right (A.CONF confId pqSup' _ "bob's connInfo")) <- (alice <#:)
-  pqSup' `shouldBe` CR.connPQEncryption aPQ
-  bobConn' `shouldBe` bobConn
-  alice #: ("2", bobConn, "LET " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False
-  bob <# ("", aliceConn, A.INFO bPQ "alice's connInfo")
-  bob <# ("", aliceConn, CON pq)
-  alice <# ("", bobConn, CON pq)
-  alice #: ("2", bobConn, "SEND F :hello") #> ("2", bobConn, A.MID 4 pq)
-  alice <# ("", bobConn, SENT 4)
-  bob <#= \case ("", c, Msg' 4 pq' "hello") -> c == aliceConn && pq == pq'; _ -> False
-  bob #: ("12", aliceConn, "ACK 4") #> ("12", aliceConn, OK)
-  alice #: ("3", bobConn, "SEND F :how are you?") #> ("3", bobConn, A.MID 5 pq)
-  alice <# ("", bobConn, SENT 5)
-  bob <#= \case ("", c, Msg' 5 pq' "how are you?") -> c == aliceConn && pq == pq'; _ -> False
-  bob #: ("13", aliceConn, "ACK 5") #> ("13", aliceConn, OK)
-  bob #: ("14", aliceConn, "SEND F 9\nhello too") #> ("14", aliceConn, A.MID 6 pq)
-  bob <# ("", aliceConn, SENT 6)
-  alice <#= \case ("", c, Msg' 6 pq' "hello too") -> c == bobConn && pq == pq'; _ -> False
-  alice #: ("3a", bobConn, "ACK 6") #> ("3a", bobConn, OK)
-  bob #: ("15", aliceConn, "SEND F 9\nmessage 1") #> ("15", aliceConn, A.MID 7 pq)
-  bob <# ("", aliceConn, SENT 7)
-  alice <#= \case ("", c, Msg' 7 pq' "message 1") -> c == bobConn && pq == pq'; _ -> False
-  alice #: ("4a", bobConn, "ACK 7") #> ("4a", bobConn, OK)
-  alice #: ("5", bobConn, "OFF") #> ("5", bobConn, OK)
-  bob #: ("17", aliceConn, "SEND F 9\nmessage 3") #> ("17", aliceConn, A.MID 8 pq)
-  bob <#= \case ("", cId, MERR 8 (SMP _ AUTH)) -> cId == aliceConn; _ -> False
-  alice #: ("6", bobConn, "DEL") #> ("6", bobConn, OK)
-  alice #:# "nothing else should be delivered to alice"
-
-testContactConnection :: Transport c => (c, InitialKeys) -> (c, PQSupport) -> (c, PQSupport) -> IO ()
-testContactConnection (alice, aPQ) (bob, bPQ) (tom, tPQ) = do
-  ("1", "alice_contact", Right (INV cReq)) <- alice #: ("1", "alice_contact", "NEW T CON" <> pqConnModeStr aPQ <> " subscribe")
-  let cReq' = strEncode cReq
-      abPQ = pqConnectionMode aPQ bPQ
-      aPQMode = CR.connPQEncryption aPQ
-
-  bob #: ("11", "alice", "JOIN T " <> cReq' <> enableKEMStr bPQ <> " subscribe 14\nbob's connInfo") #> ("11", "alice", OK)
-  ("", "alice_contact", Right (A.REQ aInvId PQSupportOn _ "bob's connInfo")) <- (alice <#:)
-  alice #: ("2", "bob", "ACPT " <> aInvId <> enableKEMStr aPQMode <> " 16\nalice's connInfo") #> ("2", "bob", OK)
-  ("", "alice", Right (A.CONF bConfId pqSup'' _ "alice's connInfo")) <- (bob <#:)
-  pqSup'' `shouldBe` bPQ
-  bob #: ("12", "alice", "LET " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", "alice", OK)
-  alice <# ("", "bob", A.INFO (CR.connPQEncryption aPQ) "bob's connInfo 2")
-  alice <# ("", "bob", CON abPQ)
-  bob <# ("", "alice", CON abPQ)
-  alice #: ("3", "bob", "SEND F :hi") #> ("3", "bob", A.MID 4 abPQ)
-  alice <# ("", "bob", SENT 4)
-  bob <#= \case ("", "alice", Msg' 4 pq' "hi") -> pq' == abPQ; _ -> False
-  bob #: ("13", "alice", "ACK 4") #> ("13", "alice", OK)
-
-  let atPQ = pqConnectionMode aPQ tPQ
-  tom #: ("21", "alice", "JOIN T " <> cReq' <> enableKEMStr tPQ <> " subscribe 14\ntom's connInfo") #> ("21", "alice", OK)
-  ("", "alice_contact", Right (A.REQ aInvId' PQSupportOn _ "tom's connInfo")) <- (alice <#:)
-  alice #: ("4", "tom", "ACPT " <> aInvId' <> enableKEMStr aPQMode <> " 16\nalice's connInfo") #> ("4", "tom", OK)
-  ("", "alice", Right (A.CONF tConfId pqSup4 _ "alice's connInfo")) <- (tom <#:)
-  pqSup4 `shouldBe` tPQ
-  tom #: ("22", "alice", "LET " <> tConfId <> " 16\ntom's connInfo 2") #> ("22", "alice", OK)
-  alice <# ("", "tom", A.INFO (CR.connPQEncryption aPQ) "tom's connInfo 2")
-  alice <# ("", "tom", CON atPQ)
-  tom <# ("", "alice", CON atPQ)
-  alice #: ("5", "tom", "SEND F :hi there") #> ("5", "tom", A.MID 4 atPQ)
-  alice <# ("", "tom", SENT 4)
-  tom <#= \case ("", "alice", Msg' 4 pq' "hi there") -> pq' == atPQ; _ -> False
-  tom #: ("23", "alice", "ACK 4") #> ("23", "alice", OK)
-
-testContactConnRandomIds :: Transport c => (c, InitialKeys) -> (c, PQSupport) -> IO ()
-testContactConnRandomIds (alice, aPQ) (bob, bPQ) = do
-  let pq = pqConnectionMode aPQ bPQ
-  ("1", aliceContact, Right (INV cReq)) <- alice #: ("1", "", "NEW T CON" <> pqConnModeStr aPQ <> " subscribe")
-  let cReq' = strEncode cReq
-
-  ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN T " <> cReq' <> enableKEMStr bPQ <> " subscribe 14\nbob's connInfo")
-  ("", aliceContact', Right (A.REQ aInvId PQSupportOn _ "bob's connInfo")) <- (alice <#:)
-  aliceContact' `shouldBe` aliceContact
-
-  ("2", bobConn, Right OK) <- alice #: ("2", "", "ACPT " <> aInvId <> enableKEMStr (CR.connPQEncryption aPQ) <> " 16\nalice's connInfo")
-  ("", aliceConn', Right (A.CONF bConfId pqSup'' _ "alice's connInfo")) <- (bob <#:)
-  pqSup'' `shouldBe` bPQ
-  aliceConn' `shouldBe` aliceConn
-
-  bob #: ("12", aliceConn, "LET " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", aliceConn, OK)
-  alice <# ("", bobConn, A.INFO (CR.connPQEncryption aPQ) "bob's connInfo 2")
-  alice <# ("", bobConn, CON pq)
-  bob <# ("", aliceConn, CON pq)
-
-  alice #: ("3", bobConn, "SEND F :hi") #> ("3", bobConn, A.MID 4 pq)
-  alice <# ("", bobConn, SENT 4)
-  bob <#= \case ("", c, Msg' 4 pq' "hi") -> c == aliceConn && pq == pq'; _ -> False
-  bob #: ("13", aliceConn, "ACK 4") #> ("13", aliceConn, OK)
-
-testRejectContactRequest :: Transport c => TProxy c -> c -> c -> IO ()
-testRejectContactRequest _ alice bob = do
-  ("1", "a_contact", Right (INV cReq)) <- alice #: ("1", "a_contact", "NEW T CON subscribe")
-  let cReq' = strEncode cReq
-  bob #: ("11", "alice", "JOIN T " <> cReq' <> " subscribe 10\nbob's info") #> ("11", "alice", OK)
-  ("", "a_contact", Right (A.REQ aInvId PQSupportOn _ "bob's info")) <- (alice <#:)
-  -- RJCT must use correct contact connection
-  alice #: ("2a", "bob", "RJCT " <> aInvId) #> ("2a", "bob", ERR $ CONN NOT_FOUND)
-  alice #: ("2b", "a_contact", "RJCT " <> aInvId) #> ("2b", "a_contact", OK)
-  alice #: ("3", "bob", "ACPT " <> aInvId <> " 12\nalice's info") =#> \case ("3", "bob", ERR (A.CMD PROHIBITED _)) -> True; _ -> False
-  bob #:# "nothing should be delivered to bob"
-
-testSubscription :: Transport c => TProxy c -> c -> c -> c -> IO ()
-testSubscription _ alice1 alice2 bob = do
-  (alice1, "alice") `connect` (bob, "bob")
-  bob #: ("12", "alice", "SEND F 5\nhello") #> ("12", "alice", MID 4)
-  bob <# ("", "alice", SENT 4)
-  alice1 <#= \case ("", "bob", Msg "hello") -> True; _ -> False
-  alice1 #: ("1", "bob", "ACK 4") #> ("1", "bob", OK)
-  bob #: ("13", "alice", "SEND F 11\nhello again") #> ("13", "alice", MID 5)
-  bob <# ("", "alice", SENT 5)
-  alice1 <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
-  alice1 #: ("2", "bob", "ACK 5") #> ("2", "bob", OK)
-  alice2 #: ("21", "bob", "SUB") #> ("21", "bob", OK)
-  alice1 <# ("", "bob", END)
-  bob #: ("14", "alice", "SEND F 2\nhi") #> ("14", "alice", MID 6)
-  bob <# ("", "alice", SENT 6)
-  alice2 <#= \case ("", "bob", Msg "hi") -> True; _ -> False
-  alice2 #: ("22", "bob", "ACK 6") #> ("22", "bob", OK)
-  alice1 #:# "nothing else should be delivered to alice1"
-
-testSubscrNotification :: Transport c => TProxy c -> (ThreadId, ThreadId) -> c -> IO ()
-testSubscrNotification t (server, _) client = do
-  client #: ("1", "conn1", "NEW T INV subscribe") =#> \case ("1", "conn1", INV {}) -> True; _ -> False
-  client #:# "nothing should be delivered to client before the server is killed"
-  killThread server
-  client <#. ("", "", DOWN testSMPServer ["conn1"])
-  withSmpServer (ATransport t) $
-    client <#= \case ("", "conn1", ERR (SMP _ AUTH)) -> True; _ -> False -- this new server does not have the queue
-
-testMsgDeliveryServerRestart :: forall c. Transport c => (c, InitialKeys) -> (c, PQSupport) -> IO ()
-testMsgDeliveryServerRestart (alice, aPQ) (bob, bPQ) = do
-  let pq = pqConnectionMode aPQ bPQ
-  withServer $ do
-    connect' (alice, "alice", aPQ) (bob, "bob", bPQ)
-    bob #: ("1", "alice", "SEND F 2\nhi") #> ("1", "alice", A.MID 4 pq)
-    bob <# ("", "alice", SENT 4)
-    alice <#= \case ("", "bob", Msg' _ pq' "hi") -> pq == pq'; _ -> False
-    alice #: ("11", "bob", "ACK 4") #> ("11", "bob", OK)
-    alice #:# "nothing else delivered before the server is killed"
-
-  let server = SMPServer "localhost" testPort2 testKeyHash
-  alice <#. ("", "", DOWN server ["bob"])
-  bob #: ("2", "alice", "SEND F 11\nhello again") #> ("2", "alice", A.MID 5 pq)
-  bob #:# "nothing else delivered before the server is restarted"
-  alice #:# "nothing else delivered before the server is restarted"
-
-  withServer $ do
-    bob <# ("", "alice", SENT 5)
-    alice <#. ("", "", UP server ["bob"])
-    alice <#= \case ("", "bob", Msg' _ pq' "hello again") -> pq == pq'; _ -> False
-    alice #: ("12", "bob", "ACK 5") #> ("12", "bob", OK)
-
-  removeFile testStoreLogFile
-  where
-    withServer test' = withSmpServerStoreLogOn (transport @c) testPort2 (const test') `shouldReturn` ()
-
-testServerConnectionAfterError :: forall c. Transport c => TProxy c -> [c] -> IO ()
-testServerConnectionAfterError t _ = do
-  withAgent1 $ \bob -> do
-    withAgent2 $ \alice -> do
-      withServer $ do
-        connect (bob, "bob") (alice, "alice")
-      bob <#. ("", "", DOWN server ["alice"])
-      alice <#. ("", "", DOWN server ["bob"])
-      alice #: ("1", "bob", "SEND F 5\nhello") #> ("1", "bob", MID 4)
-      alice #:# "nothing else delivered before the server is restarted"
-      bob #:# "nothing else delivered before the server is restarted"
-
-  withAgent1 $ \bob -> do
-    withAgent2 $ \alice -> do
-      bob #:! ("1", "alice", "SUB") =#> \case ("1", "alice", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT; _ -> False
-      alice #:! ("1", "bob", "SUB") =#> \case ("1", "bob", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT; _ -> False
-      withServer $ do
-        alice <#=? \case ("", "bob", APC SAEConn (SENT 4)) -> True; ("", "", APC _ (UP s ["bob"])) -> s == server; _ -> False
-        alice <#=? \case ("", "bob", APC SAEConn (SENT 4)) -> True; ("", "", APC _ (UP s ["bob"])) -> s == server; _ -> False
-        bob <#=? \case ("", "alice", APC _ (Msg "hello")) -> True; ("", "", APC _ (UP s ["alice"])) -> s == server; _ -> False
-        bob <#=? \case ("", "alice", APC _ (Msg "hello")) -> True; ("", "", APC _ (UP s ["alice"])) -> s == server; _ -> False
-        bob #: ("2", "alice", "ACK 4") #> ("2", "alice", OK)
-        alice #: ("1", "bob", "SEND F 11\nhello again") #> ("1", "bob", MID 5)
-        alice <# ("", "bob", SENT 5)
-        bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False
-
-  removeFile testStoreLogFile
-  removeFile testDB
-  removeFile testDB2
-  where
-    server = SMPServer "localhost" testPort2 testKeyHash
-    withServer test' = withSmpServerStoreLogOn (ATransport t) testPort2 (const test') `shouldReturn` ()
-    withAgent1 = withAgent agentTestPort testDB 0
-    withAgent2 = withAgent agentTestPort2 testDB2 10
-    withAgent :: String -> FilePath -> Int -> (c -> IO a) -> IO a
-    withAgent agentPort agentDB initClientId = withSmpAgentThreadOn_ (ATransport t) (agentPort, testPort2, agentDB) initClientId (pure ()) . const . testSMPAgentClientOn agentPort
-
-testMsgDeliveryAgentRestart :: Transport c => TProxy c -> c -> IO ()
-testMsgDeliveryAgentRestart t bob = do
-  let server = SMPServer "localhost" testPort2 testKeyHash
-  withAgent $ \alice -> do
-    withServer $ do
-      connect (bob, "bob") (alice, "alice")
-      alice #: ("1", "bob", "SEND F 5\nhello") #> ("1", "bob", MID 4)
-      alice <# ("", "bob", SENT 4)
-      bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
-      bob #: ("11", "alice", "ACK 4") #> ("11", "alice", OK)
-      bob #:# "nothing else delivered before the server is down"
-
-    bob <#. ("", "", DOWN server ["alice"])
-    alice #: ("2", "bob", "SEND F 11\nhello again") #> ("2", "bob", MID 5)
-    alice #:# "nothing else delivered before the server is restarted"
-    bob #:# "nothing else delivered before the server is restarted"
-
-  withAgent $ \alice -> do
-    withServer $ do
-      tPutRaw alice ("3", "bob", "SUB")
-      alice <#= \case
-        (corrId, "bob", cmd) ->
-          (corrId == "3" && cmd == OK)
-            || (corrId == "" && cmd == SENT 5)
-        _ -> False
-      bob <#=? \case ("", "alice", APC _ (Msg "hello again")) -> True; ("", "", APC _ (UP s ["alice"])) -> s == server; _ -> False
-      bob <#=? \case ("", "alice", APC _ (Msg "hello again")) -> True; ("", "", APC _ (UP s ["alice"])) -> s == server; _ -> False
-      bob #: ("12", "alice", "ACK 5") #> ("12", "alice", OK)
-
-  removeFile testStoreLogFile
-  removeFile testDB
-  where
-    withServer test' = withSmpServerStoreLogOn (ATransport t) testPort2 (const test') `shouldReturn` ()
-    withAgent = withSmpAgentThreadOn_ (ATransport t) (agentTestPort, testPort, testDB) 0 (pure ()) . const . testSMPAgentClientOn agentTestPort
-
-testConcurrentMsgDelivery :: Transport c => TProxy c -> c -> c -> IO ()
-testConcurrentMsgDelivery _ alice bob = do
-  connect (alice, "alice") (bob, "bob")
-
-  ("1", "bob2", Right (INV cReq)) <- alice #: ("1", "bob2", "NEW T INV subscribe")
-  let cReq' = strEncode cReq
-  bob #: ("11", "alice2", "JOIN T " <> cReq' <> " subscribe 14\nbob's connInfo") #> ("11", "alice2", OK)
-  ("", "bob2", Right (A.CONF _confId PQSupportOff _ "bob's connInfo")) <- (alice <#:)
-  -- below commands would be needed to accept bob's connection, but alice does not
-  -- alice #: ("2", "bob", "LET " <> _confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
-  -- bob <# ("", "alice", INFO "alice's connInfo")
-  -- bob <# ("", "alice", CON)
-  -- alice <# ("", "bob", CON)
-
-  -- the first connection should not be blocked by the second one
-  sendMessage (alice, "alice") (bob, "bob") "hello"
-  -- alice #: ("2", "bob", "SEND F :hello") #> ("2", "bob", MID 1)
-  -- alice <# ("", "bob", SENT 1)
-  -- bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
-  -- bob #: ("12", "alice", "ACK 1") #> ("12", "alice", OK)
-  bob #: ("14", "alice", "SEND F 9\nhello too") #> ("14", "alice", MID 5)
-  bob <# ("", "alice", SENT 5)
-  -- if delivery is blocked it won't go further
-  alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
-  alice #: ("3", "bob", "ACK 5") #> ("3", "bob", OK)
-
-testMsgDeliveryQuotaExceeded :: Transport c => TProxy c -> c -> c -> IO ()
-testMsgDeliveryQuotaExceeded _ alice bob = do
-  connect (alice, "alice") (bob, "bob")
-  connect (alice, "alice2") (bob, "bob2")
-  forM_ [1 .. 4 :: Int] $ \i -> do
-    let corrId = bshow i
-        msg = "message " <> bshow i
-    (_, "bob", Right (MID mId)) <- alice #: (corrId, "bob", "SEND F :" <> msg)
-    alice <#= \case ("", "bob", SENT m) -> m == mId; _ -> False
-  (_, "bob", Right (MID _)) <- alice #: ("5", "bob", "SEND F :over quota")
-  alice <#= \case ("", "bob", MWARN _ (SMP _ QUOTA)) -> True; _ -> False
-
-  alice #: ("1", "bob2", "SEND F :hello") #> ("1", "bob2", MID 4)
-  -- if delivery is blocked it won't go further
-  alice <# ("", "bob2", SENT 4)
-
-testResumeDeliveryQuotaExceeded :: Transport c => TProxy c -> c -> c -> IO ()
-testResumeDeliveryQuotaExceeded _ alice bob = do
-  connect (alice, "alice") (bob, "bob")
-  forM_ [1 .. 4 :: Int] $ \i -> do
-    let corrId = bshow i
-        msg = "message " <> bshow i
-    (_, "bob", Right (MID mId)) <- alice #: (corrId, "bob", "SEND F :" <> msg)
-    alice <#= \case ("", "bob", SENT m) -> m == mId; _ -> False
-  ("5", "bob", Right (MID 8)) <- alice #: ("5", "bob", "SEND F :over quota")
-  alice <#= \case ("", "bob", MWARN 8 (SMP _ QUOTA)) -> True; _ -> False
-  alice #:# "the last message not sent yet"
-  bob <#= \case ("", "alice", Msg "message 1") -> True; _ -> False
-  bob #: ("1", "alice", "ACK 4") #> ("1", "alice", OK)
-  alice #:# "the last message not sent"
-  bob <#= \case ("", "alice", Msg "message 2") -> True; _ -> False
-  bob #: ("2", "alice", "ACK 5") #> ("2", "alice", OK)
-  alice #:# "the last message not sent"
-  bob <#= \case ("", "alice", Msg "message 3") -> True; _ -> False
-  bob #: ("3", "alice", "ACK 6") #> ("3", "alice", OK)
-  alice #:# "the last message not sent"
-  bob <#= \case ("", "alice", Msg "message 4") -> True; _ -> False
-  bob #: ("4", "alice", "ACK 7") #> ("4", "alice", OK)
-  inAnyOrder
-    (tGetAgent alice)
-    [ \case ("", c, Right (SENT 8)) -> c == "bob"; _ -> False,
-      \case ("", c, Right QCONT) -> c == "bob"; _ -> False
-    ]
-  bob <#= \case ("", "alice", Msg "over quota") -> True; _ -> False
-  -- message 8 is skipped because of alice agent sending "QCONT" message
-  bob #: ("5", "alice", "ACK 9") #> ("5", "alice", OK)
-
-connect :: Transport c => (c, ByteString) -> (c, ByteString) -> IO ()
-connect (h1, name1) (h2, name2) = connect' (h1, name1, IKPQOn) (h2, name2, PQSupportOn)
-
-connect' :: forall c. Transport c => (c, ByteString, InitialKeys) -> (c, ByteString, PQSupport) -> IO ()
-connect' (h1, name1, pqMode1) (h2, name2, pqMode2) = do
-  ("c1", _, Right (INV cReq)) <- h1 #: ("c1", name2, "NEW T INV" <> pqConnModeStr pqMode1 <> " subscribe")
-  let cReq' = strEncode cReq
-      pq = pqConnectionMode pqMode1 pqMode2
-  h2 #: ("c2", name1, "JOIN T " <> cReq' <> enableKEMStr pqMode2 <> " subscribe 5\ninfo2") #> ("c2", name1, OK)
-  ("", _, Right (A.CONF connId pqSup' _ "info2")) <- (h1 <#:)
-  pqSup' `shouldBe` CR.connPQEncryption pqMode1
-  h1 #: ("c3", name2, "LET " <> connId <> " 5\ninfo1") #> ("c3", name2, OK)
-  h2 <# ("", name1, A.INFO pqMode2 "info1")
-  h2 <# ("", name1, CON pq)
-  h1 <# ("", name2, CON pq)
-
-pqConnectionMode :: InitialKeys -> PQSupport -> PQEncryption
-pqConnectionMode pqMode1 pqMode2 = PQEncryption $ supportPQ (CR.connPQEncryption pqMode1) && supportPQ pqMode2
-
-enableKEMStr :: PQSupport -> ByteString
-enableKEMStr PQSupportOn = " " <> strEncode PQSupportOn
-enableKEMStr _ = ""
-
-pqConnModeStr :: InitialKeys -> ByteString
-pqConnModeStr (IKNoPQ PQSupportOff) = ""
-pqConnModeStr pq = " " <> strEncode pq
-
-sendMessage :: Transport c => (c, ConnId) -> (c, ConnId) -> ByteString -> IO ()
-sendMessage (h1, name1) (h2, name2) msg = do
-  ("m1", name2', Right (MID mId)) <- h1 #: ("m1", name2, "SEND F :" <> msg)
-  name2' `shouldBe` name2
-  h1 <#= \case ("", n, SENT m) -> n == name2 && m == mId; _ -> False
-  ("", name1', Right (MSG MsgMeta {recipient = (msgId', _)} _ msg')) <- (h2 <#:)
-  name1' `shouldBe` name1
-  msg' `shouldBe` msg
-  h2 #: ("m2", name1, "ACK " <> bshow msgId') =#> \case ("m2", n, OK) -> n == name1; _ -> False
-
--- connect' :: forall c. Transport c => c -> c -> IO (ByteString, ByteString)
--- connect' h1 h2 = do
---   ("c1", conn2, Right (INV cReq)) <- h1 #: ("c1", "", "NEW T INV subscribe")
---   let cReq' = strEncode cReq
---   ("c2", conn1, Right OK) <- h2 #: ("c2", "", "JOIN T " <> cReq' <> " subscribe 5\ninfo2")
---   ("", _, Right (REQ connId _ "info2")) <- (h1 <#:)
---   h1 #: ("c3", conn2, "ACPT " <> connId <> " 5\ninfo1") =#> \case ("c3", c, OK) -> c == conn2; _ -> False
---   h2 <# ("", conn1, INFO "info1")
---   h2 <# ("", conn1, CON)
---   h1 <# ("", conn2, CON)
---   pure (conn1, conn2)
-
-sampleDhKey :: ByteString
-sampleDhKey = "MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
-
-syntaxTests :: forall c. Transport c => TProxy c -> Spec
-syntaxTests t = do
-  it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR CMD SYNTAX parseCommand")
-  describe "NEW" $ do
-    describe "valid" $ do
-      it "with correct parameter" $ ("211", "", "NEW T INV subscribe") >#>= \case ("211", _, "INV" : _) -> True; _ -> False
-    describe "invalid" $ do
-      it "with incorrect parameter" $ ("222", "", "NEW T hi subscribe") >#> ("222", "", "ERR CMD SYNTAX parseCommand")
-
-  describe "JOIN" $ do
-    describe "valid" $ do
-      it "using same server as in invitation" $
-        ( "311",
-          "a",
-          "JOIN T https://simpex.chat/invitation#/?smp=smp%3A%2F%2F"
-            <> urlEncode True "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
-            <> "%40localhost%3A5001%2F3456-w%3D%3D%23"
-            <> urlEncode True sampleDhKey
-            <> "&v=2"
-            <> "&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
-            <> " subscribe "
-            <> "14\nbob's connInfo"
-        )
-          >#> ("311", "a", "ERR SMP smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001 AUTH")
-    describe "invalid" $ do
-      it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX parseCommand")
-  where
-    -- simple test for one command with the expected response
-    (>#>) :: ARawTransmission -> ARawTransmission -> Expectation
-    command >#> response = withFrozenCallStack $ smpAgentTest t command `shouldReturn` response
-
-    -- simple test for one command with a predicate for the expected response
-    (>#>=) :: ARawTransmission -> ((ByteString, ByteString, [ByteString]) -> Bool) -> Expectation
-    command >#>= p = withFrozenCallStack $ smpAgentTest t command >>= (`shouldSatisfy` p . \(cId, connId, cmd) -> (cId, connId, B.words cmd))
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 25bbdb260..8d1247384 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -86,7 +86,7 @@ import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), SQLiteS
 import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction')
 import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SMPProxyFallback (..), SMPProxyMode (..), TransportSessionMode (TSMEntity, TSMUser), defaultClientConfig)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
+import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Transport (NTFVersion, authBatchCmdsNTFVersion, pattern VersionNTF)
@@ -96,7 +96,7 @@ import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, basicAuthSMPVersion, batchCmdsSMPVersion, currentServerSMPRelayVersion, supportedSMPHandshakes)
-import Simplex.Messaging.Util (diffToMicroseconds)
+import Simplex.Messaging.Util (bshow, diffToMicroseconds)
 import Simplex.Messaging.Version (VersionRange (..))
 import qualified Simplex.Messaging.Version as V
 import Simplex.Messaging.Version.Internal (Version (..))
@@ -106,7 +106,7 @@ import UnliftIO
 import Util
 import XFTPClient (testXFTPServer)
 
-type AEntityTransmission e = (ACorrId, ConnId, ACommand 'Agent e)
+type AEntityTransmission e = (ACorrId, ConnId, AEvent e)
 
 -- deriving instance Eq (ValidFileDescription p)
 
@@ -142,49 +142,52 @@ nGet c = withFrozenCallStack $ get' @'AENone c
 
 get' :: forall e m. (MonadIO m, AEntityI e, HasCallStack) => AgentClient -> m (AEntityTransmission e)
 get' c = withFrozenCallStack $ do
-  (corrId, connId, APC e cmd) <- pGet c
+  (corrId, connId, AEvt e cmd) <- pGet c
   case testEquality e (sAEntity @e) of
     Just Refl -> pure (corrId, connId, cmd)
     _ -> error $ "unexpected command " <> show cmd
 
-pGet :: forall m. MonadIO m => AgentClient -> m (ATransmission 'Agent)
-pGet c = do
-  t@(_, _, APC _ cmd) <- atomically (readTBQueue $ subQ c)
+pGet :: forall m. MonadIO m => AgentClient -> m ATransmission
+pGet c = pGet' c True
+
+pGet' :: forall m. MonadIO m => AgentClient -> Bool -> m ATransmission
+pGet' c skipWarn = do
+  t@(_, _, AEvt _ cmd) <- atomically (readTBQueue $ subQ c)
   case cmd of
     CONNECT {} -> pGet c
     DISCONNECT {} -> pGet c
     ERR (BROKER _ NETWORK) -> pGet c
-    MWARN {} -> pGet c
+    MWARN {} | skipWarn -> pGet c
     _ -> pure t
 
-pattern CONF :: ConfirmationId -> [SMPServer] -> ConnInfo -> ACommand 'Agent e
+pattern CONF :: ConfirmationId -> [SMPServer] -> ConnInfo -> AEvent e
 pattern CONF conId srvs connInfo <- A.CONF conId PQSupportOn srvs connInfo
 
-pattern INFO :: ConnInfo -> ACommand 'Agent 'AEConn
+pattern INFO :: ConnInfo -> AEvent 'AEConn
 pattern INFO connInfo = A.INFO PQSupportOn connInfo
 
-pattern REQ :: InvitationId -> NonEmpty SMPServer -> ConnInfo -> ACommand 'Agent e
+pattern REQ :: InvitationId -> NonEmpty SMPServer -> ConnInfo -> AEvent e
 pattern REQ invId srvs connInfo <- A.REQ invId PQSupportOn srvs connInfo
 
-pattern CON :: ACommand 'Agent 'AEConn
+pattern CON :: AEvent 'AEConn
 pattern CON = A.CON PQEncOn
 
-pattern Msg :: MsgBody -> ACommand 'Agent e
+pattern Msg :: MsgBody -> AEvent e
 pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk, pqEncryption = PQEncOn} _ msgBody
 
-pattern Msg' :: AgentMsgId -> PQEncryption -> MsgBody -> ACommand 'Agent e
+pattern Msg' :: AgentMsgId -> PQEncryption -> MsgBody -> AEvent e
 pattern Msg' aMsgId pq msgBody <- MSG MsgMeta {integrity = MsgOk, recipient = (aMsgId, _), pqEncryption = pq} _ msgBody
 
-pattern MsgErr :: AgentMsgId -> MsgErrorType -> MsgBody -> ACommand 'Agent 'AEConn
+pattern MsgErr :: AgentMsgId -> MsgErrorType -> MsgBody -> AEvent 'AEConn
 pattern MsgErr msgId err msgBody <- MSG MsgMeta {recipient = (msgId, _), integrity = MsgError err} _ msgBody
 
-pattern MsgErr' :: AgentMsgId -> MsgErrorType -> PQEncryption -> MsgBody -> ACommand 'Agent 'AEConn
+pattern MsgErr' :: AgentMsgId -> MsgErrorType -> PQEncryption -> MsgBody -> AEvent 'AEConn
 pattern MsgErr' msgId err pq msgBody <- MSG MsgMeta {recipient = (msgId, _), integrity = MsgError err, pqEncryption = pq} _ msgBody
 
-pattern SENT :: AgentMsgId -> ACommand 'Agent 'AEConn
+pattern SENT :: AgentMsgId -> AEvent 'AEConn
 pattern SENT msgId = A.SENT msgId Nothing
 
-pattern Rcvd :: AgentMsgId -> ACommand 'Agent 'AEConn
+pattern Rcvd :: AgentMsgId -> AEvent 'AEConn
 pattern Rcvd agentMsgId <- RCVD MsgMeta {integrity = MsgOk} [MsgReceipt {agentMsgId, msgRcptStatus = MROk}]
 
 smpCfgVPrev :: ProtocolClientConfig SMPVersion
@@ -242,7 +245,7 @@ runRight action =
     Right x -> pure x
     Left e -> error $ "Unexpected error: " <> show e
 
-getInAnyOrder :: HasCallStack => AgentClient -> [ATransmission 'Agent -> Bool] -> Expectation
+getInAnyOrder :: HasCallStack => AgentClient -> [ATransmission -> Bool] -> Expectation
 getInAnyOrder c ts = withFrozenCallStack $ inAnyOrder (pGet c) ts
 
 inAnyOrder :: (Show a, MonadUnliftIO m, HasCallStack) => m a -> [a -> Bool] -> m ()
@@ -279,12 +282,20 @@ functionalAPITests t = do
       withSmpServer t testAgentClient3
     it "should establish connection without PQ encryption and enable it" $
       withSmpServer t testEnablePQEncryption
+  describe "Establishing duplex connection, different PQ settings" $ do
+    testPQMatrix2 t $ runAgentClientTestPQ True
   describe "Establishing duplex connection v2, different Ratchet versions" $
     testRatchetMatrix2 t runAgentClientTest
   describe "Establish duplex connection via contact address" $
     testMatrix2 t runAgentClientContactTest
+  describe "Establish duplex connection via contact address, different PQ settings" $ do
+    testPQMatrix2NoInv t $ runAgentClientContactTestPQ True PQSupportOn
   describe "Establish duplex connection via contact address v2, different Ratchet versions" $
     testRatchetMatrix2 t runAgentClientContactTest
+  describe "Establish duplex connection via contact address, different PQ settings" $ do
+    testPQMatrix3 t $ runAgentClientContactTestPQ3 True
+  it "should support rejecting contact request" $
+    withSmpServer t testRejectContactRequest
   describe "Establishing connection asynchronously" $ do
     it "should connect with initiating client going offline" $
       withSmpServer t testAsyncInitiatingOffline
@@ -311,6 +322,10 @@ functionalAPITests t = do
       testDuplicateMessage t
     it "should report error via msg integrity on skipped messages" $
       testSkippedMessages t
+    it "should connect to the server when server goes up if it initially was down" $
+      testDeliveryAfterSubscriptionError t
+    it "should deliver messages if one of connections has quota exceeded" $
+      testMsgDeliveryQuotaExceeded t
     describe "message expiration" $ do
       it "should expire one message" $ testExpireMessage t
       it "should expire multiple messages" $ testExpireManyMessages t
@@ -472,7 +487,7 @@ canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =
   let v = basicAuthSMPVersion
    in allowNew && (isNothing srvAuth || (srvVersion >= v && clntVersion >= v && srvAuth == clntAuth))
 
-testMatrix2 :: ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2 t runTest = do
   it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfg agentProxyCfg (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
   it "v7" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfgV7 3 $ runTest PQSupportOn False
@@ -484,7 +499,7 @@ testMatrix2 t runTest = do
   it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff False
   it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff False
 
-testRatchetMatrix2 :: ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testRatchetMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testRatchetMatrix2 t runTest = do
   it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfg agentProxyCfg (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
   it "ratchet next" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfgV7 3 $ runTest PQSupportOn False
@@ -495,11 +510,50 @@ testRatchetMatrix2 t runTest = do
   it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 3 $ runTest PQSupportOff False
   it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 3 $ runTest PQSupportOff False
 
-testServerMatrix2 :: ATransport -> (InitialAgentServers -> IO ()) -> Spec
+testServerMatrix2 :: HasCallStack => ATransport -> (InitialAgentServers -> IO ()) -> Spec
 testServerMatrix2 t runTest = do
   it "1 server" $ withSmpServer t $ runTest initAgentServers
   it "2 servers" $ withSmpServer t . withSmpServerOn t testPort2 $ runTest initAgentServers2
 
+testPQMatrix2 :: HasCallStack => ATransport -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
+testPQMatrix2 = pqMatrix2_ True
+
+testPQMatrix2NoInv :: HasCallStack => ATransport -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
+testPQMatrix2NoInv = pqMatrix2_ False
+
+pqMatrix2_ :: HasCallStack => Bool -> ATransport -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
+pqMatrix2_ pqInv t test = do
+  it "dh/dh handshake" $ runTest $ \a b -> test (a, IKPQOff) (b, PQSupportOff)
+  it "dh/pq handshake" $ runTest $ \a b -> test (a, IKPQOff) (b, PQSupportOn)
+  it "pq/dh handshake" $ runTest $ \a b -> test (a, IKPQOn) (b, PQSupportOff)
+  it "pq/pq handshake" $ runTest $ \a b -> test (a, IKPQOn) (b, PQSupportOn)
+  when pqInv $ do
+    it "pq-inv/dh handshake" $ runTest $ \a b -> test (a, IKUsePQ) (b, PQSupportOff)
+    it "pq-inv/pq handshake" $ runTest $ \a b -> test (a, IKUsePQ) (b, PQSupportOn)
+  where
+    runTest = withSmpServerProxy t . runTestCfgServers2 agentProxyCfg agentProxyCfg (initAgentServersProxy SPMAlways SPFProhibit) 3
+
+testPQMatrix3 ::
+  HasCallStack =>
+  ATransport ->
+  (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) ->
+  Spec
+testPQMatrix3 t test = do
+  it "dh" $ runTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOff) (c, PQSupportOff)
+  it "dh/dh/pq" $ runTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOff) (c, PQSupportOn)
+  it "dh/pq/dh" $ runTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOn) (c, PQSupportOff)
+  it "dh/pq/pq" $ runTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOn) (c, PQSupportOn)
+  it "pq/dh/dh" $ runTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOff) (c, PQSupportOff)
+  it "pq/dh/pq" $ runTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOff) (c, PQSupportOn)
+  it "pq/pq/dh" $ runTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOn) (c, PQSupportOff)
+  it "pq" $ runTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOn) (c, PQSupportOn)
+  where
+    runTest test' =
+      withSmpServerProxy t $
+        runTestCfgServers2 agentProxyCfg agentProxyCfg servers 3 $ \a b baseMsgId ->
+          withAgent 3 agentProxyCfg servers testDB3 $ \c -> test' a b c baseMsgId
+    servers = initAgentServersProxy SPMAlways SPFProhibit
+
 runTestCfg2 :: HasCallStack => AgentConfig -> AgentConfig -> AgentMsgId -> (HasCallStack => AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> IO ()
 runTestCfg2 aCfg bCfg = runTestCfgServers2 aCfg bCfg initAgentServers
 {-# INLINE runTestCfg2 #-}
@@ -509,17 +563,17 @@ runTestCfgServers2 aCfg bCfg servers baseMsgId runTest =
   withAgentClientsCfgServers2 aCfg bCfg servers $ \a b -> runTest a b baseMsgId
 {-# INLINE runTestCfgServers2 #-}
 
-withAgentClientsCfgServers2 :: HasCallStack => AgentConfig -> AgentConfig -> InitialAgentServers -> (HasCallStack => AgentClient -> AgentClient -> IO ()) -> IO ()
+withAgentClientsCfgServers2 :: HasCallStack => AgentConfig -> AgentConfig -> InitialAgentServers -> (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
 withAgentClientsCfgServers2 aCfg bCfg servers runTest =
   withAgent 1 aCfg servers testDB $ \a ->
     withAgent 2 bCfg servers testDB2 $ \b ->
       runTest a b
 
-withAgentClientsCfg2 :: HasCallStack => AgentConfig -> AgentConfig -> (HasCallStack => AgentClient -> AgentClient -> IO ()) -> IO ()
+withAgentClientsCfg2 :: HasCallStack => AgentConfig -> AgentConfig -> (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
 withAgentClientsCfg2 aCfg bCfg = withAgentClientsCfgServers2 aCfg bCfg initAgentServers
 {-# INLINE withAgentClientsCfg2 #-}
 
-withAgentClients2 :: HasCallStack => (HasCallStack => AgentClient -> AgentClient -> IO ()) -> IO ()
+withAgentClients2 :: HasCallStack => (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
 withAgentClients2 = withAgentClientsCfg2 agentCfg agentCfg
 {-# INLINE withAgentClients2 #-}
 
@@ -530,16 +584,20 @@ withAgentClients3 runTest =
       runTest a b c
 
 runAgentClientTest :: HasCallStack => PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
-runAgentClientTest pqSupport viaProxy alice@AgentClient {} bob baseId =
+runAgentClientTest pqSupport viaProxy alice bob baseId =
+  runAgentClientTestPQ viaProxy (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId
+
+runAgentClientTestPQ :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
+runAgentClientTestPQ viaProxy (alice, aPQ) (bob, bPQ) baseId =
   runRight_ $ do
-    (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (IKNoPQ pqSupport) SMSubscribe
-    aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" pqSupport SMSubscribe
+    (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing aPQ SMSubscribe
+    aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" bPQ SMSubscribe
     ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
-    liftIO $ pqSup' `shouldBe` pqSupport
+    liftIO $ pqSup' `shouldBe` CR.connPQEncryption aPQ
     allowConnection alice bobId confId "alice's connInfo"
-    let pqEnc = CR.pqSupportToEnc pqSupport
+    let pqEnc = PQEncryption $ pqConnectionMode aPQ bPQ
     get alice ##> ("", bobId, A.CON pqEnc)
-    get bob ##> ("", aliceId, A.INFO pqSupport "alice's connInfo")
+    get bob ##> ("", aliceId, A.INFO bPQ "alice's connInfo")
     get bob ##> ("", aliceId, A.CON pqEnc)
     -- message IDs 1 to 3 (or 1 to 4 in v1) get assigned to control messages, so first MSG is assigned ID 4
     let proxySrv = if viaProxy then Just testSMPServer else Nothing
@@ -567,6 +625,9 @@ runAgentClientTest pqSupport viaProxy alice@AgentClient {} bob baseId =
   where
     msgId = subtract baseId . fst
 
+pqConnectionMode :: InitialKeys -> PQSupport -> Bool
+pqConnectionMode pqMode1 pqMode2 = supportPQ (CR.connPQEncryption pqMode1) && supportPQ pqMode2
+
 testEnablePQEncryption :: HasCallStack => IO ()
 testEnablePQEncryption =
   withAgentClients2 $ \ca cb -> runRight_ $ do
@@ -659,19 +720,23 @@ testAgentClient3 =
 
 runAgentClientContactTest :: HasCallStack => PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 runAgentClientContactTest pqSupport viaProxy alice bob baseId =
+  runAgentClientContactTestPQ viaProxy pqSupport (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId
+
+runAgentClientContactTestPQ :: HasCallStack => Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
+runAgentClientContactTestPQ viaProxy reqPQSupport (alice, aPQ) (bob, bPQ) baseId =
   runRight_ $ do
-    (_, qInfo) <- A.createConnection alice 1 True SCMContact Nothing (IKNoPQ pqSupport) SMSubscribe
-    aliceId <- A.prepareConnectionToJoin bob 1 True qInfo pqSupport
-    aliceId' <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" pqSupport SMSubscribe
+    (_, qInfo) <- A.createConnection alice 1 True SCMContact Nothing aPQ SMSubscribe
+    aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
+    aliceId' <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" bPQ SMSubscribe
     liftIO $ aliceId' `shouldBe` aliceId
     ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
-    liftIO $ pqSup' `shouldBe` pqSupport
-    bobId <- acceptContact alice True invId "alice's connInfo" PQSupportOn SMSubscribe
+    liftIO $ pqSup' `shouldBe` reqPQSupport
+    bobId <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
     ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get bob
-    liftIO $ pqSup'' `shouldBe` pqSupport
+    liftIO $ pqSup'' `shouldBe` bPQ
     allowConnection bob aliceId confId "bob's connInfo"
-    let pqEnc = CR.pqSupportToEnc pqSupport
-    get alice ##> ("", bobId, A.INFO pqSupport "bob's connInfo")
+    let pqEnc = PQEncryption $ pqConnectionMode aPQ bPQ
+    get alice ##> ("", bobId, A.INFO (CR.connPQEncryption aPQ) "bob's connInfo")
     get alice ##> ("", bobId, A.CON pqEnc)
     get bob ##> ("", aliceId, A.CON pqEnc)
     -- message IDs 1 to 3 (or 1 to 4 in v1) get assigned to control messages, so first MSG is assigned ID 4
@@ -700,6 +765,41 @@ runAgentClientContactTest pqSupport viaProxy alice bob baseId =
   where
     msgId = subtract baseId . fst
 
+runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
+runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do
+  (_, qInfo) <- A.createConnection alice 1 True SCMContact Nothing aPQ SMSubscribe
+  (bAliceId, bobId, abPQEnc) <- connectViaContact bob bPQ qInfo
+  sentMessages abPQEnc alice bobId bob bAliceId
+  (tAliceId, tomId, atPQEnc) <- connectViaContact tom tPQ qInfo
+  sentMessages atPQEnc alice tomId tom tAliceId
+  where
+    msgId = subtract baseId . fst
+    connectViaContact b pq qInfo = do
+      aId <- A.prepareConnectionToJoin b 1 True qInfo pq
+      aId' <- A.joinConnection b 1 (Just aId) True qInfo "bob's connInfo" pq SMSubscribe
+      liftIO $ aId' `shouldBe` aId
+      ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
+      liftIO $ pqSup' `shouldBe` PQSupportOn
+      bId <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
+      ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get b
+      liftIO $ pqSup'' `shouldBe` pq
+      allowConnection b aId confId "bob's connInfo"
+      let pqEnc = PQEncryption $ pqConnectionMode aPQ pq
+      get alice ##> ("", bId, A.INFO (CR.connPQEncryption aPQ) "bob's connInfo")
+      get alice ##> ("", bId, A.CON pqEnc)
+      get b ##> ("", aId, A.CON pqEnc)
+      pure (aId, bId, pqEnc)
+    sentMessages pqEnc a bId b aId = do
+      let proxySrv = if viaProxy then Just testSMPServer else Nothing
+      1 <- msgId <$> A.sendMessage a bId pqEnc SMP.noMsgFlags "hello"
+      get a ##> ("", bId, A.SENT (baseId + 1) proxySrv)
+      get b =##> \case ("", c, Msg' _ pq "hello") -> c == aId && pq == pqEnc; _ -> False
+      ackMessage b aId (baseId + 1) Nothing
+      2 <- msgId <$> A.sendMessage b aId pqEnc SMP.noMsgFlags "hello too"
+      get b ##> ("", aId, A.SENT (baseId + 2) proxySrv)
+      get a =##> \case ("", c, Msg' _ pq "hello too") -> c == bId && pq == pqEnc; _ -> False
+      ackMessage a bId (baseId + 2) Nothing
+
 noMessages :: HasCallStack => AgentClient -> String -> Expectation
 noMessages c err = tryGet `shouldReturn` ()
   where
@@ -708,6 +808,18 @@ noMessages c err = tryGet `shouldReturn` ()
         Just msg -> error $ err <> ": " <> show msg
         _ -> return ()
 
+testRejectContactRequest :: HasCallStack => IO ()
+testRejectContactRequest =
+  withAgentClients2 $ \alice bob -> runRight_ $ do
+    (addrConnId, qInfo) <- A.createConnection alice 1 True SCMContact Nothing IKPQOn SMSubscribe
+    aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
+    aliceId' <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+    liftIO $ aliceId' `shouldBe` aliceId
+    ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get alice
+    liftIO $ runExceptT (rejectContact alice "abcd" invId) `shouldReturn` Left (CONN NOT_FOUND)
+    rejectContact alice addrConnId invId
+    liftIO $ noMessages bob "nothing delivered to bob"
+
 testAsyncInitiatingOffline :: HasCallStack => IO ()
 testAsyncInitiatingOffline =
   withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> runRight_ $ do
@@ -1072,6 +1184,53 @@ testSkippedMessages t = do
   disposeAgentClient alice2
   disposeAgentClient bob2
 
+testDeliveryAfterSubscriptionError :: HasCallStack => ATransport -> IO ()
+testDeliveryAfterSubscriptionError t = do
+  (aId, bId) <- withAgentClients2 $ \a b -> do
+    (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ makeConnection a b
+    nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
+    nGet b =##> \case ("", "", DOWN _ [c]) -> c == aId; _ -> False
+    4 <- runRight $ sendMessage a bId SMP.noMsgFlags "hello"
+    liftIO $ noMessages b "not delivered"
+    pure (aId, bId)
+
+  withAgentClients2 $ \a b -> do
+    Left (BROKER _ NETWORK) <- runExceptT $ subscribeConnection a bId
+    Left (BROKER _ NETWORK) <- runExceptT $ subscribeConnection b aId
+    pure ()
+    withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
+      withUP a bId $ \case ("", c, SENT 4) -> c == bId; _ -> False
+      withUP b aId $ \case ("", c, Msg "hello") -> c == aId; _ -> False
+      ackMessage b aId 4 Nothing
+
+testMsgDeliveryQuotaExceeded :: HasCallStack => ATransport -> IO ()
+testMsgDeliveryQuotaExceeded t =
+  withAgentClients2 $ \a b -> withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
+    (aId, bId) <- makeConnection a b
+    (aId', bId') <- makeConnection a b
+    forM_ ([1 .. 4] :: [Int]) $ \i -> do
+      mId <- sendMessage a bId SMP.noMsgFlags $ "message " <> bshow i
+      get a =##> \case ("", c, SENT mId') -> bId == c && mId == mId'; _ -> False
+    8 <- sendMessage a bId SMP.noMsgFlags "over quota"
+    pGet' a False =##> \case ("", c, AEvt _ (MWARN 8 (SMP _ QUOTA))) -> bId == c; _ -> False
+    4 <- sendMessage a bId' SMP.noMsgFlags "hello"
+    get a =##> \case ("", c, SENT 4) -> bId' == c; _ -> False
+    get b =##> \case ("", c, Msg "message 1") -> aId == c; _ -> False
+    get b =##> \case ("", c, Msg "hello") -> aId' == c; _ -> False
+    ackMessage b aId' 4 Nothing
+    ackMessage b aId 4 Nothing
+    get b =##> \case ("", c, Msg "message 2") -> aId == c; _ -> False
+    ackMessage b aId 5 Nothing
+    get b =##> \case ("", c, Msg "message 3") -> aId == c; _ -> False
+    ackMessage b aId 6 Nothing
+    get b =##> \case ("", c, Msg "message 4") -> aId == c; _ -> False
+    ackMessage b aId 7 Nothing
+    get a =##> \case ("", c, QCONT) -> bId == c; _ -> False
+    get b =##> \case ("", c, Msg "over quota") -> aId == c; _ -> False
+    ackMessage b aId 9 Nothing -- msg 8 was QCONT
+    get a =##> \case ("", c, SENT 8) -> bId == c; _ -> False
+    liftIO $ concurrently_ (noMessages a "no more events") (noMessages b "no more events")
+
 testExpireMessage :: HasCallStack => ATransport -> IO ()
 testExpireMessage t =
   withAgent 1 agentCfg {messageTimeout = 1, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB $ \a ->
@@ -1124,8 +1283,8 @@ withUP a bId p =
   liftIO $
     getInAnyOrder
       a
-      [ \case ("", "", APC SAENone (UP _ [c])) -> c == bId; _ -> False,
-        \case (corrId, c, APC SAEConn cmd) -> c == bId && p (corrId, c, cmd); _ -> False
+      [ \case ("", "", AEvt SAENone (UP _ [c])) -> c == bId; _ -> False,
+        \case (corrId, c, AEvt SAEConn cmd) -> c == bId && p (corrId, c, cmd); _ -> False
       ]
 
 testExpireMessageQuota :: HasCallStack => ATransport -> IO ()
@@ -1147,8 +1306,8 @@ testExpireMessageQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1} testP
     get b' =##> \case ("", c, Msg "1") -> c == aId; _ -> False
     ackMessage b' aId 4 Nothing
     liftIO . getInAnyOrder a $
-      [ \case ("", c, APC SAEConn (SENT 6)) -> c == bId; _ -> False,
-        \case ("", c, APC SAEConn QCONT) -> c == bId; _ -> False
+      [ \case ("", c, AEvt SAEConn (SENT 6)) -> c == bId; _ -> False,
+        \case ("", c, AEvt SAEConn QCONT) -> c == bId; _ -> False
       ]
     get b' =##> \case ("", c, MsgErr 6 (MsgSkipped 4 4) "3") -> c == aId; _ -> False
     ackMessage b' aId 6 Nothing
@@ -1184,8 +1343,8 @@ testExpireManyMessagesQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1}
     get b' =##> \case ("", c, Msg "1") -> c == aId; _ -> False
     ackMessage b' aId 4 Nothing
     liftIO . getInAnyOrder a $
-      [ \case ("", c, APC SAEConn (SENT 8)) -> c == bId; _ -> False,
-        \case ("", c, APC SAEConn QCONT) -> c == bId; _ -> False
+      [ \case ("", c, AEvt SAEConn (SENT 8)) -> c == bId; _ -> False,
+        \case ("", c, AEvt SAEConn QCONT) -> c == bId; _ -> False
       ]
     get b' =##> \case ("", c, MsgErr 6 (MsgSkipped 4 6) "5") -> c == aId; _ -> False
     ackMessage b' aId 6 Nothing
@@ -1258,9 +1417,9 @@ ratchetSyncP cId rss = \case
     cId' == cId && rss' == rss && ratchetSyncState == rss
   _ -> False
 
-ratchetSyncP' :: ConnId -> RatchetSyncState -> ATransmission 'Agent -> Bool
+ratchetSyncP' :: ConnId -> RatchetSyncState -> ATransmission -> Bool
 ratchetSyncP' cId rss = \case
-  (_, cId', APC SAEConn (RSYNC rss' _ ConnectionStats {ratchetSyncState})) ->
+  (_, cId', AEvt SAEConn (RSYNC rss' _ ConnectionStats {ratchetSyncState})) ->
     cId' == cId && rss' == rss && ratchetSyncState == rss
   _ -> False
 
@@ -1285,9 +1444,9 @@ testRatchetSyncServerOffline t = withAgentClients2 $ \alice bob -> do
       exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9
   disposeAgentClient bob2
 
-serverUpP :: ATransmission 'Agent -> Bool
+serverUpP :: ATransmission -> Bool
 serverUpP = \case
-  ("", "", APC SAENone (UP _ _)) -> True
+  ("", "", AEvt SAENone (UP _ _)) -> True
   _ -> False
 
 testRatchetSyncClientRestart :: HasCallStack => ATransport -> IO ()
@@ -1436,8 +1595,8 @@ testInactiveNoSubs t = do
   withSmpServerConfigOn t cfg' testPort $ \_ ->
     withAgent 1 agentCfg initAgentServers testDB $ \alice -> do
       runRight_ . void $ createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate -- do not subscribe to pass noSubscriptions check
-      Just (_, _, APC SAENone (CONNECT _ _)) <- timeout 2000000 $ atomically (readTBQueue $ subQ alice)
-      Just (_, _, APC SAENone (DISCONNECT _ _)) <- timeout 5000000 $ atomically (readTBQueue $ subQ alice)
+      Just (_, _, AEvt SAENone (CONNECT _ _)) <- timeout 2000000 $ atomically (readTBQueue $ subQ alice)
+      Just (_, _, AEvt SAENone (DISCONNECT _ _)) <- timeout 5000000 $ atomically (readTBQueue $ subQ alice)
       pure ()
 
 testInactiveWithSubs :: ATransport -> IO ()
@@ -1513,13 +1672,13 @@ testSuspendingAgentCompleteSending t = withAgentClients2 $ \a b -> do
     liftIO $ suspendAgent b 5000000
 
   withSmpServerStoreLogOn t testPort $ \_ -> runRight_ @AgentErrorType $ do
-    pGet b =##> \case ("", c, APC SAEConn (SENT 5)) -> c == aId; ("", "", APC _ UP {}) -> True; _ -> False
-    pGet b =##> \case ("", c, APC SAEConn (SENT 5)) -> c == aId; ("", "", APC _ UP {}) -> True; _ -> False
-    pGet b =##> \case ("", c, APC SAEConn (SENT 6)) -> c == aId; ("", "", APC _ UP {}) -> True; _ -> False
+    pGet b =##> \case ("", c, AEvt SAEConn (SENT 5)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
+    pGet b =##> \case ("", c, AEvt SAEConn (SENT 5)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
+    pGet b =##> \case ("", c, AEvt SAEConn (SENT 6)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
     ("", "", SUSPENDED) <- nGet b
 
-    pGet a =##> \case ("", c, APC _ (Msg "hello too")) -> c == bId; ("", "", APC _ UP {}) -> True; _ -> False
-    pGet a =##> \case ("", c, APC _ (Msg "hello too")) -> c == bId; ("", "", APC _ UP {}) -> True; _ -> False
+    pGet a =##> \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; ("", "", AEvt _ UP {}) -> True; _ -> False
+    pGet a =##> \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; ("", "", AEvt _ UP {}) -> True; _ -> False
     ackMessage a bId 5 Nothing
     get a =##> \case ("", c, Msg "how are you?") -> c == bId; _ -> False
     ackMessage a bId 6 Nothing
@@ -1810,8 +1969,8 @@ testWaitDelivery t =
         liftIO $
           getInAnyOrder
             bob
-            [ \case ("", "", APC SAENone (UP _ [cId])) -> cId == aliceId; _ -> False,
-              \case ("", cId, APC SAEConn (Msg "how are you?")) -> cId == aliceId; _ -> False
+            [ \case ("", "", AEvt SAENone (UP _ [cId])) -> cId == aliceId; _ -> False,
+              \case ("", cId, AEvt SAEConn (Msg "how are you?")) -> cId == aliceId; _ -> False
             ]
         ackMessage bob aliceId (baseId + 3) Nothing
         get bob =##> \case ("", c, Msg "message 1") -> c == aliceId; _ -> False
@@ -1947,8 +2106,8 @@ testWaitDeliveryTimeout2 t =
         liftIO $
           getInAnyOrder
             bob
-            [ \case ("", "", APC SAENone (UP _ [cId])) -> cId == aliceId; _ -> False,
-              \case ("", cId, APC SAEConn (Msg "how are you?")) -> cId == aliceId; _ -> False
+            [ \case ("", "", AEvt SAENone (UP _ [cId])) -> cId == aliceId; _ -> False,
+              \case ("", cId, AEvt SAEConn (Msg "how are you?")) -> cId == aliceId; _ -> False
             ]
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
@@ -1974,10 +2133,10 @@ testJoinConnectionAsyncReplyError t = do
         get b =##> \case ("2", c, OK) -> c == aId; _ -> False
         confId <- withSmpServerStoreLogOn t testPort $ \_ -> do
           pGet a >>= \case
-            ("", "", APC _ (UP _ [_])) -> do
+            ("", "", AEvt _ (UP _ [_])) -> do
               ("", _, CONF confId _ "bob's connInfo") <- get a
               pure confId
-            ("", _, APC _ (CONF confId _ "bob's connInfo")) -> do
+            ("", _, AEvt _ (CONF confId _ "bob's connInfo")) -> do
               ("", "", UP _ [_]) <- nGet a
               pure confId
             r -> error $ "unexpected response " <> show r
@@ -1988,8 +2147,8 @@ testJoinConnectionAsyncReplyError t = do
           ConnectionStats {rcvQueuesInfo = [RcvQueueInfo {}], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
           pure ()
         withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
-          pGet a =##> \case ("3", c, APC _ OK) -> c == bId; ("", "", APC _ (UP _ [c])) -> c == bId; _ -> False
-          pGet a =##> \case ("3", c, APC _ OK) -> c == bId; ("", "", APC _ (UP _ [c])) -> c == bId; _ -> False
+          pGet a =##> \case ("3", c, AEvt _ OK) -> c == bId; ("", "", AEvt _ (UP _ [c])) -> c == bId; _ -> False
+          pGet a =##> \case ("3", c, AEvt _ OK) -> c == bId; ("", "", AEvt _ (UP _ [c])) -> c == bId; _ -> False
           get a ##> ("", bId, CON)
           get b ##> ("", aId, INFO "alice's connInfo")
           get b ##> ("", aId, CON)
@@ -2261,20 +2420,20 @@ testAbortSwitchStartedReinitiate servers = do
     withB :: (AgentClient -> IO a) -> IO a
     withB = withAgent 2 agentCfg servers testDB2
 
-switchPhaseRcvP :: ConnId -> SwitchPhase -> [Maybe RcvSwitchStatus] -> ATransmission 'Agent -> Bool
+switchPhaseRcvP :: ConnId -> SwitchPhase -> [Maybe RcvSwitchStatus] -> ATransmission -> Bool
 switchPhaseRcvP cId sphase swchStatuses = switchPhaseP cId QDRcv sphase (\stats -> rcvSwchStatuses' stats == swchStatuses)
 
-switchPhaseSndP :: ConnId -> SwitchPhase -> [Maybe SndSwitchStatus] -> ATransmission 'Agent -> Bool
+switchPhaseSndP :: ConnId -> SwitchPhase -> [Maybe SndSwitchStatus] -> ATransmission -> Bool
 switchPhaseSndP cId sphase swchStatuses = switchPhaseP cId QDSnd sphase (\stats -> sndSwchStatuses' stats == swchStatuses)
 
-switchPhaseP :: ConnId -> QueueDirection -> SwitchPhase -> (ConnectionStats -> Bool) -> ATransmission 'Agent -> Bool
+switchPhaseP :: ConnId -> QueueDirection -> SwitchPhase -> (ConnectionStats -> Bool) -> ATransmission -> Bool
 switchPhaseP cId qd sphase statsP = \case
-  (_, cId', APC SAEConn (SWITCH qd' sphase' stats)) -> cId' == cId && qd' == qd && sphase' == sphase && statsP stats
+  (_, cId', AEvt SAEConn (SWITCH qd' sphase' stats)) -> cId' == cId && qd' == qd && sphase' == sphase && statsP stats
   _ -> False
 
-errQueueNotFoundP :: ConnId -> ATransmission 'Agent -> Bool
+errQueueNotFoundP :: ConnId -> ATransmission -> Bool
 errQueueNotFoundP cId = \case
-  (_, cId', APC SAEConn (ERR AGENT {agentErr = A_QUEUE {queueErr = "QKEY: queue address not found in connection"}})) -> cId' == cId
+  (_, cId', AEvt SAEConn (ERR AGENT {agentErr = A_QUEUE {queueErr = "QKEY: queue address not found in connection"}})) -> cId' == cId
   _ -> False
 
 testCannotAbortSwitchSecured :: HasCallStack => InitialAgentServers -> IO ()
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index a7c3fb25a..01eab9555 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -56,7 +56,7 @@ import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMes
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore')
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, Env (..), InitialAgentServers)
 import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, SENT)
-import Simplex.Messaging.Agent.Store.SQLite (getSavedNtfToken)
+import Simplex.Messaging.Agent.Store.SQLite (closeSQLiteStore, getSavedNtfToken, reopenSQLiteStore)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
@@ -161,11 +161,12 @@ testNtfMatrix t runTest = do
     it "servers: next SMP v7, curr NTF v2; clients: curr/new" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfg agentCfgV7 runTest
 
 runNtfTestCfg :: ATransport -> ServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentClient -> AgentClient -> IO ()) -> IO ()
-runNtfTestCfg t smpCfg ntfCfg aCfg bCfg runTest =
+runNtfTestCfg t smpCfg ntfCfg aCfg bCfg runTest = do
   withSmpServerConfigOn t smpCfg testPort $ \_ ->
     withAPNSMockServer $ \apns ->
       withNtfServerCfg ntfCfg {transports = [(ntfTestPort, t)]} $ \_ ->
         withAgentClientsCfg2 aCfg bCfg $ runTest apns
+  threadDelay 100000
 
 testNotificationToken :: APNSMockServer -> IO ()
 testNotificationToken APNSMockServer {apnsQ} = do
@@ -345,7 +346,7 @@ testRunNTFServerTests t srv =
       testProtocolServer a 1 $ ProtoServerWithAuth srv Nothing
 
 testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentClient -> AgentClient -> IO ()
-testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} alice@AgentClient {agentEnv = Env {config = aliceCfg}} bob = do
+testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
   (bobId, aliceId, nonce, message) <- runRight $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -376,11 +377,21 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} alice@Agen
   -- alice client already has subscription for the connection
   Left (CMD PROHIBITED _) <- runExceptT $ getNotificationMessage alice nonce message
 
+  threadDelay 200000
+  suspendAgent alice 0
+  closeSQLiteStore store
+  threadDelay 200000
+
   -- aliceNtf client doesn't have subscription and is allowed to get notification message
   withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do
     (_, [SMPMsgMeta {msgFlags = MsgFlags True}]) <- getNotificationMessage aliceNtf nonce message
     pure ()
 
+  threadDelay 200000
+  reopenSQLiteStore store
+  foregroundAgent alice
+  threadDelay 200000
+
   runRight_ $ do
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 1) Nothing
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index 63466b9d7..039e26090 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -663,7 +663,7 @@ testGetPendingServerCommand st = do
     Right (Just PendingCommand {corrId = corrId'}) <- getPendingServerCommand db (Just smpServer1)
     corrId' `shouldBe` "4"
   where
-    command = AClientCommand $ APC SAEConn $ NEW True (ACM SCMInvitation) (IKNoPQ PQSupportOn) SMSubscribe
+    command = AClientCommand $ NEW True (ACM SCMInvitation) (IKNoPQ PQSupportOn) SMSubscribe
     corruptCmd :: DB.Connection -> ByteString -> ConnId -> IO ()
     corruptCmd db corrId connId = DB.execute db "UPDATE commands SET command = cast('bad' as blob) WHERE conn_id = ? AND corr_id = ?" (connId, corrId)
 
diff --git a/tests/CoreTests/ProtocolErrorTests.hs b/tests/CoreTests/ProtocolErrorTests.hs
deleted file mode 100644
index 4466c4933..000000000
--- a/tests/CoreTests/ProtocolErrorTests.hs
+++ /dev/null
@@ -1,111 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-
-module CoreTests.ProtocolErrorTests where
-
-import GHC.Generics (Generic)
-import Generic.Random (genericArbitraryU)
-import Simplex.FileTransfer.Transport (XFTPErrorType (..))
-import Simplex.Messaging.Agent.Protocol
-import qualified Simplex.Messaging.Agent.Protocol as Agent
-import Simplex.Messaging.Client (ProxyClientError (..))
-import Simplex.Messaging.Encoding
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (CommandError (..), ErrorType (..))
-import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Transport (HandshakeError (..), TransportError (..))
-import Simplex.RemoteControl.Types (RCErrorType (..))
-import Test.Hspec
-import Test.Hspec.QuickCheck (modifyMaxSuccess)
-import Test.QuickCheck
-
-protocolErrorTests :: Spec
-protocolErrorTests = modifyMaxSuccess (const 1000) $ do
-  describe "errors parsing / serializing" $ do
-    it "should parse SMP protocol errors" . property . forAll possibleErrorType $ \err ->
-      smpDecode (smpEncode err) == Right err
-    it "should parse SMP agent errors" . property . forAll possibleAgentErrorType $ \err ->
-      strDecode (strEncode err) == Right err
-  where
-    possibleErrorType :: Gen ErrorType
-    possibleErrorType = arbitrary >>= \e -> if skipErrorType e then discard else pure e
-    possibleAgentErrorType :: Gen AgentErrorType
-    possibleAgentErrorType =
-      arbitrary >>= \case
-        BROKER srv _ | hasSpaces srv -> discard
-        SMP srv e | hasSpaces srv || skipErrorType e -> discard
-        NTF srv e | hasSpaces srv || skipErrorType e -> discard
-        XFTP srv _ | hasSpaces srv -> discard
-        Agent.PROXY pxy srv _ | hasSpaces pxy || hasSpaces srv -> discard
-        Agent.PROXY _ _ (ProxyProtocolError e) | skipErrorType e -> discard
-        Agent.PROXY _ _ (ProxyUnexpectedResponse e) | hasUnicode e -> discard
-        Agent.PROXY _ _ (ProxyResponseError e) | skipErrorType e -> discard
-        ok -> pure ok
-    hasSpaces :: String -> Bool
-    hasSpaces = any (== ' ')
-    hasUnicode :: String -> Bool
-    hasUnicode = any (>= '\255')
-    skipErrorType = \case
-      SMP.PROXY (SMP.PROTOCOL e) -> skipErrorType e
-      SMP.PROXY (SMP.BROKER (UNEXPECTED s)) -> hasUnicode s
-      SMP.PROXY (SMP.BROKER (RESPONSE s)) -> hasUnicode s
-      _ -> False
-
-deriving instance Generic AgentErrorType
-
-deriving instance Generic CommandErrorType
-
-deriving instance Generic ConnectionErrorType
-
-deriving instance Generic ProxyClientError
-
-deriving instance Generic BrokerErrorType
-
-deriving instance Generic SMPAgentError
-
-deriving instance Generic AgentCryptoError
-
-deriving instance Generic ErrorType
-
-deriving instance Generic CommandError
-
-deriving instance Generic SMP.ProxyError
-
-deriving instance Generic TransportError
-
-deriving instance Generic HandshakeError
-
-deriving instance Generic XFTPErrorType
-
-deriving instance Generic RCErrorType
-
-instance Arbitrary AgentErrorType where arbitrary = genericArbitraryU
-
-instance Arbitrary CommandErrorType where arbitrary = genericArbitraryU
-
-instance Arbitrary ConnectionErrorType where arbitrary = genericArbitraryU
-
-instance Arbitrary ProxyClientError where arbitrary = genericArbitraryU
-
-instance Arbitrary BrokerErrorType where arbitrary = genericArbitraryU
-
-instance Arbitrary SMPAgentError where arbitrary = genericArbitraryU
-
-instance Arbitrary AgentCryptoError where arbitrary = genericArbitraryU
-
-instance Arbitrary ErrorType where arbitrary = genericArbitraryU
-
-instance Arbitrary CommandError where arbitrary = genericArbitraryU
-
-instance Arbitrary SMP.ProxyError where arbitrary = genericArbitraryU
-
-instance Arbitrary TransportError where arbitrary = genericArbitraryU
-
-instance Arbitrary HandshakeError where arbitrary = genericArbitraryU
-
-instance Arbitrary XFTPErrorType where arbitrary = genericArbitraryU
-
-instance Arbitrary RCErrorType where arbitrary = genericArbitraryU
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index aee3c8cb0..c5de1533b 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -10,54 +10,20 @@
 
 module SMPAgentClient where
 
-import Control.Monad
-import Control.Monad.IO.Unlift
-import qualified Data.ByteString.Char8 as B
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import qualified Database.SQLite.Simple as SQL
-import Network.Socket (ServiceName)
 import NtfClient (ntfTestPort)
-import SMPClient
-  ( proxyVRange,
-    serverBracket,
-    testKeyHash,
-    testPort,
-    testPort2,
-    withSmpServer,
-    withSmpServerOn,
-    withSmpServerThreadOn,
-  )
+import SMPClient (proxyVRange, testPort)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
-import Simplex.Messaging.Agent.Server (runSMPAgentBlocking)
-import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), SQLiteStore (dbNew))
-import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction')
-import Simplex.Messaging.Client (ProtocolClientConfig (..), SMPProxyFallback, SMPProxyMode, chooseTransportHost, defaultNetworkConfig, defaultSMPClientConfig)
+import Simplex.Messaging.Client (ProtocolClientConfig (..), SMPProxyFallback, SMPProxyMode, defaultNetworkConfig, defaultSMPClientConfig)
 import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
-import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth)
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Transport.Client
-import Test.Hspec
-import UnliftIO.Concurrent
-import UnliftIO.Directory
 import XFTPClient (testXFTPServer)
 
-agentTestHost :: NonEmpty TransportHost
-agentTestHost = "localhost"
-
-agentTestPort :: ServiceName
-agentTestPort = "5010"
-
-agentTestPort2 :: ServiceName
-agentTestPort2 = "5011"
-
-agentTestPort3 :: ServiceName
-agentTestPort3 = "5012"
-
 testDB :: FilePath
 testDB = "tests/tmp/smp-agent.test.protocol.db"
 
@@ -67,114 +33,6 @@ testDB2 = "tests/tmp/smp-agent2.test.protocol.db"
 testDB3 :: FilePath
 testDB3 = "tests/tmp/smp-agent3.test.protocol.db"
 
-smpAgentTest :: forall c. Transport c => TProxy c -> ARawTransmission -> IO ARawTransmission
-smpAgentTest _ cmd = runSmpAgentTest $ \(h :: c) -> tPutRaw h cmd >> get h
-  where
-    get h = do
-      t@(_, _, cmdStr) <- tGetRaw h
-      case parseAll networkCommandP cmdStr of
-        Right (ACmd SAgent _ CONNECT {}) -> get h
-        Right (ACmd SAgent _ DISCONNECT {}) -> get h
-        _ -> pure t
-
-runSmpAgentTest :: forall c a. Transport c => (c -> IO a) -> IO a
-runSmpAgentTest test = withSmpServer t . withSmpAgent t $ testSMPAgentClient test
-  where
-    t = transport @c
-
-runSmpAgentServerTest :: forall c a. Transport c => ((ThreadId, ThreadId) -> c -> IO a) -> IO a
-runSmpAgentServerTest test =
-  withSmpServerThreadOn t testPort $
-    \server -> withSmpAgentThreadOn t (agentTestPort, testPort, testDB) $
-      \agent -> testSMPAgentClient $ test (server, agent)
-  where
-    t = transport @c
-
-smpAgentServerTest :: Transport c => ((ThreadId, ThreadId) -> c -> IO ()) -> Expectation
-smpAgentServerTest test' = runSmpAgentServerTest test' `shouldReturn` ()
-
-runSmpAgentTestN :: forall c a. Transport c => [(ServiceName, ServiceName, FilePath)] -> ([c] -> IO a) -> IO a
-runSmpAgentTestN agents test = withSmpServer t $ run agents []
-  where
-    run :: [(ServiceName, ServiceName, FilePath)] -> [c] -> IO a
-    run [] hs = test hs
-    run (a@(p, _, _) : as) hs = withSmpAgentOn t a $ testSMPAgentClientOn p $ \h -> run as (h : hs)
-    t = transport @c
-
-runSmpAgentTestN_1 :: forall c a. Transport c => Int -> ([c] -> IO a) -> IO a
-runSmpAgentTestN_1 nClients test = withSmpServer t . withSmpAgent t $ run nClients []
-  where
-    run :: Int -> [c] -> IO a
-    run 0 hs = test hs
-    run n hs = testSMPAgentClient $ \h -> run (n - 1) (h : hs)
-    t = transport @c
-
-smpAgentTestN :: Transport c => [(ServiceName, ServiceName, FilePath)] -> ([c] -> IO ()) -> Expectation
-smpAgentTestN agents test' = runSmpAgentTestN agents test' `shouldReturn` ()
-
-smpAgentTestN_1 :: Transport c => Int -> ([c] -> IO ()) -> Expectation
-smpAgentTestN_1 n test' = runSmpAgentTestN_1 n test' `shouldReturn` ()
-
-smpAgentTest2_2_2 :: forall c. Transport c => (c -> c -> IO ()) -> Expectation
-smpAgentTest2_2_2 test' =
-  withSmpServerOn (transport @c) testPort2 $
-    smpAgentTest2_2_2_needs_server test'
-
-smpAgentTest2_2_2_needs_server :: forall c. Transport c => (c -> c -> IO ()) -> Expectation
-smpAgentTest2_2_2_needs_server test' =
-  smpAgentTestN
-    [ (agentTestPort, testPort, testDB),
-      (agentTestPort2, testPort2, testDB2)
-    ]
-    _test
-  where
-    _test [h1, h2] = test' h1 h2
-    _test _ = error "expected 2 handles"
-
-smpAgentTest2_2_1 :: Transport c => (c -> c -> IO ()) -> Expectation
-smpAgentTest2_2_1 test' =
-  smpAgentTestN
-    [ (agentTestPort, testPort, testDB),
-      (agentTestPort2, testPort, testDB2)
-    ]
-    _test
-  where
-    _test [h1, h2] = test' h1 h2
-    _test _ = error "expected 2 handles"
-
-smpAgentTest2_1_1 :: Transport c => (c -> c -> IO ()) -> Expectation
-smpAgentTest2_1_1 test' = smpAgentTestN_1 2 _test
-  where
-    _test [h1, h2] = test' h1 h2
-    _test _ = error "expected 2 handles"
-
-smpAgentTest3 :: Transport c => (c -> c -> c -> IO ()) -> Expectation
-smpAgentTest3 test' =
-  smpAgentTestN
-    [ (agentTestPort, testPort, testDB),
-      (agentTestPort2, testPort, testDB2),
-      (agentTestPort3, testPort, testDB3)
-    ]
-    _test
-  where
-    _test [h1, h2, h3] = test' h1 h2 h3
-    _test _ = error "expected 3 handles"
-
-smpAgentTest3_1_1 :: Transport c => (c -> c -> c -> IO ()) -> Expectation
-smpAgentTest3_1_1 test' = smpAgentTestN_1 3 _test
-  where
-    _test [h1, h2, h3] = test' h1 h2 h3
-    _test _ = error "expected 3 handles"
-
-smpAgentTest1_1_1 :: forall c. Transport c => (c -> IO ()) -> Expectation
-smpAgentTest1_1_1 test' =
-  smpAgentTestN
-    [(agentTestPort2, testPort2, testDB2)]
-    _test
-  where
-    _test [h] = test' h
-    _test _ = error "expected 1 handle"
-
 testSMPServer :: SMPServer
 testSMPServer = "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"
 
@@ -206,7 +64,7 @@ initAgentServersProxy smpProxyMode smpProxyFallback =
 agentCfg :: AgentConfig
 agentCfg =
   defaultAgentConfig
-    { tcpPort = Just agentTestPort,
+    { tcpPort = Nothing,
       tbqSize = 4,
       -- database = testDB,
       smpCfg = defaultSMPClientConfig {qSize = 1, defaultTransport = (testPort, transport @TLS), networkConfig},
@@ -232,39 +90,5 @@ fastRetryInterval = defaultReconnectInterval {initialInterval = 50_000}
 fastMessageRetryInterval :: RetryInterval2
 fastMessageRetryInterval = RetryInterval2 {riFast = fastRetryInterval, riSlow = fastRetryInterval}
 
-withSmpAgentThreadOn_ :: ATransport -> (ServiceName, ServiceName, FilePath) -> Int -> IO () -> (ThreadId -> IO a) -> IO a
-withSmpAgentThreadOn_ t (port', smpPort', db') initClientId afterProcess =
-  let cfg' = agentCfg {tcpPort = Just port'}
-      initServers' = initAgentServers {smp = userServers [ProtoServerWithAuth (SMPServer "localhost" smpPort' testKeyHash) Nothing]}
-   in serverBracket
-        ( \started -> do
-            Right st <- liftIO $ createAgentStore db' "" False MCError
-            when (dbNew st) . liftIO $ withTransaction' st (`SQL.execute_` "INSERT INTO users (user_id) VALUES (1)")
-            runSMPAgentBlocking t cfg' initServers' st initClientId started
-        )
-        afterProcess
-
 userServers :: NonEmpty (ProtoServerWithAuth p) -> Map UserId (NonEmpty (ProtoServerWithAuth p))
 userServers srvs = M.fromList [(1, srvs)]
-
-withSmpAgentThreadOn :: ATransport -> (ServiceName, ServiceName, FilePath) -> (ThreadId -> IO a) -> IO a
-withSmpAgentThreadOn t a@(_, _, db') = withSmpAgentThreadOn_ t a 0 $ removeFile db'
-
-withSmpAgentOn :: ATransport -> (ServiceName, ServiceName, FilePath) -> IO a -> IO a
-withSmpAgentOn t (port', smpPort', db') = withSmpAgentThreadOn t (port', smpPort', db') . const
-
-withSmpAgent :: ATransport -> IO a -> IO a
-withSmpAgent t = withSmpAgentOn t (agentTestPort, testPort, testDB)
-
-testSMPAgentClientOn :: Transport c => ServiceName -> (c -> IO a) -> IO a
-testSMPAgentClientOn port' client = do
-  Right useHost <- pure $ chooseTransportHost defaultNetworkConfig agentTestHost
-  runTransportClient defaultTransportClientConfig Nothing useHost port' (Just testKeyHash) $ \h -> do
-    line <- getLn h
-    if line == "Welcome to SMP agent v" <> B.pack simplexMQVersion
-      then client h
-      else do
-        error $ "wrong welcome message: " <> B.unpack line
-
-testSMPAgentClient :: Transport c => (c -> IO a) -> IO a
-testSMPAgentClient = testSMPAgentClientOn agentTestPort
diff --git a/tests/Test.hs b/tests/Test.hs
index f9fb2a2c0..98d902163 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -11,7 +11,6 @@ import CoreTests.BatchingTests
 import CoreTests.CryptoFileTests
 import CoreTests.CryptoTests
 import CoreTests.EncodingTests
-import CoreTests.ProtocolErrorTests
 import CoreTests.RetryIntervalTests
 import CoreTests.TRcvQueuesTests
 import CoreTests.UtilTests
@@ -49,7 +48,6 @@ main = do
         describe "Core tests" $ do
           describe "Batching tests" batchingTests
           describe "Encoding tests" encodingTests
-          describe "Protocol error tests" protocolErrorTests
           describe "Version range" versionRangeTests
           describe "Encryption tests" cryptoTests
           describe "Encrypted files tests" cryptoFileTests
diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index e4cf3d704..4580652e2 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -28,7 +28,7 @@ import Simplex.FileTransfer.Transport (XFTPErrorType (AUTH))
 import Simplex.Messaging.Agent (AgentClient, testProtocolServer, xftpDeleteRcvFile, xftpDeleteSndFileInternal, xftpDeleteSndFileRemote, xftpReceiveFile, xftpSendDescription, xftpSendFile, xftpStartWorkers)
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, xftpCfg)
-import Simplex.Messaging.Agent.Protocol (ACommand (..), AgentErrorType (..), BrokerErrorType (..), RcvFileId, SndFileId, noAuthSrv)
+import Simplex.Messaging.Agent.Protocol (AEvent (..), AgentErrorType (..), BrokerErrorType (..), RcvFileId, SndFileId, noAuthSrv)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs)
 import qualified Simplex.Messaging.Crypto.File as CF

From 3c0cd7efcc3d3058d940c7a9667faef2dc6de6cc Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Wed, 5 Jun 2024 18:44:32 +0400
Subject: [PATCH 003/195] agent: separate type for agent file errors (#1185)

---
 src/Simplex/FileTransfer/Agent.hs         | 70 +++++++++++++----------
 src/Simplex/FileTransfer/Transport.hs     | 10 ----
 src/Simplex/FileTransfer/Types.hs         | 47 ++++++++++++++-
 src/Simplex/Messaging/Agent.hs            |  1 +
 src/Simplex/Messaging/Agent/Env/SQLite.hs |  2 -
 src/Simplex/Messaging/Agent/Protocol.hs   | 15 +++--
 src/Simplex/Messaging/Parsers.hs          |  5 +-
 tests/AgentTests/FunctionalAPITests.hs    |  2 +
 tests/SMPAgentClient.hs                   |  1 -
 tests/XFTPAgent.hs                        |  8 ++-
 10 files changed, 105 insertions(+), 56 deletions(-)

diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 8da29d28b..9c0b3fe00 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -57,6 +57,7 @@ import Simplex.FileTransfer.Protocol (FileParty (..), SFileParty (..))
 import Simplex.FileTransfer.Transport (XFTPRcvChunkSpec (..))
 import qualified Simplex.FileTransfer.Transport as XFTP
 import Simplex.FileTransfer.Types
+import qualified Simplex.FileTransfer.Types as FT
 import Simplex.FileTransfer.Util (removePath, uniqueCombine)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
@@ -71,6 +72,7 @@ import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String (strDecode, strEncode)
 import Simplex.Messaging.Protocol (EntityId, XFTPServer)
+import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (catchAll_, liftError, tshow, unlessM, whenM)
 import System.FilePath (takeFileName, (</>))
 import UnliftIO
@@ -175,7 +177,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
-    runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpNotifyErrsOnRetry = notifyOnRetry, xftpConsecutiveRetries} =
+    runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpConsecutiveRetries} =
       withWork c doWork (\db -> getNextRcvChunkToDownload db srv rcvFilesTTL) $ \case
         (RcvFileChunk {rcvFileId, rcvFileEntityId, fileTmpPath, replicas = []}, _) -> rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath) (INTERNAL "chunk has no replicas")
         (fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _}, approvedRelays) -> do
@@ -187,7 +189,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
           where
             retryLoop loop e replicaDelay = do
               flip catchAgentError (\_ -> pure ()) $ do
-                when notifyOnRetry $ notify c rcvFileEntityId $ RFERR e
+                when (serverHostError e) $ notify c rcvFileEntityId $ RFWARN e
                 liftIO $ closeXFTPServerClient c userId server digest
                 withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
               atomically $ assertAgentForeground c
@@ -195,7 +197,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
             retryDone = rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath)
     downloadFileChunk :: RcvFileChunk -> RcvFileChunkReplica -> Bool -> AM ()
     downloadFileChunk RcvFileChunk {userId, rcvFileId, rcvFileEntityId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath} replica approvedRelays = do
-      unlessM ((approvedRelays ||) <$> ipAddressProtected') $ throwE $ XFTP "" XFTP.NOT_APPROVED
+      unlessM ((approvedRelays ||) <$> ipAddressProtected') $ throwE $ FILE NOT_APPROVED
       fsFileTmpPath <- lift $ toFSFilePath fileTmpPath
       chunkPath <- uniqueCombine fsFileTmpPath $ show chunkNo
       let chunkSpec = XFTPRcvChunkSpec chunkPath (unFileSize chunkSize) (unFileDigest digest)
@@ -236,7 +238,7 @@ withRetryIntervalLimit maxN ri action =
 retryOnError :: Text -> AM a -> AM a -> AgentErrorType -> AM a
 retryOnError name loop done e = do
   logError $ name <> " error: " <> tshow e
-  if temporaryAgentError e
+  if temporaryOrHostError e
     then loop
     else done
 
@@ -272,7 +274,7 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
       encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
       when (FileDigest encDigest /= digest) $ throwE $ XFTP "" XFTP.DIGEST
       let destFile = CryptoFile fsSavePath cfArgs
-      void $ liftError (INTERNAL . show) $ decryptChunks encSize chunkPaths key nonce $ \_ -> pure destFile
+      void $ liftError (FILE . FILE_IO . show) $ decryptChunks encSize chunkPaths key nonce $ \_ -> pure destFile
       case redirect of
         Nothing -> do
           notify c rcvFileEntityId $ RFDONE fsSavePath
@@ -285,13 +287,13 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
           atomically $ waitUntilForeground c
           withStore' c (`updateRcvFileComplete` rcvFileId)
           -- proceed with redirect
-          yaml <- liftError (INTERNAL . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `agentFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
+          yaml <- liftError (FILE . FILE_IO . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `agentFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
           next@FileDescription {chunks = nextChunks} <- case strDecode (LB.toStrict yaml) of
             -- TODO switch to another error constructor
-            Left _ -> throwE . XFTP "" $ XFTP.REDIRECT "decode error"
+            Left _ -> throwE . FILE $ REDIRECT "decode error"
             Right (ValidFileDescription fd@FileDescription {size = dstSize, digest = dstDigest})
-              | dstSize /= redirectSize -> throwE . XFTP "" $ XFTP.REDIRECT "size mismatch"
-              | dstDigest /= redirectDigest -> throwE . XFTP "" $ XFTP.REDIRECT "digest mismatch"
+              | dstSize /= redirectSize -> throwE . FILE $ REDIRECT "size mismatch"
+              | dstDigest /= redirectDigest -> throwE . FILE $ REDIRECT "digest mismatch"
               | otherwise -> pure fd
           -- register and download chunks from the actual file
           withStore c $ \db -> updateRcvFileRedirect db redirectDbId next
@@ -349,7 +351,7 @@ xftpSendDescription' c userId (ValidFileDescription fdDirect@FileDescription {si
   let directYaml = prefixPath </> "direct.yaml"
   cfArgs <- atomically $ CF.randomArgs g
   let file = CryptoFile directYaml (Just cfArgs)
-  liftError (INTERNAL . show) $ CF.writeFile file (LB.fromStrict $ strEncode fdDirect)
+  liftError (FILE . FILE_IO . show) $ CF.writeFile file (LB.fromStrict $ strEncode fdDirect)
   key <- atomically $ C.randomSbKey g
   nonce <- atomically $ C.randomCbNonce g
   fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce $ Just RedirectFileInfo {size, digest}
@@ -377,11 +379,11 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
     runXFTPOperation cfg@AgentConfig {sndFilesTTL} =
       withWork c doWork (`getNextSndFileToPrepare` sndFilesTTL) $
         \f@SndFile {sndFileId, sndFileEntityId, prefixPath} ->
-          prepareFile cfg f `catchAgentError` (sndWorkerInternalError c sndFileId sndFileEntityId prefixPath . show)
+          prepareFile cfg f `catchAgentError` sndWorkerInternalError c sndFileId sndFileEntityId prefixPath
     prepareFile :: AgentConfig -> SndFile -> AM ()
     prepareFile _ SndFile {prefixPath = Nothing} =
       throwE $ INTERNAL "no prefix path"
-    prepareFile cfg sndFile@SndFile {sndFileId, userId, prefixPath = Just ppath, status} = do
+    prepareFile cfg sndFile@SndFile {sndFileId, sndFileEntityId, userId, prefixPath = Just ppath, status} = do
       SndFile {numRecipients, chunks} <-
         if status /= SFSEncrypted -- status is SFSNew or SFSEncrypting
           then do
@@ -406,17 +408,17 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
           let CryptoFile {filePath} = srcFile
               fileName = takeFileName filePath
           fileSize <- liftIO $ fromInteger <$> CF.getFileContentsSize srcFile
-          when (fileSize > maxFileSizeHard) $ throwE $ INTERNAL "max file size exceeded"
+          when (fileSize > maxFileSizeHard) $ throwE $ FILE FT.SIZE
           let fileHdr = smpEncode FileHeader {fileName, fileExtra = Nothing}
               fileSize' = fromIntegral (B.length fileHdr) + fileSize
               payloadSize = fileSize' + fileSizeLen + authTagSize
           chunkSizes <- case redirect of
             Nothing -> pure $ prepareChunkSizes payloadSize
             Just _ -> case singleChunkSize payloadSize of
-              Nothing -> throwE $ INTERNAL "max file size exceeded for redirect"
+              Nothing -> throwE $ FILE FT.SIZE
               Just chunkSize -> pure [chunkSize]
           let encSize = sum $ map fromIntegral chunkSizes
-          void $ liftError (INTERNAL . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize fsEncPath
+          void $ liftError (FILE . FILE_IO . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize fsEncPath
           digest <- liftIO $ LC.sha512Hash <$> LB.readFile fsEncPath
           let chunkSpecs = prepareChunkSpecs fsEncPath chunkSizes
           chunkDigests <- liftIO $ mapM getChunkDigest chunkSpecs
@@ -430,24 +432,32 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
           where
             tryCreate = do
               usedSrvs <- newTVarIO ([] :: [XFTPServer])
-              withRetryInterval (riFast ri) $ \_ loop -> do
+              let AgentClient {xftpServers} = c
+              userSrvCount <- length <$> atomically (TM.lookup userId xftpServers)
+              withRetryIntervalCount (riFast ri) $ \n _ loop -> do
                 liftIO $ waitForUserNetwork c
+                let triedAllSrvs = n > userSrvCount
                 createWithNextSrv usedSrvs
-                  `catchAgentError` \e -> retryOnError "XFTP prepare worker" (retryLoop loop) (throwE e) e
+                  `catchAgentError` \e -> retryOnError "XFTP prepare worker" (retryLoop loop triedAllSrvs e) (throwE e) e
               where
-                retryLoop loop = atomically (assertAgentForeground c) >> loop
+                -- we don't do closeXFTPServerClient here to not risk closing connection for concurrent chunk upload
+                retryLoop loop triedAllSrvs e = do
+                  flip catchAgentError (\_ -> pure ()) $ do
+                    when (triedAllSrvs && serverHostError e) $ notify c sndFileEntityId $ SFWARN e
+                  atomically $ assertAgentForeground c
+                  loop
             createWithNextSrv usedSrvs = do
               deleted <- withStore' c $ \db -> getSndFileDeleted db sndFileId
-              when deleted $ throwE $ INTERNAL "file deleted, aborting chunk creation"
+              when deleted $ throwE $ FILE NO_FILE
               withNextSrv c userId usedSrvs [] $ \srvAuth -> do
                 replica <- agentXFTPNewChunk c ch numRecipients' srvAuth
                 pure (replica, srvAuth)
 
-sndWorkerInternalError :: AgentClient -> DBSndFileId -> SndFileId -> Maybe FilePath -> String -> AM ()
-sndWorkerInternalError c sndFileId sndFileEntityId prefixPath internalErrStr = do
+sndWorkerInternalError :: AgentClient -> DBSndFileId -> SndFileId -> Maybe FilePath -> AgentErrorType -> AM ()
+sndWorkerInternalError c sndFileId sndFileEntityId prefixPath err = do
   lift . forM_ prefixPath $ removePath <=< toFSFilePath
-  withStore' c $ \db -> updateSndFileError db sndFileId internalErrStr
-  notify c sndFileEntityId $ SFERR $ INTERNAL internalErrStr
+  withStore' c $ \db -> updateSndFileError db sndFileId (show err)
+  notify c sndFileEntityId $ SFERR err
 
 runXFTPSndWorker :: AgentClient -> XFTPServer -> Worker -> AM ()
 runXFTPSndWorker c srv Worker {doWork} = do
@@ -458,9 +468,9 @@ runXFTPSndWorker c srv Worker {doWork} = do
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
-    runXFTPOperation cfg@AgentConfig {sndFilesTTL, reconnectInterval = ri, xftpNotifyErrsOnRetry = notifyOnRetry, xftpConsecutiveRetries} = do
+    runXFTPOperation cfg@AgentConfig {sndFilesTTL, reconnectInterval = ri, xftpConsecutiveRetries} = do
       withWork c doWork (\db -> getNextSndChunkToUpload db srv sndFilesTTL) $ \case
-        SndFileChunk {sndFileId, sndFileEntityId, filePrefixPath, replicas = []} -> sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) "chunk has no replicas"
+        SndFileChunk {sndFileId, sndFileEntityId, filePrefixPath, replicas = []} -> sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) (INTERNAL "chunk has no replicas")
         fc@SndFileChunk {userId, sndFileId, sndFileEntityId, filePrefixPath, digest, replicas = replica@SndFileChunkReplica {sndChunkReplicaId, server, delay} : _} -> do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
@@ -470,17 +480,17 @@ runXFTPSndWorker c srv Worker {doWork} = do
           where
             retryLoop loop e replicaDelay = do
               flip catchAgentError (\_ -> pure ()) $ do
-                when notifyOnRetry $ notify c sndFileEntityId $ SFERR e
+                when (serverHostError e) $ notify c sndFileEntityId $ SFWARN e
                 liftIO $ closeXFTPServerClient c userId server digest
                 withStore' c $ \db -> updateSndChunkReplicaDelay db sndChunkReplicaId replicaDelay
               atomically $ assertAgentForeground c
               loop
-            retryDone e = sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) (show e)
+            retryDone = sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath)
     uploadFileChunk :: AgentConfig -> SndFileChunk -> SndFileChunkReplica -> AM ()
     uploadFileChunk AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients} sndFileChunk@SndFileChunk {sndFileId, userId, chunkSpec = chunkSpec@XFTPChunkSpec {filePath}, digest = chunkDigest} replica = do
       replica'@SndFileChunkReplica {sndChunkReplicaId} <- addRecipients sndFileChunk replica
       fsFilePath <- lift $ toFSFilePath filePath
-      unlessM (doesFileExist fsFilePath) $ throwE $ INTERNAL "encrypted file doesn't exist on upload"
+      unlessM (doesFileExist fsFilePath) $ throwE $ FILE NO_FILE
       let chunkSpec' = chunkSpec {filePath = fsFilePath} :: XFTPChunkSpec
       atomically $ assertAgentForeground c
       agentXFTPUploadChunk c userId chunkDigest replica' chunkSpec'
@@ -624,7 +634,7 @@ runXFTPDelWorker c srv Worker {doWork} = do
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
-    runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpNotifyErrsOnRetry = notifyOnRetry, xftpConsecutiveRetries} = do
+    runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpConsecutiveRetries} = do
       -- no point in deleting files older than rcv ttl, as they will be expired on server
       withWork c doWork (\db -> getNextDeletedSndChunkReplica db srv rcvFilesTTL) processDeletedReplica
       where
@@ -637,7 +647,7 @@ runXFTPDelWorker c srv Worker {doWork} = do
           where
             retryLoop loop e replicaDelay = do
               flip catchAgentError (\_ -> pure ()) $ do
-                when notifyOnRetry $ notify c "" $ SFERR e
+                when (serverHostError e) $ notify c "" $ SFWARN e
                 liftIO $ closeXFTPServerClient c userId server chunkDigest
                 withStore' c $ \db -> updateDeletedSndChunkReplicaDelay db deletedSndChunkReplicaId replicaDelay
               atomically $ assertAgentForeground c
diff --git a/src/Simplex/FileTransfer/Transport.hs b/src/Simplex/FileTransfer/Transport.hs
index 678d39d52..d72f9862b 100644
--- a/src/Simplex/FileTransfer/Transport.hs
+++ b/src/Simplex/FileTransfer/Transport.hs
@@ -223,10 +223,6 @@ data XFTPErrorType
     FILE_IO
   | -- | file sending or receiving timeout
     TIMEOUT
-  | -- | bad redirect data
-    REDIRECT {redirectError :: String}
-  | -- | cannot proceed with download from not approved relays without proxy
-    NOT_APPROVED
   | -- | internal server error
     INTERNAL
   | -- | used internally, never returned by the server (to be removed)
@@ -236,11 +232,9 @@ data XFTPErrorType
 instance StrEncoding XFTPErrorType where
   strEncode = \case
     CMD e -> "CMD " <> bshow e
-    REDIRECT e -> "REDIRECT " <> bshow e
     e -> bshow e
   strP =
     "CMD " *> (CMD <$> parseRead1)
-      <|> "REDIRECT " *> (REDIRECT <$> parseRead A.takeByteString)
       <|> parseRead1
 
 instance Encoding XFTPErrorType where
@@ -258,8 +252,6 @@ instance Encoding XFTPErrorType where
     HAS_FILE -> "HAS_FILE"
     FILE_IO -> "FILE_IO"
     TIMEOUT -> "TIMEOUT"
-    REDIRECT err -> "REDIRECT " <> smpEncode err
-    NOT_APPROVED -> "NOT_APPROVED"
     INTERNAL -> "INTERNAL"
     DUPLICATE_ -> "DUPLICATE_"
 
@@ -278,8 +270,6 @@ instance Encoding XFTPErrorType where
       "HAS_FILE" -> pure HAS_FILE
       "FILE_IO" -> pure FILE_IO
       "TIMEOUT" -> pure TIMEOUT
-      "REDIRECT" -> REDIRECT <$> _smpP
-      "NOT_APPROVED" -> pure NOT_APPROVED
       "INTERNAL" -> pure INTERNAL
       "DUPLICATE_" -> pure DUPLICATE_
       _ -> fail "bad error type"
diff --git a/src/Simplex/FileTransfer/Types.hs b/src/Simplex/FileTransfer/Types.hs
index ba306a6c6..15dc672da 100644
--- a/src/Simplex/FileTransfer/Types.hs
+++ b/src/Simplex/FileTransfer/Types.hs
@@ -2,24 +2,33 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Simplex.FileTransfer.Types where
 
+import qualified Data.Aeson.TH as J
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
 import Data.Word (Word32)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
 import Simplex.FileTransfer.Description
-import Simplex.Messaging.Agent.Protocol (RcvFileId, SndFileId)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (fromTextField_)
-import Simplex.Messaging.Protocol
+import Simplex.Messaging.Parsers
+import Simplex.Messaging.Protocol (XFTPServer)
 import System.FilePath ((</>))
 
+type RcvFileId = ByteString
+
+type SndFileId = ByteString
+
 authTagSize :: Int64
 authTagSize = fromIntegral C.authTagSize
 
@@ -236,3 +245,35 @@ data DeletedSndChunkReplica = DeletedSndChunkReplica
     retries :: Int
   }
   deriving (Show)
+
+data FileErrorType
+  = -- | cannot proceed with download from not approved relays without proxy
+    NOT_APPROVED
+  | -- | max file size exceeded
+    SIZE
+  | -- | bad redirect data
+    REDIRECT {redirectError :: String}
+  | -- | file crypto error
+    FILE_IO {fileIOError :: String}
+  | -- | file not found or was deleted
+    NO_FILE
+  deriving (Eq, Show)
+
+instance StrEncoding FileErrorType where
+  strP =
+    A.takeTill (== ' ')
+      >>= \case
+        "NOT_APPROVED" -> pure NOT_APPROVED
+        "SIZE" -> pure SIZE
+        "REDIRECT" -> REDIRECT <$> (A.space *> textP)
+        "FILE_IO" -> FILE_IO <$> (A.space *> textP)
+        "NO_FILE" -> pure NO_FILE
+        _ -> fail "bad FileErrorType"
+  strEncode = \case
+    NOT_APPROVED -> "NOT_APPROVED"
+    SIZE -> "SIZE"
+    REDIRECT e -> "REDIRECT " <> encodeUtf8 (T.pack e)
+    FILE_IO e -> "FILE_IO " <> encodeUtf8 (T.pack e)
+    NO_FILE -> "NO_FILE"
+
+$(J.deriveJSON (sumTypeJSON id) ''FileErrorType)
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 7bc638496..c550ba04a 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -148,6 +148,7 @@ import Data.Word (Word16)
 import Simplex.FileTransfer.Agent (closeXFTPAgent, deleteSndFileInternal, deleteSndFileRemote, deleteSndFilesInternal, deleteSndFilesRemote, startXFTPWorkers, toFSFilePath, xftpDeleteRcvFile', xftpDeleteRcvFiles', xftpReceiveFile', xftpSendDescription', xftpSendFile')
 import Simplex.FileTransfer.Description (ValidFileDescription)
 import Simplex.FileTransfer.Protocol (FileParty (..))
+import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
 import Simplex.FileTransfer.Util (removePath)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 63aa652ac..ee2bb16cc 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -105,7 +105,6 @@ data AgentConfig = AgentConfig
     storedMsgDataTTL :: NominalDiffTime,
     rcvFilesTTL :: NominalDiffTime,
     sndFilesTTL :: NominalDiffTime,
-    xftpNotifyErrsOnRetry :: Bool,
     xftpConsecutiveRetries :: Int,
     xftpMaxRecipientsPerRequest :: Int,
     deleteErrorCount :: Int,
@@ -176,7 +175,6 @@ defaultAgentConfig =
       storedMsgDataTTL = 21 * nominalDay,
       rcvFilesTTL = 2 * nominalDay,
       sndFilesTTL = nominalDay,
-      xftpNotifyErrsOnRetry = True,
       xftpConsecutiveRetries = 3,
       xftpMaxRecipientsPerRequest = 200,
       deleteErrorCount = 10,
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 447658cfe..0067d4ada 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -115,8 +115,6 @@ module Simplex.Messaging.Agent.Protocol
     cryptoErrToSyncState,
     ATransmission,
     ConnId,
-    RcvFileId,
-    SndFileId,
     ConfirmationId,
     InvitationId,
     MsgIntegrity (..),
@@ -169,6 +167,7 @@ import Database.SQLite.Simple.ToField
 import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Protocol (FileParty (..))
 import Simplex.FileTransfer.Transport (XFTPErrorType)
+import Simplex.FileTransfer.Types (FileErrorType)
 import Simplex.Messaging.Agent.QueryString
 import Simplex.Messaging.Client (ProxyClientError)
 import qualified Simplex.Messaging.Crypto as C
@@ -352,9 +351,11 @@ data AEvent (e :: AEntity) where
   RFPROG :: Int64 -> Int64 -> AEvent AERcvFile
   RFDONE :: FilePath -> AEvent AERcvFile
   RFERR :: AgentErrorType -> AEvent AERcvFile
+  RFWARN :: AgentErrorType -> AEvent AERcvFile
   SFPROG :: Int64 -> Int64 -> AEvent AESndFile
   SFDONE :: ValidFileDescription 'FSender -> [ValidFileDescription 'FRecipient] -> AEvent AESndFile
   SFERR :: AgentErrorType -> AEvent AESndFile
+  SFWARN :: AgentErrorType -> AEvent AESndFile
 
 deriving instance Eq (AEvent e)
 
@@ -420,9 +421,11 @@ data AEventTag (e :: AEntity) where
   RFDONE_ :: AEventTag AERcvFile
   RFPROG_ :: AEventTag AERcvFile
   RFERR_ :: AEventTag AERcvFile
+  RFWARN_ :: AEventTag AERcvFile
   SFPROG_ :: AEventTag AESndFile
   SFDONE_ :: AEventTag AESndFile
   SFERR_ :: AEventTag AESndFile
+  SFWARN_ :: AEventTag AESndFile
 
 deriving instance Eq (AEventTag e)
 
@@ -470,9 +473,11 @@ aEventTag = \case
   RFPROG {} -> RFPROG_
   RFDONE {} -> RFDONE_
   RFERR {} -> RFERR_
+  RFWARN {} -> RFWARN_
   SFPROG {} -> SFPROG_
   SFDONE {} -> SFDONE_
   SFERR {} -> SFERR_
+  SFWARN {} -> SFWARN_
 
 data QueueDirection = QDRcv | QDSnd
   deriving (Eq, Show)
@@ -1077,10 +1082,6 @@ connModeT = \case
 -- | SMP agent connection ID.
 type ConnId = ByteString
 
-type RcvFileId = ByteString
-
-type SndFileId = ByteString
-
 type ConfirmationId = ByteString
 
 type InvitationId = ByteString
@@ -1316,6 +1317,8 @@ data AgentErrorType
     NTF {serverAddress :: String, ntfErr :: ErrorType}
   | -- | XFTP protocol errors forwarded to agent clients
     XFTP {serverAddress :: String, xftpErr :: XFTPErrorType}
+  | -- | XFTP agent errors
+    FILE {fileErr :: FileErrorType}
   | -- | SMP proxy errors
     PROXY {proxyServer :: String, relayServer :: String, proxyErr :: ProxyClientError}
   | -- | XRCP protocol errors forwarded to agent clients
diff --git a/src/Simplex/Messaging/Parsers.hs b/src/Simplex/Messaging/Parsers.hs
index 39cb0383c..6ad9f867d 100644
--- a/src/Simplex/Messaging/Parsers.hs
+++ b/src/Simplex/Messaging/Parsers.hs
@@ -24,7 +24,7 @@ import Database.SQLite.Simple (ResultError (..), SQLData (..))
 import Database.SQLite.Simple.FromField (FieldParser, returnError)
 import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok (Ok (Ok))
-import Simplex.Messaging.Util ((<$?>))
+import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
 import Text.Read (readMaybe)
 
 base64P :: Parser ByteString
@@ -154,3 +154,6 @@ singleFieldJSON_ objectTag tagModifier =
 
 defaultJSON :: J.Options
 defaultJSON = J.defaultOptions {J.omitNothingFields = True}
+
+textP :: Parser String
+textP = T.unpack . safeDecodeUtf8 <$> A.takeByteString
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 8d1247384..d52c12877 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -158,6 +158,8 @@ pGet' c skipWarn = do
     DISCONNECT {} -> pGet c
     ERR (BROKER _ NETWORK) -> pGet c
     MWARN {} | skipWarn -> pGet c
+    RFWARN {} | skipWarn -> pGet c
+    SFWARN {} | skipWarn -> pGet c
     _ -> pure t
 
 pattern CONF :: ConfirmationId -> [SMPServer] -> ConnInfo -> AEvent e
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index c5de1533b..3c9907c48 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -71,7 +71,6 @@ agentCfg =
       ntfCfg = defaultNTFClientConfig {qSize = 1, defaultTransport = (ntfTestPort, transport @TLS), networkConfig},
       reconnectInterval = fastRetryInterval,
       persistErrorInterval = 1,
-      xftpNotifyErrsOnRetry = False,
       ntfWorkerDelay = 100,
       ntfSMPWorkerDelay = 100,
       caCertificateFile = "tests/fixtures/ca.crt",
diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index 4580652e2..37ec00199 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -20,15 +20,17 @@ import Data.Int (Int64)
 import Data.List (find, isSuffixOf)
 import Data.Maybe (fromJust)
 import SMPAgentClient (agentCfg, initAgentServers, testDB, testDB2, testDB3)
+import SMPClient (xit'')
 import Simplex.FileTransfer.Client (XFTPClientConfig (..))
 import Simplex.FileTransfer.Description (FileChunk (..), FileDescription (..), FileDescriptionURI (..), ValidFileDescription, fileDescriptionURI, kb, mb, qrSizeLimit, pattern ValidFileDescription)
 import Simplex.FileTransfer.Protocol (FileParty (..))
 import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
 import Simplex.FileTransfer.Transport (XFTPErrorType (AUTH))
+import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
 import Simplex.Messaging.Agent (AgentClient, testProtocolServer, xftpDeleteRcvFile, xftpDeleteSndFileInternal, xftpDeleteSndFileRemote, xftpReceiveFile, xftpSendDescription, xftpSendFile, xftpStartWorkers)
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, xftpCfg)
-import Simplex.Messaging.Agent.Protocol (AEvent (..), AgentErrorType (..), BrokerErrorType (..), RcvFileId, SndFileId, noAuthSrv)
+import Simplex.Messaging.Agent.Protocol (AEvent (..), AgentErrorType (..), BrokerErrorType (..), noAuthSrv)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs)
 import qualified Simplex.Messaging.Crypto.File as CF
@@ -58,7 +60,7 @@ xftpAgentTests = around_ testBracket . describe "agent XFTP API" $ do
   it "should resume receiving file after restart" testXFTPAgentReceiveRestore
   it "should cleanup rcv tmp path after permanent error" testXFTPAgentReceiveCleanup
   it "should resume sending file after restart" testXFTPAgentSendRestore
-  xit "should cleanup snd prefix path after permanent error" testXFTPAgentSendCleanup
+  xit'' "should cleanup snd prefix path after permanent error" testXFTPAgentSendCleanup
   it "should delete sent file on server" testXFTPAgentDelete
   it "should resume deleting file after restart" testXFTPAgentDeleteRestore
   -- TODO when server is fixed to correctly send AUTH error, this test has to be modified to expect AUTH error
@@ -475,7 +477,7 @@ testXFTPAgentSendCleanup = withGlobalLogging logCfgNoLogs $ do
     -- send file - should fail with AUTH error
     withAgent 2 agentCfg initAgentServers testDB $ \sndr' -> do
       runRight_ $ xftpStartWorkers sndr' (Just senderFiles)
-      ("", sfId', SFERR (INTERNAL "XFTP {serverAddress = \"xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000\", xftpErr = AUTH}")) <-
+      ("", sfId', SFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <-
         sfGet sndr'
       sfId' `shouldBe` sfId
 

From da620c388a853cb8612cc695aed5cff6900a916b Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Thu, 6 Jun 2024 15:50:15 +0400
Subject: [PATCH 004/195] xftp: start chunk upload after all chunks are
 prepared (#1191)

---
 src/Simplex/FileTransfer/Agent.hs | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 9c0b3fe00..890966888 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -38,7 +38,7 @@ import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Coerce (coerce)
 import Data.Composition ((.:))
-import Data.Either (rights)
+import Data.Either (partitionEithers, rights)
 import Data.Int (Int64)
 import Data.List (foldl', partition, sortOn)
 import qualified Data.List.NonEmpty as L
@@ -71,7 +71,7 @@ import qualified Simplex.Messaging.Crypto.File as CF
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String (strDecode, strEncode)
-import Simplex.Messaging.Protocol (EntityId, XFTPServer)
+import Simplex.Messaging.Protocol (EntityId, ProtocolServer, ProtocolType (..), XFTPServer)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (catchAll_, liftError, tshow, unlessM, whenM)
 import System.FilePath (takeFileName, (</>))
@@ -397,9 +397,14 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
               getSndFile db sndFileId
           else pure sndFile
       let numRecipients' = min numRecipients maxRecipients
+      -- in case chunk preparation previously failed mid-way, some chunks may already be created -
+      -- here we split previously prepared chunks from the pending ones to then build full list of servers
+      let (pendingChunks, preparedSrvs) = partitionEithers $ map srvOrPendingChunk chunks
       -- concurrently?
       -- separate worker to create chunks? record retries and delay on snd_file_chunks?
-      forM_ (filter (\SndFileChunk {replicas} -> null replicas) chunks) $ createChunk numRecipients'
+      srvs <- forM pendingChunks $ createChunk numRecipients'
+      let allSrvs = S.fromList $ preparedSrvs <> srvs
+      lift $ forM_ allSrvs $ \srv -> getXFTPSndWorker True c (Just srv)
       withStore' c $ \db -> updateSndFileStatus db sndFileId SFSUploading
       where
         AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients, messageRetryInterval = ri} = cfg
@@ -423,12 +428,16 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
           let chunkSpecs = prepareChunkSpecs fsEncPath chunkSizes
           chunkDigests <- liftIO $ mapM getChunkDigest chunkSpecs
           pure (FileDigest digest, zip chunkSpecs $ coerce chunkDigests)
-        createChunk :: Int -> SndFileChunk -> AM ()
+        srvOrPendingChunk :: SndFileChunk -> Either SndFileChunk (ProtocolServer 'PXFTP)
+        srvOrPendingChunk ch@SndFileChunk {replicas} = case replicas of
+          [] -> Left ch
+          SndFileChunkReplica {server} : _ -> Right server
+        createChunk :: Int -> SndFileChunk -> AM (ProtocolServer 'PXFTP)
         createChunk numRecipients' ch = do
           atomically $ assertAgentForeground c
           (replica, ProtoServerWithAuth srv _) <- tryCreate
           withStore' c $ \db -> createSndFileReplica db ch replica
-          lift . void $ getXFTPSndWorker True c (Just srv)
+          pure srv
           where
             tryCreate = do
               usedSrvs <- newTVarIO ([] :: [XFTPServer])

From 369efc24c23689e6c290f86e2f9c6cc7e97b06e1 Mon Sep 17 00:00:00 2001
From: sh <37271604+shumvgolove@users.noreply.github.com>
Date: Sat, 8 Jun 2024 07:12:16 +0000
Subject: [PATCH 005/195] scripts: update install/update scripts (#1192)

---
 README.md                              |   2 +-
 install.sh                             | 110 +++++++++++++++---
 scripts/main/simplex-servers-uninstall |  12 +-
 scripts/main/simplex-servers-update    | 153 +++++++++++++++++--------
 4 files changed, 204 insertions(+), 73 deletions(-)

diff --git a/README.md b/README.md
index d946b8ec6..70b905803 100644
--- a/README.md
+++ b/README.md
@@ -150,7 +150,7 @@ You can install and setup servers automatically using our script:
 
 ```sh
 curl --proto '=https' --tlsv1.2 -sSf https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/install.sh -o simplex-server-install.sh \
-&& if echo 'b8cf2be103f21f9461d9a500bcd3db06ab7d01d68871b07f4bd245195cbead1d simplex-server-install.sh' | sha256sum -c; then chmod +x ./simplex-server-install.sh && ./simplex-server-install.sh; rm ./simplex-server-install.sh; else echo "SHA-256 checksum is incorrect!" && rm ./simplex-server-install.sh; fi
+&& if echo '03d8dbc38736a9e58283b88c5f09599fbcab1673eefe803f305e80eaf9539873 simplex-server-install.sh' | sha256sum -c; then chmod +x ./simplex-server-install.sh && ./simplex-server-install.sh; rm ./simplex-server-install.sh; else echo "SHA-256 checksum is incorrect!" && rm ./simplex-server-install.sh; fi
 ```
 
 ### Build from source
diff --git a/install.sh b/install.sh
index 18c2cdf11..a9418571f 100755
--- a/install.sh
+++ b/install.sh
@@ -3,8 +3,7 @@ set -eu
 
 # Links to scripts/configs
 bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
-bin_smp="$bin/smp-server-ubuntu-20_04-x86-64"
-bin_xftp="$bin/xftp-server-ubuntu-20_04-x86-64"
+remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
 
 scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
 scripts_systemd_smp="$scripts/smp-server.service"
@@ -26,6 +25,8 @@ path_conf_var="/var/opt"
 path_conf_smp="$path_conf_etc/simplex $path_conf_var/simplex"
 path_conf_xftp="$path_conf_etc/simplex-xftp $path_conf_var/simplex-xftp /srv/xftp"
 
+path_conf_info="$path_conf_etc/simplex-info"
+
 path_systemd="/etc/systemd/system"
 path_systemd_smp="$path_systemd/smp-server.service"
 path_systemd_xftp="$path_systemd/xftp-server.service"
@@ -65,7 +66,13 @@ ${GRN}4.${NC} Create systemd services:
 ${GRN}5.${NC} Install stopscript (systemd), update and uninstallation script:
     - all: ${YLW}${path_bin_update}${NC}, ${YLW}${path_bin_uninstall}${NC}, ${YLW}${path_bin_stopscript}${NC}
 
-Press ${GRN}ENTER${NC} to continue or ${RED}Ctrl+C${NC} to cancel installation"
+Press:
+  - ${GRN}ENTER${NC} to continue installing both xftp and smp servers
+  - ${GRN}1${NC} to install only smp server
+  - ${GRN}2${NC} to install only xftp server
+  - ${RED}Ctrl+C${NC} to cancel installation
+  
+Selection: "
 
 end="Installtion is complete!
 
@@ -76,27 +83,64 @@ Please checkout our server guides:
 To uninstall with full clean-up, simply run: ${YLW}sudo /usr/local/bin/simplex-servers-uninstall${NC}
 "
 
+os_test() {
+ . /etc/os-release
+
+ case "$VERSION_ID" in
+  20.04) : ;;
+  22.04) : ;;
+  *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new" "$VERSION_ID" && exit 1 ;;
+ esac
+
+ version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
+ arch="$(uname -p)"
+
+ case "$arch" in
+  x86_64) arch="$(printf '%s' "$arch" | tr '_' '-')" ;;
+  *)  printf "${RED}Unsupported architecture!${NC}\nPlease file Github issue with request to support %s architecture: https://github.com/simplex-chat/simplexmq/issues/new" "$arch" && exit 1 ;;
+ esac
+
+ bin_smp="$bin/smp-server-ubuntu-${version}-${arch}"
+ bin_xftp="$bin/xftp-server-ubuntu-${version}-${arch}"
+}
+
 setup_bins() {
- curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_smp" && chmod +x "$path_bin_smp"
- curl --proto '=https' --tlsv1.2 -sSf -L "$bin_xftp" -o "$path_bin_xftp" && chmod +x "$path_bin_xftp"
+ eval "bin=\$bin_${1}"
+ eval "path=\$path_bin_${1}"
+
+ curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path" && chmod +x "$path"
+
+ unset bin path
 }
 
 setup_users() {
- useradd -M "$user_smp" 2> /dev/null || true
- useradd -M "$user_xftp" 2> /dev/null || true
+ eval "user=\$user_${1}"
+
+ useradd -M "$user" 2> /dev/null || true
+
+ unset user
 }
 
 setup_dirs() {
  # Unquoted varibles, so field splitting can occur
- mkdir -p $path_conf_smp
- chown "$user_smp":"$user_smp" $path_conf_smp
- mkdir -p $path_conf_xftp
- chown "$user_xftp":"$user_xftp" $path_conf_xftp
+ eval "path_conf=\$path_conf_${1}"
+ eval "user=\$user_${1}"
+
+ mkdir -p $path_conf
+ mkdir -p $path_conf_info
+ printf "local_version_%s='%s'\n" "$1" "$remote_version" >> "$path_conf_info/release"
+ chown -R "$user":"$user" $path_conf
+
+ unset path_conf user
 }
 
 setup_systemd() {
- curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_smp" -o "$path_systemd_smp"
- curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_xftp" -o "$path_systemd_xftp"
+ eval "scripts_systemd=\$scripts_systemd_${1}"
+ eval "path_systemd=\$path_systemd_${1}"
+
+ curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd" -o "$path_systemd"
+
+ unset scripts_systemd path_systemd
 }
 
 setup_scripts() {
@@ -110,32 +154,62 @@ checks() {
   printf "This script is intended to be run with root privileges. Please re-run script using sudo."
   exit 1
  fi
+ 
+ os_test
+
+ mkdir -p $path_conf_info  
 }
 
 main() {
  checks
  
- printf "%b\n%b\n" "${BLU}$logo${NC}" "$welcome"
+ printf "%b\n%b" "${BLU}$logo${NC}" "$welcome"
  read ans
 
+ if [ "$ans" = '1' ]; then
+  setup='smp'
+ elif [ "$ans" = '2' ]; then
+  setup='xftp'
+ else
+  setup='smp xftp'
+ fi
+
  printf "Installing binaries..."
- setup_bins
+ 
+ for i in $setup; do
+  setup_bins "$i"
+ done
+ 
  printf "${GRN} Done!${NC}\n"
 
  printf "Creating users..."
- setup_users
+
+ for i in $setup; do
+  setup_users "$i"
+ done
+
  printf "${GRN} Done!${NC}\n"
  
  printf "Creating directories..."
- setup_dirs
+
+ for i in $setup; do
+  setup_dirs "$i"
+ done
+
  printf "${GRN} Done!${NC}\n"
 
  printf "Creating systemd services..."
- setup_systemd
+
+ for i in $setup; do
+  setup_systemd "$i"
+ done
+
  printf "${GRN} Done!${NC}\n"
 
  printf "Installing stopscript, update and uninstallation script..."
+
  setup_scripts
+
  printf "${GRN} Done!${NC}\n"
 
  printf "%b" "$end"
diff --git a/scripts/main/simplex-servers-uninstall b/scripts/main/simplex-servers-uninstall
index 4860dff34..1855a249b 100755
--- a/scripts/main/simplex-servers-uninstall
+++ b/scripts/main/simplex-servers-uninstall
@@ -13,11 +13,15 @@ fi
 printf "${RED}This action will permanently remove all configs, directories, binaries from Installation Script. Please backup any relevant configs if they are needed.${NC}\n\nPress ${GRN}ENTER${NC} to continue or ${RED}Ctrl+C${NC} to cancel installation"
 read ans
 
-systemctl stop smp-server
-systemctl stop xftp-server
+systemctl disable --now smp-server 2>/dev/null || true
+systemctl revert smp-server 2>/dev/null || true
+systemctl disable --now xftp-server 2>/dev/null || true
+systemctl revert xftp-server 2>/dev/null || true
+systemctl daemon-reload 2>/dev/null || true
 
-rm -rf /var/opt/simplex /etc/opt/simplex /var/opt/simplex-xftp /etc/opt/simplex-xftp /srv/xftp /etc/systemd/system/smp-server.service /etc/systemd/system/xftp-server.service /usr/local/bin/smp-server /usr/local/bin/xftp-server /usr/local/bin/simplex-servers-update /usr/local/bin/simplex-servers-uninstall
+rm -rf /var/opt/simplex /etc/opt/simplex /etc/opt/simplex-info /var/opt/simplex-xftp /etc/opt/simplex-xftp /srv/xftp /etc/systemd/system/smp-server.service /etc/systemd/system/xftp-server.service /usr/local/bin/smp-server /usr/local/bin/xftp-server /usr/local/bin/simplex-servers-update /usr/local/bin/simplex-servers-uninstall /usr/local/bin/simplex-servers-stopscript
 
-userdel smp && userdel xftp
+userdel smp 2>/dev/null || true
+userdel xftp 2>/dev/null || true
 
 printf "Uninstallation is complete! Thanks for trying out SimpleX!\n"
diff --git a/scripts/main/simplex-servers-update b/scripts/main/simplex-servers-update
index c1c7aa738..e069fc813 100755
--- a/scripts/main/simplex-servers-update
+++ b/scripts/main/simplex-servers-update
@@ -3,8 +3,6 @@ set -eu
 
 # Links to scripts/configs
 bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
-bin_smp="$bin/smp-server-ubuntu-20_04-x86-64"
-bin_xftp="$bin/xftp-server-ubuntu-20_04-x86-64"
 
 scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
 scripts_systemd_smp="$scripts/smp-server.service"
@@ -33,6 +31,9 @@ path_tmp_bin_stopscript="$path_tmp_bin/simplex-servers-stopscript"
 path_tmp_systemd_smp="$path_tmp_bin/smp-server.service"
 path_tmp_systemd_xftp="$path_tmp_bin/xftp-server.service"
 
+path_conf_etc='/etc/opt'
+path_conf_info='/etc/opt/simplex-info'
+
 GRN='\033[0;32m'
 BLU='\033[1;36m'
 YLW='\033[1;33m'
@@ -40,8 +41,40 @@ RED='\033[0;31m'
 NC='\033[0m'
 
 # Currently, XFTP default to v0.1.0, so it doesn't make sense to check its version
-local_version="$($path_bin_smp -v | awk '{print $3}')"
-remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
+
+os_test() {
+ . /etc/os-release
+
+ case "$VERSION_ID" in
+  20.04) : ;;
+  22.04) : ;;
+  *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new" "$VERSION_ID" && exit 1 ;;
+ esac
+
+ version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
+ arch="$(uname -p)"
+
+ case "$arch" in
+  x86_64) arch="$(printf '%s' "$arch" | tr '_' '-')" ;;
+  *)  printf "${RED}Unsupported architecture!${NC}\nPlease file Github issue with request to support %s architecture: https://github.com/simplex-chat/simplexmq/issues/new" "$arch" && exit 1 ;;
+ esac
+
+ bin_smp="$bin/smp-server-ubuntu-${version}-${arch}"
+ bin_xftp="$bin/xftp-server-ubuntu-${version}-${arch}"
+}
+
+installed_test() {
+  set +u
+  for i in $path_conf_etc/*; do
+    if [ -d "$i" ]; then
+      case "$i" in
+        *simplex) apps="smp $apps" ;;
+        *simplex-xftp) apps="xftp $apps" ;;
+      esac
+    fi
+  done
+  set -u
+}
 
 update_scripts() {
   curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_update" -o "$path_tmp_bin_update" && chmod +x "$path_tmp_bin_update"
@@ -56,6 +89,7 @@ update_scripts() {
     mv "$path_tmp_bin_uninstall" "$path_bin_uninstall"
     printf "${GRN}Done!${NC}\n"
   fi
+
   if diff -q "$path_bin_stopscript" "$path_tmp_bin_stopscript" > /dev/null 2>&1; then
     printf -- "- ${YLW}Stopscript script is up-to-date${NC}.\n"
     rm "$path_tmp_bin_stopscript"
@@ -64,6 +98,7 @@ update_scripts() {
     mv "$path_tmp_bin_stopscript" "$path_bin_stopscript"
     printf "${GRN}Done!${NC}\n"
   fi
+
   if diff -q "$path_bin_update" "$path_tmp_bin_update" > /dev/null 2>&1; then
     printf -- "- ${YLW}Update script is up-to-date${NC}.\n"
     rm "$path_tmp_bin_update"
@@ -71,75 +106,84 @@ update_scripts() {
     printf -- "- Updating update script..."
     mv "$path_tmp_bin_update" "$path_bin_update"
     printf "${GRN}Done!${NC}\n"
-    printf "Re-executing Update script with latest updates..."
+    printf -- "- Re-executing Update script with latest updates..."
     exec sh "$path_bin_update" "continue"
   fi
 }
 
 update_systemd() {
-  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_smp" -o "$path_tmp_systemd_smp"
-  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_xftp" -o "$path_tmp_systemd_xftp"
+  service="${1}-server"
+  eval "scripts_systemd=\$scripts_systemd_${1}"
+  eval "path_systemd=\$path_systemd_${1}"
+  eval "path_tmp_systemd=\$path_tmp_systemd_${1}"
+   
+  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd" -o "$path_tmp_systemd"
 
-  if diff -q "$path_systemd_smp" "$path_tmp_systemd_smp" > /dev/null 2>&1; then
-    printf -- "- ${YLW}smp-server service is up-to-date${NC}.\n"
-    rm "$path_tmp_systemd_smp"
+  if diff -q "$path_systemd" "$path_tmp_systemd" > /dev/null 2>&1; then
+    printf -- "- ${YLW}%s service is up-to-date${NC}.\n" "$service"
+    rm "$path_tmp_systemd"
   else
-    printf -- "- Updating smp-server service..."
-    mv "$path_tmp_systemd_smp" "$path_systemd_smp"
-    systemctl daemon-reload
-    printf "${GRN}Done!${NC}\n"
-  fi
-  if diff -q "$path_systemd_xftp" "$path_tmp_systemd_xftp" > /dev/null 2>&1; then
-    printf -- "- ${YLW}xftp-server service is up-to-date${NC}.\n"
-    rm "$path_tmp_systemd_xftp"
-  else
-    printf -- "- Updating xftp-server service..."
-    mv "$path_tmp_systemd_xftp" "$path_systemd_xftp"
+    printf -- "- Updating %s service..." "$service"
+    mv "$path_tmp_systemd" "$path_systemd"
     systemctl daemon-reload
     printf "${GRN}Done!${NC}\n"
   fi
+
+  unset service scripts_systemd path_systemd path_tmp_systemd
 }
 
 update_bins() {
-  if [ "$local_version" != "$remote_version" ]; then
-    if systemctl is-active --quiet smp-server; then
-      printf -- "- Stopping smp-server service..."
-      systemctl stop smp-server
-      printf "${GRN}Done!${NC}\n"
+  service="${1}-server"
+  eval "bin=\$bin_${1}"
+  eval "path_bin=\$path_bin_${1}"
 
-      printf -- "- Updating smp-server bin to %s..." "$remote_version"
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_smp" && chmod +x "$path_bin_smp"
-      printf "${GRN}Done!${NC}\n"
-      
-      printf -- "- Starting smp-server service..."
-      systemctl start smp-server
-      printf "${GRN}Done!${NC}\n"
-    else
-      printf -- "- Updating smp-server bin..."
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_smp" && chmod +x "$path_bin_smp"
-      printf "${GRN}Done!${NC}\n"
+  remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
+
+  set_ver() {
+    local_version='unset'
+    sed -i -- "s/local_version_${1}=.*/local_version_${1}='${remote_version}'/" "$path_conf_info/release"
+  }
+
+  if [ -f "$path_conf_info/release" ]; then
+    . "$path_conf_info/release" 2>/dev/null
+
+    set +u
+    eval "local_version=\$local_version_${1}"
+    set -u
+
+    if [ -z "${local_version}" ]; then
+            set_ver "$1"
     fi
+  else
+    printf 'local_version_xftp=\nlocal_version_smp=\n' > "$path_conf_info/release"
+    set_ver "$1"
+  fi
 
-    if systemctl is-active --quiet xftp-server; then
-      printf -- "- Stopping xftp-server service..."
-      systemctl stop xftp-server
+  if [ "$local_version" != "$remote_version" ]; then
+    if systemctl is-active --quiet "$service"; then
+      printf -- "- Stopping %s service..." "$service"
+      systemctl stop "$service"
       printf "${GRN}Done!${NC}\n"
 
-      printf -- "- Updating xftp-server bin to %s..." "$remote_version"
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_xftp" -o "$path_bin_xftp" && chmod +x "$path_bin_xftp"
+      printf -- "- Updating %s to %s..." "$service" "$remote_version"
+      curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path_bin" && chmod +x "$path_bin"
       printf "${GRN}Done!${NC}\n"
       
-      printf -- "- Starting xftp-server service..."
-      systemctl start xftp-server
+      printf -- "- Starting %s service..." "$service"
+      systemctl start "$service"
       printf "${GRN}Done!${NC}\n"
     else
-      printf -- "- Updating xftp-server bin..."
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_xftp" && chmod +x "$path_bin_xftp"
+      printf -- "- Updating %s to %s..." "$service" "$remote_version"
+      curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path_bin" && chmod +x "$path_bin"
       printf "${GRN}Done!${NC}\n"
     fi
   else
-    printf -- "- ${YLW}smp-server and xftp-server binaries is up-to-date${NC}.\n"
+    printf -- "- ${YLW}%s is up-to-date${NC}.\n" "$service"
   fi
+
+  set_ver "$1"
+
+  unset service bin path_bin local_version
 }
 
 checks() {
@@ -147,6 +191,11 @@ checks() {
     printf "This script is intended to be run with root privileges. Please re-run script using sudo.\n"
     exit 1
   fi
+
+  os_test
+  installed_test
+
+  mkdir -p $path_conf_info
 }
 
 main() {
@@ -163,10 +212,14 @@ main() {
   fi
 
   printf "Updating systemd services...\n"
-  update_systemd
+  for i in $apps; do
+    update_systemd "$i"
+  done
   
-  printf "Updating simplex server binaries...\n"
-  update_bins
+  printf "Updating simplex servers...\n"
+  for i in $apps; do
+    update_bins "$i"
+  done
 
   rm -rf "$path_tmp_bin"
 }

From bb1d31e459337f5d2de05f4495ff50d0a8788dff Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Mon, 10 Jun 2024 17:42:51 +0400
Subject: [PATCH 006/195] remote ctrl: differentiate RCP error when trying to
 connect to unknown host identity (#1195)

* remote ctrl: differentiate RCP error when trying to connect to unknown host identity

* rename

* refactor

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 src/Simplex/RemoteControl/Client.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/Simplex/RemoteControl/Client.hs b/src/Simplex/RemoteControl/Client.hs
index a21630454..de0cbce3b 100644
--- a/src/Simplex/RemoteControl/Client.hs
+++ b/src/Simplex/RemoteControl/Client.hs
@@ -304,7 +304,9 @@ connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca,
             logDebug "Session ended"
 
 catchRCError :: ExceptT RCErrorType IO a -> (RCErrorType -> ExceptT RCErrorType IO a) -> ExceptT RCErrorType IO a
-catchRCError = catchAllErrors (RCEException . show)
+catchRCError = catchAllErrors $ \e -> case fromException e of
+  Just (TLS.Terminated _ _ (TLS.Error_Protocol (_, _, TLS.UnknownCa))) -> RCEIdentity
+  _ -> RCEException $ show e
 {-# INLINE catchRCError #-}
 
 putRCError :: ExceptT RCErrorType IO a -> TMVar (Either RCErrorType b) -> ExceptT RCErrorType IO a

From 7008b0803172629edabacaefd7ac832ebc7191b6 Mon Sep 17 00:00:00 2001
From: "M. Sarmad Qadeer" <MSarmadQadeer@gmail.com>
Date: Sun, 16 Jun 2024 00:52:41 +0500
Subject: [PATCH 007/195] smp-server: fix layout (#1196)

* smp-server: fix layout

* ws

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 apps/smp-server/static/index.html      | 17 +++++++++++++++++
 apps/smp-server/static/media/style.css |  4 ++++
 2 files changed, 21 insertions(+)

diff --git a/apps/smp-server/static/index.html b/apps/smp-server/static/index.html
index e3889de2a..e276ff596 100644
--- a/apps/smp-server/static/index.html
+++ b/apps/smp-server/static/index.html
@@ -15,6 +15,12 @@
   <link rel="stylesheet" href="/media/style.css">
 
   <style>
+    body,
+    html {
+      width: 100%;
+      overflow-x: hidden;
+    }
+
     table#config {
       border-collapse: collapse;
       margin-bottom: 4px;
@@ -42,6 +48,17 @@
       }
     }
 
+    @media screen and (max-width: 440px) {
+      table {
+        width: 100%;
+        table-layout: fixed;
+      }
+
+      tr td:not(:last-child) {
+        width: 40%;
+      }
+    }
+
     .dark tr td:not(:last-child) {
       color: #fff;
     }
diff --git a/apps/smp-server/static/media/style.css b/apps/smp-server/static/media/style.css
index d9d2e829e..e29de80f7 100644
--- a/apps/smp-server/static/media/style.css
+++ b/apps/smp-server/static/media/style.css
@@ -50,6 +50,10 @@ img {
   /* For Internet Explorer and Edge */
 }
 
+a{
+  word-wrap: break-word;
+}
+
 /* NEW SITE */
 .container,
 .container-fluid,

From 6597f6f0ed536b2af9ea102fd7dac225c533616d Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Sun, 16 Jun 2024 05:27:58 +0300
Subject: [PATCH 008/195] tests: add proxy connection refused test (#1200)

---
 src/Simplex/Messaging/Server.hs |  4 ++--
 tests/SMPProxyTests.hs          | 24 ++++++++++++++++++++++--
 2 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 88e3bf4a3..bbdeab340 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -714,7 +714,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 let own = isOwnServer a srv
                 inc own pRequests
                 inc own $ if temporaryClientError e then pErrorsConnect else pErrorsOther
-                logError $ "Error connecting: " <> decodeLatin1 (strEncode $ host srv) <> " " <> tshow e
+                logWarn $ "Error connecting: " <> decodeLatin1 (strEncode $ host srv) <> " " <> tshow e
                 pure . ERR $ smpProxyError e
             where
               proxyResp smp =
@@ -1184,7 +1184,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                     ProhibitSub -> QProhibitSub
               qDelivered <- decodeLatin1 . encode <$$> tryReadTMVar delivered
               pure QSub {qSubThread, qDelivered}
-          
+
         ok :: Transmission BrokerMsg
         ok = (corrId, queueId, OK)
 
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 036c8b203..d71208db9 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
@@ -14,9 +15,9 @@ module SMPProxyTests where
 
 import AgentTests.EqInstances ()
 import AgentTests.FunctionalAPITests
-import Control.Concurrent (ThreadId)
+import Control.Concurrent (ThreadId, threadDelay)
 import Control.Logger.Simple
-import Control.Monad (forM, forM_, forever)
+import Control.Monad (forM, forM_, forever, replicateM_)
 import Control.Monad.Trans.Except (ExceptT, runExceptT)
 import Data.ByteString.Char8 (ByteString)
 import Data.List.NonEmpty (NonEmpty)
@@ -39,6 +40,7 @@ import Simplex.Messaging.Transport
 import Simplex.Messaging.Util (bshow, tshow)
 import Simplex.Messaging.Version (mkVersionRange)
 import System.FilePath (splitExtensions)
+import System.Random (randomRIO)
 import Test.Hspec
 import UnliftIO
 import Util
@@ -82,6 +84,10 @@ smpProxyTests = do
         it "1x1000" . twoServersFirstProxy $ deliver 1000
         it "5x200" . twoServersFirstProxy $ 5 `inParrallel` deliver 200
         it "10x100" . twoServersFirstProxy $ 10 `inParrallel` deliver 100
+      describe "stress test - no host" $ do
+        it "1x1000, no delay" . oneServer $ proxyConnectDeadRelay 1000 0 srv1
+        xit "1x1000, 100ms" . oneServer $ proxyConnectDeadRelay 1000 100000 srv1
+        xit "100x1000, 100ms" . oneServer $ 100 `inParrallel` (randomRIO (0, 1000000) >>= threadDelay >> proxyConnectDeadRelay 1000 100000 srv1)
       xdescribe "stress test 10k" $ do
         let deliver n = deliverMessagesViaProxy srv1 srv2 C.SEd448 [] (map bshow [1 :: Int .. n])
         it "1x10000" . twoServersFirstProxy $ deliver 10000
@@ -179,6 +185,20 @@ deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do
         runExceptT' $ ackSMPMessage rc rPriv rcvId msgId'
     )
 
+proxyConnectDeadRelay :: Int -> Int -> SMPServer -> IO ()
+proxyConnectDeadRelay n d proxyServ = do
+  g <- C.newRandom
+  -- set up proxy
+  pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion} Nothing (\_ -> pure ())
+  pc <- either (fail . show) pure pc'
+  THAuthClient {} <- maybe (fail "getProtocolClient returned no thAuth") pure $ thAuth $ thParams pc
+  -- get proxy session
+  replicateM_ n $ do
+    sess0 <- runExceptT $ connectSMPProxiedRelay pc (SMPServer testHost "45678" testKeyHash) (Just "correct")
+    case sess0 of
+      Right !_noWay -> error "got unexpected client"
+      Left !_err -> threadDelay d
+
 agentDeliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => (NonEmpty SMPServer, SMPProxyMode, Bool) -> (NonEmpty SMPServer, SMPProxyMode, Bool) -> C.SAlgorithm a -> ByteString -> ByteString -> IO ()
 agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, bViaProxy) alg msg1 msg2 =
   withAgent 1 aCfg (servers aTestCfg) testDB $ \alice ->

From 388d77b61a6ffc8e0b31afb3e2d315bee095bf7c Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sat, 15 Jun 2024 20:05:45 -0700
Subject: [PATCH 009/195] ntf stats on SMP server (#1197)

* log undelivered notifications

* type

* add counters and encoding

* rename

* diff

* style

* style2

---------

Co-authored-by: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
---
 src/Simplex/Messaging/Server.hs       |  41 +++++---
 src/Simplex/Messaging/Server/Stats.hs | 131 ++++++++++++++++++++++++--
 tests/ServerTests.hs                  |   6 +-
 3 files changed, 155 insertions(+), 23 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index bbdeab340..dfb4973ea 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -229,7 +229,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
       liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
       liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
-      ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubAuth, qSubDuplicate, qSubProhibited, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv} <- asks serverStats
+      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubAuth, qSubDuplicate, qSubProhibited, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv} <- asks serverStats
       let interval = 1000000 * logInterval
       forever $ do
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
@@ -255,6 +255,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           msgSentNtf' <- atomically $ swapTVar msgSentNtf 0
           msgRecvNtf' <- atomically $ swapTVar msgRecvNtf 0
           psNtf <- atomically $ periodStatCounts activeQueuesNtf ts
+          msgNtfs' <- atomically $ swapTVar (msgNtfs ss) 0
+          msgNtfNoSub' <- atomically $ swapTVar (msgNtfNoSub ss) 0
+          msgNtfLost' <- atomically $ swapTVar (msgNtfLost ss) 0
           pRelays' <- atomically $ getResetProxyStatsData pRelays
           pRelaysOwn' <- atomically $ getResetProxyStatsData pRelaysOwn
           pMsgFwds' <- atomically $ getResetProxyStatsData pMsgFwds
@@ -296,7 +299,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                        show qSubProhibited',
                        show msgSentAuth',
                        show msgSentQuota',
-                       show msgSentLarge'
+                       show msgSentLarge',
+                       show msgNtfs',
+                       show msgNtfNoSub',
+                       show msgNtfLost'
                      ]
               )
         liftIO $ threadDelay' interval
@@ -1010,7 +1016,15 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                           pure $ err QUOTA
                         Just msg -> time "SEND ok" $ do
                           when (notification msgFlags) $ do
-                            atomically . trySendNotification msg =<< asks random
+                            forM_ (notifier qr) $ \ntf -> do
+                              asks random >>= atomically . trySendNotification ntf msg >>= \case
+                                Nothing -> do
+                                  atomically $ modifyTVar' (msgNtfNoSub stats) (+ 1)
+                                  logWarn "No notification subscription"
+                                Just False -> do
+                                  atomically $ modifyTVar' (msgNtfLost stats) (+ 1)
+                                  logWarn "Dropped message notification"
+                                Just True -> atomically $ modifyTVar' (msgNtfs stats) (+ 1)
                             atomically $ modifyTVar' (msgSentNtf stats) (+ 1)
                             atomically $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
                           atomically $ modifyTVar' (msgSent stats) (+ 1)
@@ -1033,18 +1047,19 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
               deleted <- atomically $ sum <$> mapM (deleteExpiredMsgs q) old
               atomically $ modifyTVar' (msgExpired stats) (+ deleted)
 
-            trySendNotification :: Message -> TVar ChaChaDRG -> STM ()
-            trySendNotification msg ntfNonceDrg =
-              forM_ (notifier qr) $ \NtfCreds {notifierId, rcvNtfDhSecret} ->
-                mapM_ (writeNtf notifierId msg rcvNtfDhSecret ntfNonceDrg) =<< TM.lookup notifierId notifiers
+            trySendNotification :: NtfCreds -> Message -> TVar ChaChaDRG -> STM (Maybe Bool)
+            trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg ntfNonceDrg =
+              mapM (writeNtf notifierId msg rcvNtfDhSecret ntfNonceDrg) =<< TM.lookup notifierId notifiers
 
-            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> TVar ChaChaDRG -> Client -> STM ()
+            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> TVar ChaChaDRG -> Client -> STM Bool
             writeNtf nId msg rcvNtfDhSecret ntfNonceDrg Client {sndQ = q} =
-              unlessM (isFullTBQueue q) $ case msg of
-                Message {msgId, msgTs} -> do
-                  (nmsgNonce, encNMsgMeta) <- mkMessageNotification msgId msgTs rcvNtfDhSecret ntfNonceDrg
-                  writeTBQueue q [(CorrId "", nId, NMSG nmsgNonce encNMsgMeta)]
-                _ -> pure ()
+              ifM (isFullTBQueue q) (pure False) (sendNtf $> True)
+              where
+                sendNtf = case msg of
+                  Message {msgId, msgTs} -> do
+                    (nmsgNonce, encNMsgMeta) <- mkMessageNotification msgId msgTs rcvNtfDhSecret ntfNonceDrg
+                    writeTBQueue q [(CorrId "", nId, NMSG nmsgNonce encNMsgMeta)]
+                  _ -> pure ()
 
             mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> TVar ChaChaDRG -> STM (C.CbNonce, EncNMsgMeta)
             mkMessageNotification msgId msgTs rcvNtfDhSecret ntfNonceDrg = do
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index 880791c3d..f2716c9c3 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -37,9 +37,12 @@ data ServerStats = ServerStats
     msgRecv :: TVar Int,
     msgExpired :: TVar Int,
     activeQueues :: PeriodStats RecipientId,
-    msgSentNtf :: TVar Int,
-    msgRecvNtf :: TVar Int,
+    msgSentNtf :: TVar Int, -- sent messages with NTF flag
+    msgRecvNtf :: TVar Int, -- received messages with NTF flag
     activeQueuesNtf :: PeriodStats RecipientId,
+    msgNtfs :: TVar Int, -- messages notications delivered to NTF server (<= msgSentNtf)
+    msgNtfNoSub :: TVar Int, -- no subscriber to notifications (e.g., NTF server not connected)
+    msgNtfLost :: TVar Int, -- notification is lost because NTF delivery queue is full
     pRelays :: ProxyStats,
     pRelaysOwn :: ProxyStats,
     pMsgFwds :: ProxyStats,
@@ -70,6 +73,9 @@ data ServerStatsData = ServerStatsData
     _msgSentNtf :: Int,
     _msgRecvNtf :: Int,
     _activeQueuesNtf :: PeriodStatsData RecipientId,
+    _msgNtfs :: Int,
+    _msgNtfNoSub :: Int,
+    _msgNtfLost :: Int,
     _pRelays :: ProxyStatsData,
     _pRelaysOwn :: ProxyStatsData,
     _pMsgFwds :: ProxyStatsData,
@@ -102,6 +108,9 @@ newServerStats ts = do
   msgSentNtf <- newTVar 0
   msgRecvNtf <- newTVar 0
   activeQueuesNtf <- newPeriodStats
+  msgNtfs <- newTVar 0
+  msgNtfNoSub <- newTVar 0
+  msgNtfLost <- newTVar 0
   pRelays <- newProxyStats
   pRelaysOwn <- newProxyStats
   pMsgFwds <- newProxyStats
@@ -109,7 +118,39 @@ newServerStats ts = do
   pMsgFwdsRecv <- newTVar 0
   qCount <- newTVar 0
   msgCount <- newTVar 0
-  pure ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubAuth, qSubDuplicate, qSubProhibited, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv, qCount, msgCount}
+  pure
+    ServerStats
+      { fromTime,
+        qCreated,
+        qSecured,
+        qDeletedAll,
+        qDeletedNew,
+        qDeletedSecured,
+        qSub,
+        qSubAuth,
+        qSubDuplicate,
+        qSubProhibited,
+        msgSent,
+        msgSentAuth,
+        msgSentQuota,
+        msgSentLarge,
+        msgRecv,
+        msgExpired,
+        activeQueues,
+        msgSentNtf,
+        msgRecvNtf,
+        activeQueuesNtf,
+        msgNtfs,
+        msgNtfNoSub,
+        msgNtfLost,
+        pRelays,
+        pRelaysOwn,
+        pMsgFwds,
+        pMsgFwdsOwn,
+        pMsgFwdsRecv,
+        qCount,
+        msgCount
+      }
 
 getServerStatsData :: ServerStats -> STM ServerStatsData
 getServerStatsData s = do
@@ -121,7 +162,7 @@ getServerStatsData s = do
   _qDeletedSecured <- readTVar $ qDeletedSecured s
   _qSub <- readTVar $ qSub s
   _qSubAuth <- readTVar $ qSubAuth s
-  _qSubDuplicate <- readTVar $ qSubDuplicate s  
+  _qSubDuplicate <- readTVar $ qSubDuplicate s
   _qSubProhibited <- readTVar $ qSubProhibited s
   _msgSent <- readTVar $ msgSent s
   _msgSentAuth <- readTVar $ msgSentAuth s
@@ -133,6 +174,9 @@ getServerStatsData s = do
   _msgSentNtf <- readTVar $ msgSentNtf s
   _msgRecvNtf <- readTVar $ msgRecvNtf s
   _activeQueuesNtf <- getPeriodStatsData $ activeQueuesNtf s
+  _msgNtfs <- readTVar $ msgNtfs s
+  _msgNtfNoSub <- readTVar $ msgNtfNoSub s
+  _msgNtfLost <- readTVar $ msgNtfLost s
   _pRelays <- getProxyStatsData $ pRelays s
   _pRelaysOwn <- getProxyStatsData $ pRelaysOwn s
   _pMsgFwds <- getProxyStatsData $ pMsgFwds s
@@ -140,7 +184,39 @@ getServerStatsData s = do
   _pMsgFwdsRecv <- readTVar $ pMsgFwdsRecv s
   _qCount <- readTVar $ qCount s
   _msgCount <- readTVar $ msgCount s
-  pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeletedAll, _qDeletedNew, _qDeletedSecured, _qSub, _qSubAuth, _qSubDuplicate, _qSubProhibited, _msgSent, _msgSentAuth, _msgSentQuota, _msgSentLarge, _msgRecv, _msgExpired, _activeQueues, _msgSentNtf, _msgRecvNtf, _activeQueuesNtf, _pRelays, _pRelaysOwn, _pMsgFwds, _pMsgFwdsOwn, _pMsgFwdsRecv, _qCount, _msgCount}
+  pure
+    ServerStatsData
+      { _fromTime,
+        _qCreated,
+        _qSecured,
+        _qDeletedAll,
+        _qDeletedNew,
+        _qDeletedSecured,
+        _qSub,
+        _qSubAuth,
+        _qSubDuplicate,
+        _qSubProhibited,
+        _msgSent,
+        _msgSentAuth,
+        _msgSentQuota,
+        _msgSentLarge,
+        _msgRecv,
+        _msgExpired,
+        _activeQueues,
+        _msgSentNtf,
+        _msgRecvNtf,
+        _activeQueuesNtf,
+        _msgNtfs,
+        _msgNtfNoSub,
+        _msgNtfLost,
+        _pRelays,
+        _pRelaysOwn,
+        _pMsgFwds,
+        _pMsgFwdsOwn,
+        _pMsgFwdsRecv,
+        _qCount,
+        _msgCount
+      }
 
 setServerStats :: ServerStats -> ServerStatsData -> STM ()
 setServerStats s d = do
@@ -151,7 +227,7 @@ setServerStats s d = do
   writeTVar (qDeletedNew s) $! _qDeletedNew d
   writeTVar (qDeletedSecured s) $! _qDeletedSecured d
   writeTVar (qSub s) $! _qSub d
-  writeTVar (qSubAuth s) $! _qSubAuth d  
+  writeTVar (qSubAuth s) $! _qSubAuth d
   writeTVar (qSubDuplicate s) $! _qSubDuplicate d
   writeTVar (qSubProhibited s) $! _qSubProhibited d
   writeTVar (msgSent s) $! _msgSent d
@@ -164,6 +240,9 @@ setServerStats s d = do
   writeTVar (msgSentNtf s) $! _msgSentNtf d
   writeTVar (msgRecvNtf s) $! _msgRecvNtf d
   setPeriodStats (activeQueuesNtf s) (_activeQueuesNtf d)
+  writeTVar (msgNtfs s) $! _msgNtfs d
+  writeTVar (msgNtfNoSub s) $! _msgNtfNoSub d
+  writeTVar (msgNtfLost s) $! _msgNtfLost d
   setProxyStats (pRelays s) $! _pRelays d
   setProxyStats (pRelaysOwn s) $! _pRelaysOwn d
   setProxyStats (pMsgFwds s) $! _pMsgFwds d
@@ -194,6 +273,9 @@ instance StrEncoding ServerStatsData where
         "msgExpired=" <> strEncode (_msgExpired d),
         "msgSentNtf=" <> strEncode (_msgSentNtf d),
         "msgRecvNtf=" <> strEncode (_msgRecvNtf d),
+        "msgNtfs=" <> strEncode (_msgNtfs d),
+        "msgNtfNoSub=" <> strEncode (_msgNtfNoSub d),
+        "msgNtfLost=" <> strEncode (_msgNtfLost d),
         "activeQueues:",
         strEncode (_activeQueues d),
         "activeQueuesNtf:",
@@ -228,6 +310,9 @@ instance StrEncoding ServerStatsData where
     _msgExpired <- opt "msgExpired="
     _msgSentNtf <- opt "msgSentNtf="
     _msgRecvNtf <- opt "msgRecvNtf="
+    _msgNtfs <- opt "msgNtfs="
+    _msgNtfNoSub <- opt "msgNtfNoSub="
+    _msgNtfLost <- opt "msgNtfLost="
     _activeQueues <-
       optional ("activeQueues:" <* A.endOfLine) >>= \case
         Just _ -> strP <* optional A.endOfLine
@@ -245,7 +330,39 @@ instance StrEncoding ServerStatsData where
     _pMsgFwds <- proxyStatsP "pMsgFwds:"
     _pMsgFwdsOwn <- proxyStatsP "pMsgFwdsOwn:"
     _pMsgFwdsRecv <- opt "pMsgFwdsRecv="
-    pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeletedAll, _qDeletedNew, _qDeletedSecured, _qSub, _qSubAuth, _qSubDuplicate, _qSubProhibited, _msgSent, _msgSentAuth, _msgSentQuota, _msgSentLarge, _msgRecv, _msgExpired, _msgSentNtf, _msgRecvNtf, _activeQueues, _activeQueuesNtf, _pRelays, _pRelaysOwn, _pMsgFwds, _pMsgFwdsOwn, _pMsgFwdsRecv, _qCount, _msgCount = 0}
+    pure
+      ServerStatsData
+        { _fromTime,
+          _qCreated,
+          _qSecured,
+          _qDeletedAll,
+          _qDeletedNew,
+          _qDeletedSecured,
+          _qSub,
+          _qSubAuth,
+          _qSubDuplicate,
+          _qSubProhibited,
+          _msgSent,
+          _msgSentAuth,
+          _msgSentQuota,
+          _msgSentLarge,
+          _msgRecv,
+          _msgExpired,
+          _msgSentNtf,
+          _msgRecvNtf,
+          _msgNtfs,
+          _msgNtfNoSub,
+          _msgNtfLost,
+          _activeQueues,
+          _activeQueuesNtf,
+          _pRelays,
+          _pRelaysOwn,
+          _pMsgFwds,
+          _pMsgFwdsOwn,
+          _pMsgFwdsRecv,
+          _qCount,
+          _msgCount = 0
+        }
     where
       opt s = A.string s *> strP <* A.endOfLine <|> pure 0
       proxyStatsP key =
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index e2ca278d9..a124a42e4 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -608,7 +608,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 2
     logSize testStoreMsgsFile `shouldReturn` 5
-    logSize testServerStatsBackupFile `shouldReturn` 52
+    logSize testServerStatsBackupFile `shouldReturn` 55
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
 
@@ -626,7 +626,7 @@ testRestoreMessages at@(ATransport t) =
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
     logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 52
+    logSize testServerStatsBackupFile `shouldReturn` 55
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
@@ -645,7 +645,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     logSize testStoreMsgsFile `shouldReturn` 0
-    logSize testServerStatsBackupFile `shouldReturn` 52
+    logSize testServerStatsBackupFile `shouldReturn` 55
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
 

From 4bbadffa372cfd5ea95c437a44877edc17b1a279 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Sun, 16 Jun 2024 17:27:25 +0400
Subject: [PATCH 010/195] agent: api to reconnect single server (#1198)

* agent: api to reconnect single server

* refactor

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 src/Simplex/Messaging/Agent.hs        |  1 +
 src/Simplex/Messaging/Agent/Client.hs | 11 +++++++++++
 2 files changed, 12 insertions(+)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index c550ba04a..63f74b5b2 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -82,6 +82,7 @@ module Simplex.Messaging.Agent
     setNetworkConfig,
     setUserNetworkInfo,
     reconnectAllServers,
+    reconnectSMPServer,
     registerNtfToken,
     verifyNtfToken,
     checkNtfToken,
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 303bb55be..2ffd6e3a4 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -32,6 +32,7 @@ module Simplex.Messaging.Agent.Client
     closeAgentClient,
     closeProtocolServerClients,
     reconnectServerClients,
+    reconnectSMPServer,
     closeXFTPServerClient,
     runSMPServerTest,
     runXFTPServerTest,
@@ -925,6 +926,16 @@ reconnectServerClients :: ProtocolServerClient v err msg => AgentClient -> (Agen
 reconnectServerClients c clientsSel =
   readTVarIO (clientsSel c) >>= mapM_ (forkIO . closeClient_ c)
 
+reconnectSMPServer :: AgentClient -> UserId -> SMPServer -> IO ()
+reconnectSMPServer c userId srv = do
+  cs <- readTVarIO $ smpClients c
+  let vs = M.foldrWithKey srvClient [] cs
+  mapM_ (forkIO . closeClient_ c) vs
+  where
+    srvClient (userId', srv', _) v
+      | userId == userId' && srv == srv' = (v :)
+      | otherwise = id
+
 closeClient :: ProtocolServerClient v err msg => AgentClient -> (AgentClient -> TMap (TransportSession msg) (ClientVar msg)) -> TransportSession msg -> IO ()
 closeClient c clientSel tSess =
   atomically (TM.lookupDelete tSess $ clientSel c) >>= mapM_ (closeClient_ c)

From f616cb7b3ef1fe8cf2a59bee8e5a220f57a3a0fb Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 16 Jun 2024 07:36:38 -0700
Subject: [PATCH 011/195] 5.8.1.0

---
 CHANGELOG.md    | 11 +++++++++++
 package.yaml    |  2 +-
 simplexmq.cabal |  2 +-
 3 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index e161a26df..707a6ff5f 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,14 @@
+# 5.8.1
+
+Agent:
+- API to reconnect one server.
+- Better error handling of file errors and remote control connection errors.
+- Only start uploading file once all chunks were registered on the servers.
+
+SMP server:
+- additional stats for sent message notifications.
+- fix server page layout.
+
 # 5.8.0
 
 Version 5.8.0.10
diff --git a/package.yaml b/package.yaml
index ef747da0d..16e75c866 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 5.8.0.10
+version: 5.8.1.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index bbe7583fa..1166ca4ff 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        5.8.0.10
+version:        5.8.1.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 8a3b72458f917e9867f4e3640dda0fa1827ff6cf Mon Sep 17 00:00:00 2001
From: sh <37271604+shumvgolove@users.noreply.github.com>
Date: Sun, 16 Jun 2024 14:43:22 +0000
Subject: [PATCH 012/195] readme: update compiling from source instructions
 (#1190)

---
 README.md | 31 ++++++++++++++++++++++---------
 1 file changed, 22 insertions(+), 9 deletions(-)

diff --git a/README.md b/README.md
index d946b8ec6..2c475ffd5 100644
--- a/README.md
+++ b/README.md
@@ -208,14 +208,17 @@ On Linux, you can build smp server using Docker.
 
 #### Using your distribution
 
-1. Install [Haskell GHCup](https://www.haskell.org/ghcup/), GHC 8.10.7 and cabal:
+1. Install dependencies and build tools (`GHC`, `cabal` and dev libs):
 
    ```sh
-   curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
-   ghcup install ghc 8.10.7
-   ghcup install cabal
-   ghcup set ghc 8.10.7
-   ghcup set cabal
+   # On Ubuntu. Depending on your distribution, use your package manager to determine package names.
+   sudo apt-get update && apt-get install -y build-essential curl libffi-dev libffi7 libgmp3-dev libgmp10 libncurses-dev libncurses5 libtinfo5 pkg-config zlib1g-dev libnuma-dev libssl-dev
+   export BOOTSTRAP_HASKELL_GHC_VERSION=9.6.3
+   export BOOTSTRAP_HASKELL_CABAL_VERSION=3.10.3.0
+   curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
+   ghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
+   ghcup set cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
+   source ~/.ghcup/env
    ```
 
 2. Build the project:
@@ -224,10 +227,20 @@ On Linux, you can build smp server using Docker.
    git clone https://github.com/simplex-chat/simplexmq
    cd simplexmq
    git checkout stable
-   # On Ubuntu. Depending on your distribution, use your package manager to determine package names.
-   apt-get update && apt-get install -y build-essential libgmp3-dev zlib1g-dev
    cabal update
-   cabal install
+   cabal build exe:smp-server exe:xftp-server
+   ```
+
+3. List compiled binaries:
+
+   `smp-server`
+   ```sh
+   cabal list-bin exe:smp-server
+   ```
+
+   `xftp-server`
+   ```sh
+   cabal list-bin exe:xftp-server 
    ```
 
 - Initialize SMP server with `smp-server init [-l] -n <fqdn>` or `smp-server init [-l] --ip <ip>` - depending on how you initialize it, either FQDN or IP will be used for server's address.

From d47c099ac94eda3342d02da2da76ef5cab5793ac Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 23 Jun 2024 22:53:45 +0100
Subject: [PATCH 013/195] docs: update protocol specifications (#1204)

* docs: update protocol specifications

* update SMP protocol (WIP)

* add proxy protocol commands and responses, amend envelope sizes in SMP protocol

* docs: update XFTP protocol (#1205)

* docs: update XFTP protocol

* commands

* fix table of contents, move sections

* add about ids

* download encryption

* qualities

* diagram

* crypto

* sending file diagram

* fix svg

* receiving file diagram

* update commands

* update handshake

* Add updated XRCP (#1207)

* add XRCP protocol

* add ToC

* update

* update

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

* add XFTP handshake description

* update agent protocol

* fast duplex connection in agent protocol

* update agent protocol

* update overview

* typos

* queue rotation, agent API, updates

* push notifications specification

* add XRCP threat model

* XFTP threat model

* update PQDR

* agent protocol end-to-end encryption

* versions

* remove TOC details

* update

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Co-authored-by: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
---
 protocol/agent-protocol.md                    | 625 +++++++-------
 .../duplex-messaging/duplex-creating-fast.mmd |  65 ++
 .../duplex-messaging/duplex-creating-fast.svg |   3 +
 .../duplex-messaging/duplex-creating-v2.mmd   |  71 --
 .../duplex-messaging/duplex-creating.mmd      |  65 +-
 .../duplex-messaging/duplex-creating.svg      |   4 +-
 .../duplex-messaging/queue-rotation-fast.mmd  |  17 +
 .../duplex-messaging/queue-rotation-fast.svg  |   3 +
 .../duplex-messaging/queue-rotation.mmd       |  21 +
 .../duplex-messaging/queue-rotation.svg       |   3 +
 .../notifications/register-token-detailed.mmd |  30 +
 .../diagrams/notifications/register-token.mmd |  30 +-
 .../diagrams/notifications/register-token.svg |   3 +
 .../notifications/subscription-detailed.mmd   |  40 +
 .../diagrams/notifications/subscription.mmd   |  30 +-
 .../diagrams/notifications/subscription.svg   |   3 +
 .../simplex-creating-fast.mmd                 |  23 +
 .../simplex-creating-fast.svg                 |   3 +
 .../simplex-messaging/simplex-creating.mmd    |   6 +-
 .../simplex-messaging/simplex-creating.svg    |   4 +-
 .../diagrams/xftp/xftp-receiving-file.mmd     |  18 +
 .../diagrams/xftp/xftp-receiving-file.svg     |   3 +
 protocol/diagrams/xftp/xftp-sending-file.mmd  |  23 +
 protocol/diagrams/xftp/xftp-sending-file.svg  |   3 +
 protocol/diagrams/xrcp/session.mmd            |  44 +
 protocol/diagrams/xrcp/session.svg            |   1 +
 protocol/overview-tjr.md                      | 183 ++--
 protocol/pqdr.md                              | 222 +++++
 protocol/push-notifications.md                | 398 +++++++++
 protocol/simplex-messaging.md                 | 785 +++++++++++++-----
 protocol/xftp.md                              | 632 ++++++++++++++
 protocol/xrcp.md                              | 330 ++++++++
 .../2022-12-26-simplex-file-transfer.md       |   0
 rfcs/{ => done}/2022-12-27-queue-quota.md     |   0
 rfcs/{ => done}/2023-05-02-resync-ratchets.md |   0
 .../2023-05-03-delivery-receipts.md           |   0
 .../2023-05-24-smp-delivery-proxy.md          |   0
 rfcs/{ => done}/2023-06-08-resync-ratchets.md |   0
 rfcs/{ => done}/2023-09-12-second-relays.md   |   0
 rfcs/{ => done}/2023-10-25-remote-control.md  |   0
 rfcs/{ => done}/2024-01-26-file-links.md      |   0
 rfcs/{ => done}/2024-02-03-deniability.md     |   0
 rfcs/{ => done}/2024-03-28-xftp-version.md    |   0
 rfcs/{ => rejected}/2021-02-28-streams.md     |   0
 src/Simplex/Messaging/Agent/Protocol.hs       |   3 -
 45 files changed, 3001 insertions(+), 693 deletions(-)
 create mode 100644 protocol/diagrams/duplex-messaging/duplex-creating-fast.mmd
 create mode 100644 protocol/diagrams/duplex-messaging/duplex-creating-fast.svg
 delete mode 100644 protocol/diagrams/duplex-messaging/duplex-creating-v2.mmd
 create mode 100644 protocol/diagrams/duplex-messaging/queue-rotation-fast.mmd
 create mode 100644 protocol/diagrams/duplex-messaging/queue-rotation-fast.svg
 create mode 100644 protocol/diagrams/duplex-messaging/queue-rotation.mmd
 create mode 100644 protocol/diagrams/duplex-messaging/queue-rotation.svg
 create mode 100644 protocol/diagrams/notifications/register-token-detailed.mmd
 create mode 100644 protocol/diagrams/notifications/register-token.svg
 create mode 100644 protocol/diagrams/notifications/subscription-detailed.mmd
 create mode 100644 protocol/diagrams/notifications/subscription.svg
 create mode 100644 protocol/diagrams/simplex-messaging/simplex-creating-fast.mmd
 create mode 100644 protocol/diagrams/simplex-messaging/simplex-creating-fast.svg
 create mode 100644 protocol/diagrams/xftp/xftp-receiving-file.mmd
 create mode 100644 protocol/diagrams/xftp/xftp-receiving-file.svg
 create mode 100644 protocol/diagrams/xftp/xftp-sending-file.mmd
 create mode 100644 protocol/diagrams/xftp/xftp-sending-file.svg
 create mode 100644 protocol/diagrams/xrcp/session.mmd
 create mode 100644 protocol/diagrams/xrcp/session.svg
 create mode 100644 protocol/pqdr.md
 create mode 100644 protocol/push-notifications.md
 create mode 100644 protocol/xftp.md
 create mode 100644 protocol/xrcp.md
 rename rfcs/{ => done}/2022-12-26-simplex-file-transfer.md (100%)
 rename rfcs/{ => done}/2022-12-27-queue-quota.md (100%)
 rename rfcs/{ => done}/2023-05-02-resync-ratchets.md (100%)
 rename rfcs/{ => done}/2023-05-03-delivery-receipts.md (100%)
 rename rfcs/{ => done}/2023-05-24-smp-delivery-proxy.md (100%)
 rename rfcs/{ => done}/2023-06-08-resync-ratchets.md (100%)
 rename rfcs/{ => done}/2023-09-12-second-relays.md (100%)
 rename rfcs/{ => done}/2023-10-25-remote-control.md (100%)
 rename rfcs/{ => done}/2024-01-26-file-links.md (100%)
 rename rfcs/{ => done}/2024-02-03-deniability.md (100%)
 rename rfcs/{ => done}/2024-03-28-xftp-version.md (100%)
 rename rfcs/{ => rejected}/2021-02-28-streams.md (100%)

diff --git a/protocol/agent-protocol.md b/protocol/agent-protocol.md
index 0da8af828..d8744f128 100644
--- a/protocol/agent-protocol.md
+++ b/protocol/agent-protocol.md
@@ -1,3 +1,5 @@
+Version 5, 2024-06-22
+
 # SMP agent protocol - duplex communication over SMP protocol
 
 ## Table of contents
@@ -5,69 +7,61 @@
 - [Abstract](#abstract)
 - [SMP agent](#smp-agent)
 - [SMP servers management](#smp-servers-management)
-- [SMP agent protocol components](#smp-agent-protocol-components)
+- [SMP agent protocol scope](#smp-agent-protocol-scope)
 - [Duplex connection procedure](#duplex-connection-procedure)
+- [Contact addresses](#contact-addresses)
 - [Communication between SMP agents](#communication-between-smp-agents)
   - [Message syntax](#messages-between-smp-agents)
     - [HELLO message](#hello-message)
-    - [REPLY message](#reply-message)
-    - [MSG message](#msg-message)
-    - [INV message](#inv-message)
-    - [ACK message](#ack-message)
-    - [NEW message](#new-message)
-    - [DEL message](#del-message)
-- [SMP agent commands](#smp-agent-commands)
-  - [Client commands and server responses](#client-commands-and-server-responses)
-    - [NEW command and INV response](#new-command-and-inv-response)
-    - [JOIN command](#join-command)
-    - [CONF notification and LET command](#conf-notification-and-let-command)
-    - [REQ notification and ACPT command](#req-notification-and-acpt-command)
-    - [INFO and CON notifications](#info-and-con-notifications)
-    - [SUB command](#sub-command)
-    - [SEND command and MID, SENT and MERR responses](#send-command-and-mid-sent-and-merr-responses)
-    - [MSG notification](#msg-notification)
-    - [END notification](#end-notification)
-    - [OFF command](#off-command)
-    - [DEL command](#del-command)
-- [Connection request](#connection-request)
+    - [A_MSG message](#a_msg-message)
+    - [A_RCVD message](#a_rcvd-message)
+    - [EREADY message](#eready-message)
+    - [A_QCONT message](#a_qcont-message)
+    - [Rotating messaging queue](#rotating-messaging-queue)
+- [End-to-end encryption](#end-to-end-encryption)
+- [Connection link: 1-time invitation and contact address](#connection-link-1-time-invitation-and-contact-address)
+- [Appendix A: SMP agent API](#smp-agent-api)
+  - [API functions](#api-functions)
+  - [API events](#api-events)
 
 ## Abstract
 
 The purpose of SMP agent protocol is to define the syntax and the semantics of communications between the client and the agent that connects to [SMP](./simplex-messaging.md) servers.
 
 It provides:
-- protocol to create and manage bi-directional (duplex) connections between the users of SMP agents consisting of two (or more) separate unidirectional (simplex) SMP queues, abstracting away multiple steps required to establish bi-directional connections and any information about the servers location from the users of the agent protocol.
+- API to create and manage bi-directional (duplex) connections between the users of SMP agents consisting of two (or more) separate unidirectional (simplex) SMP queues, abstracting away multiple steps required to establish bi-directional connections and any information about the servers location from the users of the agent protocol.
 - management of E2E encryption between SMP agents, generating ephemeral asymmetric keys for each connection.
 - SMP command authentication on SMP servers, generating ephemeral keys for each SMP queue.
 - TCP/TLS transport handshake with SMP servers.
 - validation of message integrity.
 
-SMP agent protocol provides no encryption or security on the client side - it is assumed that the agent is executed in the trusted and secure environment, in one of three ways:
-- via TCP network using secure connection.
-- via local port (when the agent runs on the same device as a separate process).
-- via agent library, when the agent logic is included directly into the client application - [SimpleX Chat for terminal](https://github.com/simplex-chat/simplex-chat) uses this approach.
+SMP agent API provides no security between the agent and the client - it is assumed that the agent is executed in the trusted and secure environment, via the agent library, when the agent logic is included directly into the client application - [SimpleX Chat for terminal](https://github.com/simplex-chat/simplex-chat) uses this approach.
 
 ## SMP agent
 
-SMP agents communicate with each other via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) according to the commands received from its users. This protocol is a middle layer in SimpleX protocols (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections").
+SMP agents communicate with each other via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) according to the API calls used by the client applications. This protocol is a middle layer in SimpleX protocols (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections").
 
 The agent must have a persistent storage to manage the states of known connections and of the client-side information of SMP queues that each connection consists of, and also the buffer of the most recent sent and received messages. The number of the messages that should be stored is implementation specific, depending on the error management approach that the agent implements; at the very least the agent must store the hashes and IDs of the last received and sent messages.
 
 ## SMP servers management
 
-SMP agent protocol commands do not contain the addresses of the SMP servers that the agent will use to create and use the connections (excluding the server address in queue URIs used in JOIN command). The list of the servers is a part of the agent configuration and can be dynamically changed by the agent implementation:
+SMP agent API does not use the addresses of the SMP servers that the agent will use to create and use the connections (excluding the server address in queue URIs used in JOIN command). The list of the servers is a part of the agent configuration and can be dynamically changed by the agent implementation:
 - by the client applications via any API that is outside of scope of this protocol.
 - by the agents themselves based on availability and latency of the configured servers.
 
-## SMP agent protocol components
+## SMP agent protocol scope
 
-SMP agent protocol has 3 main parts:
+SMP agent protocol has 2 main parts:
 
-- the syntax and semantics of the messages that SMP agents exchange with each other in order to:
+- the messages that SMP agents exchange with each other in order to:
   - negotiate establishing unidirectional (simplex) encrypted queues on SMP servers.
   - exchange client messages and delivery notifications, providing sequential message IDs and message integrity (by including the hash of the previous message).
-- the syntax and semantics of the commands that are sent by the agent clients to the agents. This protocol allows to create and manage multiple connections, each consisting of two or more SMP queues.
-- the syntax and semantics of the message that the clients of SMP agents should send out-of-band (as pre-shared "invitation" including queue URIs) to protect [E2E encryption][1] from active attacks ([MITM attacks][2]).
+  - re-negotiate messaging queues to use and connection e2e encryption.
+- the messages that the clients of SMP agents should send out-of-band (as pre-shared "invitation" including queue URIs) to protect [E2E encryption][1] from active attacks ([MITM attacks][2]).
+
+[Appendix A](#appendix-a-smp-agent-api) of this document describes:
+- the functional API used by the client application with the agent. This API allows to create and manage multiple connections, each consisting of two or more SMP queues.
+- events that the agent passes to the clients.
 
 ## Duplex connection procedure
 
@@ -75,54 +69,126 @@ SMP agent protocol has 3 main parts:
 
 The procedure of establishing a duplex connection is explained on the example of Alice and Bob creating a bi-directional connection consisting of two unidirectional (simplex) queues, using SMP agents (A and B) to facilitate it, and two different SMP servers (which could be the same server). It is shown on the diagram above and has these steps:
 
-1. Alice requests the new connection from the SMP agent A using SMP NEW command.
-2. Agent A creates an SMP connection on the server (using [SMP protocol](./simplex-messaging.md)) and responds to Alice with the invitation that contains queue information and the encryption key Bob's agent B should use. The invitation format is described in [Connection request](#connection-request).
-3. Alice sends the [connection request](#connection-request) to Bob via any secure channel (out-of-band message).
-4. Bob sends `JOIN` command with the connection request as a parameter to agent B to accept the connection.
-5. Establishing Alice's SMP queue (with SMP protocol commands):
-  - Agent B sends an "SMP confirmation" with SMP SEND command to the SMP queue specified in the connection request - SMP confirmation is an unauthenticated message with an ephemeral key that will be used to authenticate Bob's commands to the queue, as described in SMP protocol, and Bob's info (profile, public key for E2E encryption, etc.). This message is encrypted using key passed in the connection request (or with the derived key, in which case public key for key derivation should be sent in clear text).
-  - Agent A receives the SMP confirmation containing Bob's key and info as SMP MSG.
-  - Agent A notifies Alice sending REQ notification with Bob's info.
-  - Alice accepts connection request with ACPT command.
-  - Agent A secures the queue with SMP KEY command.
-  - Agent B tries sending authenticated SMP SEND command with agent `HELLO` message until it succeeds. Once it succeeds, Bob's agent "knows" the queue is secured.
-6. Agent B creates a new SMP queue on the server.
-7. Establish Bob's SMP queue:
-  - Agent B sends `REPLY` message (SMP SEND command) with the connection request to this 2nd queue to Alice's agent (via the 1st queue) - this connection request SHOULD use "simplex" URI scheme.
-  - Agent A, having received `REPLY` message, sends unauthenticated message (SMP SEND) to SMP queue with Alice agent's ephemeral key that will be used to authenticate Alice's commands to the queue, as described in SMP protocol, and Alice's info.
-  - Bob's agent receives the key and Alice's information and secures the queue (SMP KEY).
-  - Bob's agent sends the notification `INFO` with Alice's information to Bob.
-  - Alice's agent keeps sending `HELLO` message until it succeeds.
-8. Agents A and B notify Alice and Bob that connection is established.
-  - Once sending `HELLO` succeeds, Alice's agent sends to Alice `CON` notification that confirms that now both parties can communicate.
-  - Once Bob's agent receives `HELLO` from Alice's agent, it sends to Bob `CON` notification as well.
+1. Alice requests the new connection from the SMP agent A using agent `createConnection` api function.
+2. Agent A creates an SMP queue on the server (using [SMP protocol](./simplex-messaging.md) `NEW` command) and responds to Alice with the invitation that contains queue information and the encryption keys Bob's agent B should use. The invitation format is described in [Connection link](connection-link-1-time-invitation-and-contact-address).
+3. Alice sends the [connection link](#connection-link-1-time-invitation-and-contact-address) to Bob via any secure channel (out-of-band message) - as a link or as a QR code.
+4. Bob uses agent `joinConnection` api function with the connection link as a parameter to agent B to accept the connection.
+5. Agent B creates Bob's SMP reply queue with SMP server `NEW` command.
+6. Agent B confirms the connection: sends an "SMP confirmation" with SMP server `SEND` command to the SMP queue specified in the connection link - SMP confirmation is an unauthenticated message with an ephemeral key that will be used to authenticate Bob's commands to the queue, as described in SMP protocol, and Bob's info (profile, public key for E2E encryption, and the connection link to this 2nd queue to Agent A - this connection link SHOULD use "simplex" URI scheme). This message is encrypted using key passed in the connection link (or with the derived shared secret, in which case public key for key derivation should be sent in clear text).
+6. Alice confirms and continues the connection:
+  - Agent A receives the SMP confirmation containing Bob's key, reply queue and info as SMP server `MSG`.
+  - Agent A notifies Alice sending `CONF` notification with Bob's info.
+  - Alice allows connection to continue with agent `allowConnection` api function.
+  - Agent A secures the queue with SMP server `KEY` command.
+  - Agent A sends SMP confirmation with ephemeral sender key, ephemeral public encryption key and profile (but without reply queue).
+7. Agent B confirms the connection:
+  - receives the confirmation.
+  - sends the notification `INFO` with Alice's information to Bob.
+  - secures SMP queue that it sent to Alice in the first confirmation with SMP `KEY` command .
+  - sends `HELLO` message via SMP `SEND` command. This confirms that the reply queue is secured and also validates that Agent A secured the first SMP queue
+8. Agent A notifies Alice.
+  - receives `HELLO` message from Agent B.
+  - sends `HELLO` message to Agent B via SMP `SEND` command.
+  - sends `CON` notification to Alice, confirming that the connection is established.
+9. Agent B notifies Bob.
+  - Once Agent B receives `HELLO` from Agent A, it sends to Bob `CON` notification as well.
 
 At this point the duplex connection between Alice and Bob is established, they can use `SEND` command to send messages. The diagram also shows how the connection status changes for both parties, where the first part is the status of the SMP queue to receive messages, and the second part - the status of the queue to send messages.
 
 The most communication happens between the agents and servers, from the point of view of Alice and Bob there are 4 steps (not including notifications):
 
-1. Alice requests a new connection with `NEW` command and receives the invitation.
-2. Alice passes connection request out-of-band to Bob.
-3. Bob accepts the connection with `JOIN` command with the connection request to his agent.
-4. Alice accepts the connection with `ACPT` command.
+1. Alice requests a new connection with `createConnection` agent API function and receives the connection link.
+2. Alice passes connection link out-of-band to Bob.
+3. Bob accepts the connection with `joinConnection` agent API function with the connection link to his agent.
+4. Alice accepts the connection with `ACPT` agent API function.
 5. Both parties receive `CON` notification once duplex connection is established.
 
 Clients SHOULD support establishing duplex connection asynchronously (when parties are intermittently offline) by persisting intermediate states and resuming SMP queue subscriptions.
 
+## Fast duplex connection procedure
+
+Previously described duplex connection procedure requires sending 4 messages creating a bad UX for the users - it requires waiting until each party in online before the messages can be sent.
+
+It allows users validating connecting party profile before proceeding with the connection, but it turned out to be unnecessary UX step and is not used in the client applications.
+
+It also protects against an attacker who compromised TLS and uses the sender queue ID sent to the recipient to secure the queue before the sender can. This attack is very hard, and this accepting its risk is better than worse UX. Future protocol versions could mitigate this attack by encrypting entity IDs.
+
+Faster duplex connection process is possible with the `SKEY` command added in v9 of SMP protocol.
+
+![Fast duplex connection procedure](./diagrams/duplex-messaging/duplex-creating-fast.svg)
+
+1. Alice requests the new connection from the SMP agent A using agent `createConnection` api function
+2. Agent A creates an SMP queue on the server (using [SMP protocol](./simplex-messaging.md) `NEW` command with the flag allowing the sender to secure the queue) and responds to Alice with the invitation that contains queue information and the encryption keys Bob's agent B should use. The invitation format is described in [Connection link](connection-link-1-time-invitation-and-contact-address).
+3. Alice sends the [connection link](connection-link-1-time-invitation-and-contact-address) to Bob via any secure channel (out-of-band message) - as a link or as a QR code. This link contains the flag that the queue can be secured by the sender.
+4. Bob uses agent `joinConnection` api function with the connection link as a parameter to agent B to accept the connection.
+5. Agent B secures Alice's queue with SMP command `SKEY` - this command can be proxied.
+6. Agent B creates Bob's SMP reply queue with SMP server `NEW` command (with the flag allowing the sender to secure the queue).
+7. Agent B confirms the connection: sends an "SMP confirmation" with SMP server `SEND` command to the SMP queue specified in the connection link - SMP confirmation is an unauthenticated message with an ephemeral key that will be used to authenticate Bob's commands to the queue, as described in SMP protocol, and Bob's info (profile, public key for E2E encryption, and the connection link to this 2nd queue to Agent A - this connection link SHOULD use "simplex" URI scheme). This message is encrypted using key passed in the connection link (or with the derived shared secret, in which case public key for key derivation should be sent in clear text).
+8. Alice confirms the connection:
+  - Agent A receives the SMP confirmation containing Bob's key, reply queue and info as SMP server `MSG`.
+  - Agent A notifies Alice sending `CONF` notification with Bob's info (that indicates that Agent B already secured the queue).
+  - Alice allows connection to continue with agent `allowConnection` api function.
+  - Agent A secures Bob's queue with SMP command `SKEY`.
+  - Agent A sends SMP confirmation with ephemeral public encryption key and profile (but without reply queue, and without sender key).
+9. Agent A notifies Alice with `CON` notification.
+10. Agent B notifies Bob about connection success:
+  - receives confirmation message from Alice.
+  - sends the notification `INFO` with Alice's information to Bob.
+  - sends `CON` notification to Bob.
+
+## Contact addresses
+
+SMP agents support creating a special type of connection - a contact address - that allows to connect to multiple network users who can send connection requests by sending 1-time connection links to the message queue. 
+
+This connection address uses a messaging queue on SMP server to receive invitations to connect - see `agentInvitation` message below. Once connection request is accepted, a new connection is created and the address itself is no longer used to send the messages - deleting this address does not disrupt the connections that were created via it.
+
 ## Communication between SMP agents
 
 To establish duplex connections and to send messages on behalf of their clients, SMP agents communicate via SMP servers.
 
 Agents use SMP message client body (the part of the SMP message after header - see [SMP protocol](./simplex-messaging.md)) to transmit agent client messages and exchange messages between each other.
 
-Each SMP message client body, once decrypted, contains 3 parts (one of them may include binary message body), as defined by `decryptedSmpMessageBody` syntax:
+These messages are encrypted with per-queue shared secret using NaCL crypto_box and can be of 4 types, as defined by `decryptedSMPClientMessage`:
+- `agentConfirmation` - used when confirming SMP queues, contains connection information encrypted with double ratchet. This envelope can only contain `agentConnInfo` or `agentConnInfoReply` encrypted with double ratchet.
+- `agentMsgEnvelope` - contains different agent messages encrypted with double ratchet, as defined in `agentMessage`.
+- `agentInvitation` - sent to SMP queue that is used as contact address, does not use double ratchet.
+- `agentRatchetKey` - used to re-negotiate double ratchet encryption - can contain additional information in `agentRatchetKey`.
 
+```abnf
+decryptedSMPClientMessage = agentConfirmation / agentMsgEnvelope / agentInvitation / agentRatchetKey
+agentConfirmation = agentVersion %s"C" ("0" / "1" sndE2EEncryptionParams) encConnInfo
+agentVersion = 2*2 OCTET
+sndE2EEncryptionParams = TODO
+encConnInfo = doubleRatchetEncryptedMessage
+
+agentMsgEnvelope = agentVersion %s"M" encAgentMessage
+encAgentMessage = doubleRatchetEncryptedMessage
+
+agentInvitation = agentVersion %s"I" connReqLength connReq connInfo
+connReqLength = 2*2 OCTET ; Word16
+
+agentRatchetKey = agentVersion %s"R" rcvE2EEncryptionParams agentRatchetInfo
+rcvE2EEncryptionParams = TODO
+
+doubleRatchetEncryptedMessage = TODO
+```
+
+This syntax of decrypted SMP client message body is defined by `decryptedAgentMessage` below.
+
+Decrypted SMP message client body can be one of 4 types:
+- `agentConnInfo` - used by the initiating party when confirming reply queue - sent in `agentConfirmation` envelope.
+- `agentConnInfoReply` - used by accepting party, includes reply queue(s) in the initial confirmation - sent in `agentConfirmation` envelope.
+- `agentRatchetInfo` - used to pass additional information when renegotiating double ratchet encryption - sent in `agentRatchetKey` envelope.
+- `agentMessage` - all other agent messages.
+
+`agentMessage` contains these parts:
 - `agentMsgHeader` - agent message header that contains sequential agent message ID for a particular SMP queue, agent timestamp (ISO8601) and the hash of the previous message.
-- `agentMessage` - a command/message to the other SMP agent:
-  - to establish the connection with two SMP queues (`helloMsg`, `replyQueueMsg`)
-  - to send and to acknowledge user messages (`clientMsg`, `acknowledgeMsg`)
-  - to manage SMP queue rotation (`newQueueMessage`, `deleteQueueMsg`)
-  - to manage encryption key rotation (TODO)
+- `aMessage` - a command/message to the other SMP agent:
+  - to confirm the connection (`HELLO`).
+  - to send and to confirm reception of user messages (`A_MSG`, `A_RCVD`).
+  - to confirm that the new double ratchet encryption is agreed (`EREADY`).
+  - to notify another party that it can continue sending messages after queue capacity was exceeded (`A_QCONT`).
+  - to manage SMP queue rotation (`QADD`, `QKEY`, `QUSE`, `QTEST`).
 - `msgPadding` - an optional message padding to make all SMP messages have constant size, to prevent servers from observing the actual message size. The only case the message padding can be absent is when the message has exactly the maximum size, in all other cases the message MUST be padded to a fixed size.
 
 ### Messages between SMP agents
@@ -130,269 +196,160 @@ Each SMP message client body, once decrypted, contains 3 parts (one of them may
 Message syntax below uses [ABNF][3] with [case-sensitive strings extension][4].
 
 ```abnf
-decryptedSmpMessageBody = agentMsgHeader CRLF agentMessage CRLF msgPadding
-agentMsgHeader = agentMsgId SP previousMsgHash ; here `agentMsgId` is sequential ID set by the sending agent
-agentMsgId = 1*DIGIT
-previousMsgHash = encoded
-encoded = <base64 encoded>
+decryptedAgentMessage = agentConnInfo / agentConnInfoReply / agentRatchetInfo / agentMessage
+agentConnInfo = %s"I" connInfo
+connInfo = *OCTET
+agentConnInfoReply = %s"D" smpQueues connInfo
+agentRatchetInfo = %s"R" ratchetInfo
 
-agentMessage = helloMsg / replyQueueMsg /
-               clientMsg / invitationMsg /
-               newQueueMessage / deleteQueueMsg 
+agentMessage = %s"M" agentMsgHeader aMessage msgPadding
+agentMsgHeader = agentMsgId prevMsgHash
+agentMsgId = 8*8 OCTET ; Int64
+prevMsgHash = shortString
 
-msgPadding = *OCTET ; optional random bytes to get messages to the same size (as defined in SMP message size)
+aMessage = HELLO / A_MSG / A_RCVD / EREADY / A_QCONT /
+           QADD / QKEY / QUSE / QTEST
 
-helloMsg = %s"H"
+HELLO = %s"H"
 
-replyQueueMsg = %s"R" connectionRequest ; `connectionRequest` is defined below
-; this message can only be sent by the second connection party
+A_MSG = %s"M" userMsgBody
+userMsgBody = *OCTET
 
-clientMsg = %s"M" clientMsgBody
-clientMsgBody = *OCTET
+A_RCVD = %s"V" msgReceipt
+msgReceipt = agentMsgId msgHash rcptLength rcptInfo
 
-; TODO remove and move to "public" header
-invitationMsg = %s"INV" SP connReqInvitation SP connInfo
-; `connReqInvitation` and `connInfo` are defined below
+EREADY = %s"E" agentMsgId
 
-newQueueMsg = %s"N" queueURI
-; this message can be sent by any party to add SMP queue to the connection.
-; NOT SUPPORTED in the current implementation
+A_QCONT = %s"QC" sndQueueAddr
 
-deleteQueueMsg = %s"D" queueURI
-; notification that the queue with passed URI will be deleted
-; no need to notify the other party about suspending queue separately, as suspended and deleted queues are indistinguishable to the sender
-; NOT SUPPORTED in the current implementation
+QADD = %s"QA" sndQueues
+sndQueues = length 1*(newQueueUri replacedSndQueue)
+newQueueUri = clientVRange smpServer senderId dhPublicKey [sndSecure]
+dhPublicKey = length x509encoded
+sndSecure = "T"
+replacedSndQueue = "0" / "1" sndQueueAddr
+
+QKEY = %s"QK" sndQueueKeys
+sndQueueKeys = length 1*(newQueueInfo senderKey)
+newQueueInfo = version smpServer senderId dhPublicKey [sndSecure]
+senderKey = length x509encoded
+
+QUSE = %s"QU" sndQueuesReady
+sndQueuesReady = length 1*(sndQueueAddr primary)
+primary = %s"T" / %s"F"
+
+QTEST = %s"QT" sndQueueAddrs
+sndQueueAddrs = length 1*sndQueueAddr
+
+sndQueueAddr = smpServer senderId
+smpServer = hosts port keyHash
+hosts = length 1*host
+host = shortString
+port = shortString
+keyHash = shortString
+senderId = shortString
+
+clientVRange = version version
+version = 2*2 OCTET
+
+msgPadding = *OCTET
+rcptLength = 2*2 OCTET
+shortString = length *OCTET
+length = 1*1 OCTET
 ```
 
 #### HELLO message
 
-This is the first message that both agents send after the respective SMP queue is secured by the receiving agent (see diagram). It MAY contain the public key that the recipient would use to verify messages signed by the sender.
+This is the first message that both agents send after the respective SMP queue is secured by the receiving agent (see diagram).
 
-Sending agent might need to retry sending HELLO message, as it would not have any other confirmation that the queue is secured other than the success of sending this message with the signed SMP SEND command.
+This message is not used with [fast duplex connection](#fast-duplex-connection-procedure).
 
-#### REPLY message
+#### A_MSG message
 
-This is the message that is sent by the agent that received an out-of-band connection request to pass the connection request for the reply SMP queues to the agent that originated the connection (see diagram).
+This is the agent envelope used to send client messages once the connection is established. This is different from the MSG sent by SMP server to the agent and MSG event from SMP agent to the client that are sent in different contexts.
 
-#### MSG message
+#### A_RCVD message
 
-This is the agent envelope used to send client messages once the connection is established. Do not confuse it with the MSG response from SMP server to the agent and MSG response from SMP agent to the client that are sent in different contexts.
+This message is sent to confirm the client message reception. It includes received message number and message hash.
 
-#### INV message
+#### EREADY message
 
-This message is sent to the SMP queue(s) in `connReqContact`, to establish a new connection via existing unsecured queue, that acts as a permanent connection link of a user.
+This message is sent after re-negotiating a new double ratchet encryption with `agentRatchetKey`.
 
-#### ACK message
+#### A_QCONT message
 
-This message is sent to confirm the client message reception. It includes received message number, message hash and the reception status.
+This message is sent to notify the sender client that it can continue sending the messages after queue capacity was exhausted.
 
-#### NEW message
+### Rotating messaging queue
 
-This message is sent to add an additional SMP queue to the connection. Unlike REPLY message it can be sent at any time.
+SMP agents SHOULD support 4 messages to rotate message reception to another messaging server:
+`QADD`: add the new queue address(es) to the connection - sent by the client that initiates rotation.
+`QKEY`: pass sender's key via existing connection (SMP confirmation message will not be used, to avoid the same "race" of the initial key exchange that would create the risk of intercepting the queue for the attacker) - sent by the client accepting the rotation
+`QUSE`: instruct the sender to use the new queue with sender's queue ID as parameter. From this point some messages can be sent to both the new queue and the old queue.
+`QTEST`: send test message to the new connection. Any other message can be sent if available to continue rotation, the absence of this message is not an error. Once this message is successfully sent the sender will stop using the old queue. Once this message (or any other message in the new queue) is received, the recipient will stop using the old queue and delete it.
 
-#### DEL message 
+**Queue rotation procedure**
 
-This message is sent to notify that the queue with passed URI will be deleted - having received this message, the receiving agent should no longer send messages to this queue. In case it was the last remaining send queue in the duplex connection, the agent MAY also delete the reply queue(s) in the connection.
+![Queue rotation procedure](./diagrams/duplex-messaging/queue-rotation.svg)
 
-## SMP agent commands
+`SKEY` command added in v9 of SMP protocol allows for faster queue rotation procedure.
 
-This part describes the transmissions between users and client-side SMP agents: commands that the users send to create and operate duplex connections and SMP agent responses and messages they deliver.
+**Fast queue rotation procedure**
 
-Commands syntax below is provided using [ABNF][3] with [case-sensitive strings extension][4].
+![Fast queue rotation procedure](./diagrams/duplex-messaging/queue-rotation-fast.svg)
 
-Each transmission between the user and SMP agent must have this format/syntax:
+## End-to-end encryption
 
-```abnf
-agentTransmission = [corrId] CRLF [connId] CRLF agentCommand
+Messages between SMP agents have two layers of e2e encryption:
+- simple encryption agreed in SMP protocol with a fixed key agreed when the messaging queue is agreed by parties.
+- post-quantum resistant augmented double ratchet algorithm (PQDR) specified in [this document](./pqdr.md).
 
-corrId = 1*(%x21-7F) ; any characters other than control/whitespace
+The protocol supports adding and removing post-quantum KEM primitive to the key agreement in double ratchet:
+- to support migration of pre-existing connections to PQDR.
+- to be able to disable PQ key agreement.
+- to be able to use invitation links and contact addresses without large PQ keys.
 
-connId = encoded
+Possible scenarios below show the possible states of PQ key agreement, assuming that both clients support it.
 
-agentCommand = (userCmd / agentMsg) CRLF
-userCmd = newCmd / joinCmd / letCmd / acceptCmd / subscribeCmd / sendCmd / acknowledgeCmd / suspendCmd / deleteCmd
-agentMsg = invitation / confMsg / connReqMsg / connInfo / connected / unsubscribed / connDown / connUp / messageId / sent / messageError / message / received / ok / error
+Possible options for each stage are:
+- no KEM encapsulation key was sent (No PQ key),
+- only KEM encapsulation key was sent, but not ciphertext yet (PQ key sent),
+- both KEM encapsulation key from one KEM agreement and ciphertext from the previous agreement were sent (PQ key + PQ ct sent).
 
-newCmd = %s"NEW" SP connectionMode [SP %s"NO_ACK"] ; response is `invitation` or `error`
-; NO_ACK parameter currently not supported
+`+` in the table means that this scenario is possible, and `-` - that it is not possible.
 
-connectionMode = %s"INV" / %s"CON"
+| Connection stage                                       | No PQ key        | PQ key sent      | PQ key + PQ ct sent |
+|:------------------------------------------------------:|:----------------:|:----------------:|:-------------------:|
+| invitation                                             |         +        |         +        |          -          |
+| confirmation, in reply to: <br>no-pq inv <br>pq inv    | &nbsp;<br>+<br>+ | &nbsp;<br>+<br>- | &nbsp;<br>-<br>+    |
+| 1st msg, in reply to: <br>no-pq conf <br>pq/pq+ct conf | &nbsp;<br>+<br>+ | &nbsp;<br>+<br>- | &nbsp;<br>-<br>+    |
+| Nth msg, in reply to: <br>no-pq msg <br>pq/pq+ct msg   | &nbsp;<br>+<br>+ | &nbsp;<br>+<br>- | &nbsp;<br>-<br>+    |
 
-invitation = %s"INV" SP connectionRequest ; `connectionRequest` is defined below
+These scenarios can be reduced to:
+1. initial invitation optionally has PQ key, but must not have ciphertext.
+2. all subsequent messages should be allowed without PQ key/ciphertext, but:
+  - if the previous message had PQ key or PQ key with ciphertext, they must either have no PQ key, or have PQ key with ciphertext (PQ key without ciphertext is an error).
+  - if the previous message had no PQ key, they must either have no PQ key, or have PQ key without ciphertext (PQ key with ciphertext is an error).
 
-confMsg = %s"CONF" SP confirmationId SP msgBody
-; msgBody here is any binary information identifying connection request
+The rules for calculating the shared secret for received/sent messages are (assuming received message is valid according to the above rules):
 
-letCmd = %s"LET" SP confirmationId SP msgBody
-; msgBody here is any binary information identifying connecting party
+|  sent msg > <br>V received msg | no-pq       | pq      | pq+ct           |
+|:------------------------------:|:-----------:|:-------:|:---------------:|
+| no-pq                          | DH / DH     | DH / DH | err             |
+| pq (sent msg was NOT pq)       | DH / DH     | err     | DH / DH+KEM     |
+| pq+ct (sent msg was NOT no-pq) | DH+KEM / DH | err     | DH+KEM / DH+KEM |
 
-confirmationId = 1*DIGIT
+To summarize, the upgrade to DH+KEM secret happens in a sent message that has PQ key with ciphertext sent in reply to message with PQ key only (without ciphertext), and the downgrade to DH secret happens in the message that has no PQ key.
 
-connReqMsg = %s"REQ" SP invitationId SP msgBody
-; msgBody here is any binary information identifying connection request
+## Connection link: 1-time invitation and contact address
 
-acceptCmd = %s"ACPT" SP invitationId SP msgBody
-; msgBody here is any binary information identifying connecting party
+Connection links are generated by SMP agent in response to `createConnection` api call, used by another party user with `joinConnection` api, and then another connection link is sent by the agent in `agentConnInfoReply` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users).
 
-invitationId = 1*DIGIT
-
-connInfo = %s"INFO" SP msgBody
-; msgBody here is any binary information identifying connecting party
-
-connected = %s"CON"
-
-subscribeCmd = %s"SUB" ; response is `ok` or `error`
-
-unsubscribed = %s"END"
-; when another agent (or another client of the same agent)
-; subscribes to the same SMP queue on the server
-
-connDown = %s"DOWN"
-; lost connection (e.g. because of Internet connectivity or server is down)
-
-connUp = %s"UP"
-; restored connection
-
-joinCmd = %s"JOIN" SP connectionRequest SP connInfo [SP %s"NO_REPLY"] [SP %s"NO_ACK"]
-; `connectionRequest` and `connInfo` are defined below
-; response is `connected` or `error`
-; parameters NO_REPLY and NO_ACK are currently not supported
-
-suspendCmd = %s"OFF" ; can be sent by either party, response `ok` or `error`
-
-deleteCmd = %s"DEL" ; can be sent by either party, response `ok` or `error`
-
-sendCmd = %s"SEND" SP msgBody
-; send syntax is similar to that of SMP protocol, but it is wrapped in SMP message
-msgBody = stringMsg | binaryMsg
-stringMsg = ":" string ; until CRLF in the transmission
-string = *(%x01-09 / %x0B-0C / %x0E-FF %) ; any characters other than NUL, CR and LF
-binaryMsg = size CRLF msgBody CRLF ; the last CRLF is in addition to CRLF in the transmission
-size = 1*DIGIT ; size in bytes
-msgBody = *OCTET ; any content of specified size - safe for binary
-
-messageId = %s"MID" SP agentMsgId
-
-sent = %s"SENT" SP agentMsgId
-
-messageError = %s"MERR" SP agentMsgId SP <errorType>
-
-message = %s"MSG" SP msgIntegrity SP recipientMeta SP brokerMeta SP senderMeta SP binaryMsg
-recipientMeta = %s"R=" agentMsgId "," agentTimestamp ; receiving agent message metadata 
-brokerMeta = %s"B=" brokerMsgId "," brokerTimestamp ; broker (server) message metadata
-senderMeta = %s"S=" agentMsgId ; sending agent message ID 
-brokerMsgId = encoded
-brokerTimestamp = <date-time>
-msgIntegrity = ok / msgIntegrityError
-
-msgIntegrityError = %s"ERR" SP msgIntegrityErrorType
-msgIntegrityErrorType = skippedMsgErr / badMsgIdErr / badHashErr
-
-skippedMsgErr = %s"NO_ID" SP missingFromMsgId SP missingToMsgId
-badMsgIdErr = %s"ID" SP previousMsgId ; ID is lower than the previous
-badHashErr = %s"HASH"
-
-missingFromMsgId = agentMsgId
-missingToMsgId = agentMsgId
-previousMsgId = agentMsgId
-
-acknowledgeCmd = %s"ACK" SP agentMsgId ; ID assigned by receiving agent (in MSG "R")
-
-received = %s"RCVD" SP agentMsgId SP msgIntegrity
-; ID assigned by sending agent (in SENT response)
-; currently not implemented
-
-msgStatus = ok | error
-
-ok = %s"OK"
-
-error = %s"ERR" SP <errorType>
-```
-
-### Client commands and server responses
-
-#### NEW command and INV response
-
-`NEW` command is used to create a connection and a connection request to be sent out-of-band to another protocol user (the joining party). It should be used by the client of the agent that initiates creating a duplex connection (the initiating party).
-
-`INV` response is sent by the agent to the client of the initiating party.
-
-`NEW` command has `connectionMode` parameter to define the connection mode - to be used to communicate with a single contact (invitation mode, `connectionMode` is `INV`) or to accept connection requests from anybody (contact mode, `connectionMode` is `CON`). The type of connection request is determined by `connectionMode` parameter.
-
-#### JOIN command
-
-It is used to create a connection and accept the connection request received out-of-band. It should be used by the client of the agent that accepts the connection (the joining party).
-
-#### CONF notification and LET command
-
-When the joining party uses `JOIN` command to accept connection invitation created with `NEW INV` command, the initiating party will receive `CONF` notification with some numeric identifier and an additional binary information, that can be used to identify the joining party or for any other purpose.
-
-To continue with the connection the initiating party should use `LET` command.
-
-#### REQ notification and ACPT command
-
-When the joining party uses `JOIN` command to connect to the contact created with `NEW CON` command, the initiating party will receive `REQ` notification with some numeric identifier and an additional binary information, that can be used to identify the joining party or for any other purpose.
-
-To continue with the connection the party that created the contact should use `ACPT` command.
-
-#### INFO and CON notifications
-
-After the initiating party proceeds with the connection using `ACPT` command, the joining party will receive `INFO` notification that can be used to identify the initiating party or for any other purpose.
-
-Once the connection is established and ready to accept client messages, both agents will send `CON` notification to their clients.
-
-#### SUB command
-
-This command can be used by the client to resume receiving messages from the connection that was created in another TCP/client session. Agent response to this command can be `OK` or `ERR` in case connection does not exist (or can only be used to send connections - e.g. when the reply queue was not created).
-
-#### SEND command and MID, SENT, RCVD and MERR responses
-
-`SEND` command is used by the client to send messages.
-
-`MID` response with the message ID (the sequential message number that includes both sent and received messages in the connection) is sent to the client to confirm that the message is accepted by the agent, before it is sent to the SMP server.
-
-`SENT` notification is sent by the agent to confirm that the message was delivered to at least one of SMP servers. This notification contains the same message ID as `MID` notification. `SENT` notification, depending on network availability, can be sent at any time later, potentially in the next client session.
-
-`RCVD` notification is sent by the agent when it receives `ACK` message from the receiving agent. This notification contains reception status, only one successful notification will be sent, and multiple error notifications will be sent in case `ACK` had error status.
-
-In case of the failure to send the message for any other reason than network connection or message queue quota - e.g. authentication error (`ERR AUTH`) or syntax error (`ERR CMD error`), the agent will send to the client `MERR` notification with the message ID, and this message delivery will no longer be attempted to this SMP queue.
-
-#### MSG notification
-
-It is sent by the agent to the client when agent receives the message from the SMP server. It has message ID and timestamp from both the receiving and sending agents and from SMP server:
-- recipient agent ID is intended to be used to refer to the message in the future.
-- sender agent ID is intended to be used to identify any missed / skipped message(s)
-- broker ID should be used to detect duplicate deliveries (it would happen if TCP connection is lost before the message is acknowledged by the agent - see [SMP protocol](./simplex-messaging.md))
-
-#### END notification
-
-It is sent by the agent to the client when agent receives SMP protocol `END` notification from SMP server. It indicates that another agent has subscribed to the same SMP queue on the server and the server terminated the subscription of the current agent.
-
-#### DOWN and UP notifications
-
-These notifications are sent when server or network connection is, respectively, `DOWN` or back `UP`.
-
-All the subscriptions made in the current client session will be automatically resumed when `UP` notification is received.
-
-#### OFF command
-
-It is used to suspend the receiving SMP queue - sender will no longer be able to send the messages to the connection, but the recipient can retrieve the remaining messages. Agent response to this command can be `OK` or `ERR`. This command is irreversible.
-
-#### DEL command
-
-It is used to delete the connection and all messages in it, as well as the receiving SMP queue and all messages in it that were remaining on the server. Agent response to this command can be `OK` or `ERR`. This command is irreversible.
-
-## Connection request
-
-Connection request `connectionRequest` is generated by SMP agent in response to `newCmd` command (`"NEW"`), used by another party user with `joinCmd` command (`"JOIN"`), and then another connection request is sent by the agent in `replyQueueMsg` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users).
-
-Connection request syntax:
+Connection link syntax:
 
 ```
-connectionRequest = connectionScheme "/" connReqType "#/?smp=" smpQueues "&e2e=" e2eEncryption
-connReqType = %s"invitation" / %s"contact"
-; this parameter has the same meaning as connectionMode in agent commands
-; `NEW INV` creates `invitation` connection request, `NEW CON` - `contact`
+connectionLink = connectionScheme "/" connLinkType "#/?smp=" smpQueues "&e2e=" e2eEncryption
+connLinkType = %s"invitation" / %s"contact"
 connectionScheme = (%s"https://" clientAppServer) | %s"simplex:"
 clientAppServer = hostname [ ":" port ]
 ; client app server, e.g. simplex.chat
@@ -407,12 +364,112 @@ smpQueue = <URL-encoded queueURI defined in SMP protocol>
 
 All parameters are passed via URI hash to avoid sending them to the server (in case "https" scheme is used) - they can be used by the client-side code and processed by the client application. Parameters `smp` and `e2e` can be present in any order, any unknown additional parameters SHOULD be ignored.
 
-`clientAppServer` is not an SMP server - it is a server that shows the instruction on how to download the client app that will connect using this connection request. This server can also host a mobile or desktop app manifest so that this link is opened directly in the app if it is installed on the device.
+`clientAppServer` is not an SMP server - it is a server that shows the instruction on how to download the client app that will connect using this connection link. This server can also host a mobile or desktop app manifest so that this link is opened directly in the app if it is installed on the device.
 
 "simplex" URI scheme in `connectionProtocol` can be used instead of client app server, to connect without creating any web traffic. Client apps MUST support this URI scheme.
 
 See SMP protocol [out-of-band messages](./simplex-messaging.md#out-of-band-messages) for syntax of `queueURI`.
 
+## Appendix A: SMP agent API
+
+The exact specification of agent library API and of the events that the agent sends to the client application is out of scope of the protocol specification.
+
+The list of some of the API functions and events below is supported by the reference implementation, and they are likely to be required by the client applications.
+
+### API functions
+
+The list of APIs below is not exhaustive and provided for information only. Please consult the source code for more information.
+
+#### Create conection
+
+`createConnection` api is used to create a connection - it returns the connection link that should be sent out-of-band to another protocol user (the joining party). It should be used by the client of the agent that initiates creating a duplex connection (the initiating party).
+
+This api is also used to create a contact address - a special connection that can be used by multiple people to connect to the user.
+
+Some communication scenarios may require fault-tolerant mechanism of creating connections that retries on network failures and continue retrying after the client is restarted. Such asynchronous API would return its result via `INV` event once it succeeds.
+
+#### Join connection
+
+`joinConnection` is used to create a connection record and accept the connection invitation received out-of-band. It should be used by the client of the agent that accepts the connection (the joining party).
+
+This api can also be required as asynchronous, in which case `OK` event will be dispatched to the client to indicate the success or `ERR` in case it permanently failed (e.g., in case connection was deleted by another party).
+
+#### Allow connection
+
+Once the client receives `CONF` event, it should use synchronous `allowConnection` api to proceed with the connection (both for the [standard](#duplex-connection-procedure) and for the [fast duplex procedure](#fast-duplex-connection-procedure)).
+
+In case this API is used as asynchronous it will return its result via `OK` or `ERR` event.
+
+#### Accept and reject connection requests
+
+Connection requests are delivered to the client application via `REQ` event.
+
+Client can `acceptContact` and `rejectContact`, with `OK` and `ERR` events in case of asynchronous calls.
+
+#### Send message
+
+`sendMessage` api is always asynchronous. The api call returns message ID, `SENT` event once the message is sent to the server, `MWARN` event in case of temporary delivery failure that can be resolved by the user (e.g., by connecting via Tor or by upgrading the client) and `MERR` in case of permanent delivery failure.
+
+#### Acknowledge received message
+
+Messages are delivered to the client application via `MSG` event.
+
+Client application must always `ackMessage` to receive the next one - failure to call it in reference implementation will prevent the delivery of subsequent messages until the client reconnects to the server.
+
+This api is also used to acknowledge message delivery to the sending party - that party client application will receive `RCVD` event.
+
+#### Subscribe connection
+
+`subscribeConnection` api is used by the client to resume receiving messages from the connection that was created in another TCP/client session.
+
+#### Get notification message
+
+`getNotificationMessage` is used by push notification subsystem of the client application to receive the message from a specific messaging queue mentioned in the notification. The client application would receive `MSG` and any other events from the agent, and then `MSGNTF` event once the message related to this notification is received.
+
+#### Rotate message queue to another server
+
+`switchConnection` api is used to rotate connection queues to another messaging server.
+
+#### Renegotiate e2e encryption
+
+`synchronizeRatchet` api is used to re-negotiate double ratchet encryption for the connection.
+
+#### Delete connection
+
+`deleteConnection` api is used to delete connection. In case of asynchronous call, the connection deletion will be confirmed with `DEL_RCVQ` and `DEL_CONN` events.
+
+#### Suspend connection
+
+`suspendConnection` api is used to prevent any further messages delivered to the connection without deleting it.
+
+### API events
+
+Agent API uses these events dispatch to notify client application about events related to the connections:
+- `INV` - connection invitation or connection address URI after connection is created.
+- `CONF` - confirmation that connection is accepted by another party. When the accepting party uses `joinConnection` api to accept connection invitation, the initiating party will receive `CONF` notification with some identifier and additional information from the accepting party (e.g., profile). To continue the connection the initiating party client should use `allowConnection` api.
+- `REQ` - connection request is sent when another party uses `joinConnection` api with contact address. The client application can use `acceptContact` or `rejectContact` api.
+- `INFO` - information from the party that initiated the connection with `createConnection` sent to the party accepting the connection with `joinConnection`.
+- `CON` - notification that connection is established sent to both parties of the connection.
+- `END` - notification that connection subscription is terminated when another client subscribed to the same messaging queue.  
+- `DOWN` - notification that connection server is temporarily unavailable.
+- `UP` - notification that the subscriptions made in the current client session are resumed after the server became available.
+- `SWITCH` - notification about queue rotation process.
+- `RSYNC` - notification about e2e encryption re-negotiation process.
+- `SENT` - notification to confirm that the message was delivered to at least one of SMP servers. This notification contains the same message ID as returned to `sendMessage` api. `SENT` notification, depending on network availability, can be sent at any time later, potentially in the next client session.
+- `MWARN` - temporary delivery failure that can be resolved by the user (e.g., by connecting via Tor or by upgrading the client).
+- `MERR` - notification about permanent message delivery failure.
+- `MERRS` - notification about permanent message delivery failure for multiple messages (e.g., when multiple messages expire).
+- `MSG` - sent when agent receives the message from the SMP server.
+- `MSGNTF` - sent after agent received and processed the message referenced in the push notification.
+- `RCVD` - notification confirming message receipt by another party.
+- `QCONT` - notification that the agent continued sending messages after queue capacity was exceeded and recipient received all messages.
+- `DEL_RCVQ` - confirmation that message queue was deleted.
+- `DEL_CONN` - confirmation that connection was deleted.
+- `OK` - confirmation that asynchronous api call was successful.
+- `ERR` - error of asynchronous api call or some other error event.
+
+This list of events is not exhaustive and provided for information only. Please consult the source code for more information.
+
 [1]: https://en.wikipedia.org/wiki/End-to-end_encryption
 [2]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack
 [3]: https://tools.ietf.org/html/rfc5234
diff --git a/protocol/diagrams/duplex-messaging/duplex-creating-fast.mmd b/protocol/diagrams/duplex-messaging/duplex-creating-fast.mmd
new file mode 100644
index 000000000..674cc502f
--- /dev/null
+++ b/protocol/diagrams/duplex-messaging/duplex-creating-fast.mmd
@@ -0,0 +1,65 @@
+sequenceDiagram
+  participant A as Alice
+  participant AA as Alice's<br>agent
+  participant AS as Alice's<br>server
+  participant BS as Bob's<br>server
+  participant BA as Bob's<br>agent
+  participant B as Bob
+
+  note over AA, BA: status (receive/send): NONE/NONE
+
+  note over A, AA: 1. request connection<br>from agent
+  A ->> AA: createConnection
+ 
+  note over AA, AS: 2. create Alice's SMP queue
+  AA ->> AS: NEW: create SMP queue<br>allow sender to secure
+  AS ->> AA: IDS: SMP queue IDs
+  note over AA: status: NEW/NONE
+
+  AA ->> A: INV: invitation<br>to connect
+
+  note over A, B: 3. out-of-band invitation
+  A ->> B: OOB: invitation to connect
+
+  note over BA, B: 4. accept connection
+  B ->> BA: joinConnection:<br>via invitation info
+  note over BA: status: NONE/NEW
+
+  note over BA, AS: 5. secure Alice's SMP queue
+  BA ->> AS: SKEY: secure queue (this command needs to be proxied)
+  note over BA: status: NONE/SECURED
+
+  note over BA, BS: 6. create Bob's SMP queue
+  BA ->> BS: NEW: create SMP queue<br>allow sender to secure
+  BS ->> BA: IDS: SMP queue IDs
+  note over BA: status: NEW/SECURED
+
+  note over BA, AA: 7. confirm Alice's SMP queue
+  BA ->> AS: SEND: Bob's info without sender's key (SMP confirmation with reply queues)
+  note over BA: status: NEW/CONFIRMED
+
+  AS ->> AA: MSG: Bob's info without<br>sender server key
+  note over AA: status: CONFIRMED/NEW
+  AA ->> AS: ACK: confirm message
+  AA ->> A: CONF: connection request ID<br>and Bob's info
+  A -> AA: allowConnection: accept connection request,<br>send Alice's info
+  
+  note over AA, BS: 8. secure Bob's SMP queue
+  AA ->> BS: SKEY: secure queue (this command needs to be proxied)
+  note over BA: status: CONFIRMED/SECURED
+
+  AA ->> BS: SEND: Alice's info without sender's server key (SMP confirmation without reply queues)
+  note over AA: status: CONFIRMED/CONFIRMED
+
+  note over AA, A: 9. notify Alice<br>about connection success<br>(no HELLO needed in v6)
+  AA ->> A: CON: connected
+  note over AA: status: ACTIVE/ACTIVE
+
+  note over BA, B: 10. notify Bob<br>about connection success
+  BS ->> BA: MSG: Alice's info without<br>sender's server key
+  note over BA: status: CONFIRMED/CONFIRMED
+  BA ->> B: INFO: Alice's info
+  BA ->> BS: ACK: confirm message
+
+  BA ->> B: CON: connected
+  note over BA: status: ACTIVE/ACTIVE
diff --git a/protocol/diagrams/duplex-messaging/duplex-creating-fast.svg b/protocol/diagrams/duplex-messaging/duplex-creating-fast.svg
new file mode 100644
index 000000000..bea3bb23d
--- /dev/null
+++ b/protocol/diagrams/duplex-messaging/duplex-creating-fast.svg
@@ -0,0 +1,3 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<?xml-stylesheet href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.2/css/all.min.css" type="text/css"?>
+<svg aria-roledescription="sequence" role="graphics-document document" viewBox="-50 -10 1546 2482" style="max-width: 100%;" xmlns="http://www.w3.org/2000/svg" width="100%" id="graph-div" height="100%" xmlns:xlink="http://www.w3.org/1999/xlink"><g><rect class="actor actor-bottom" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="1296"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="1371"><tspan dy="0" x="1371">Bob</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="BA" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="1096"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="1171"><tspan dy="-8" x="1171">Bob's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="1171"><tspan dy="8" x="1171">agent</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="BS" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="845"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="920"><tspan dy="-8" x="920">Bob's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="920"><tspan dy="8" x="920">server</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="AS" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="645"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="720"><tspan dy="-8" x="720">Alice's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="720"><tspan dy="8" x="720">server</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="AA" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="397"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="472"><tspan dy="-8" x="472">Alice's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="472"><tspan dy="8" x="472">agent</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="75"><tspan dy="0" x="75">Alice</tspan></text></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="1371" y1="5" x1="1371" id="actor1777"></line><g id="root-1777"><rect class="actor actor-top" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="1296"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="1371"><tspan dy="0" x="1371">Bob</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="1171" y1="5" x1="1171" id="actor1776"></line><g id="root-1776"><rect class="actor actor-top" ry="3" rx="3" name="BA" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="1096"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="1171"><tspan dy="-8" x="1171">Bob's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="1171"><tspan dy="8" x="1171">agent</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="920" y1="5" x1="920" id="actor1775"></line><g id="root-1775"><rect class="actor actor-top" ry="3" rx="3" name="BS" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="845"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="920"><tspan dy="-8" x="920">Bob's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="920"><tspan dy="8" x="920">server</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="720" y1="5" x1="720" id="actor1774"></line><g id="root-1774"><rect class="actor actor-top" ry="3" rx="3" name="AS" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="645"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="720"><tspan dy="-8" x="720">Alice's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="720"><tspan dy="8" x="720">server</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="472" y1="5" x1="472" id="actor1773"></line><g id="root-1773"><rect class="actor actor-top" ry="3" rx="3" name="AA" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="397"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="472"><tspan dy="-8" x="472">Alice's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="472"><tspan dy="8" x="472">agent</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="75" y1="5" x1="75" id="actor1772"></line><g id="root-1772"><rect class="actor actor-top" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="75"><tspan dy="0" x="75">Alice</tspan></text></g></g><style>#graph-div{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#graph-div .error-icon{fill:#552222;}#graph-div .error-text{fill:#552222;stroke:#552222;}#graph-div .edge-thickness-normal{stroke-width:2px;}#graph-div .edge-thickness-thick{stroke-width:3.5px;}#graph-div .edge-pattern-solid{stroke-dasharray:0;}#graph-div .edge-pattern-dashed{stroke-dasharray:3;}#graph-div .edge-pattern-dotted{stroke-dasharray:2;}#graph-div .marker{fill:#333333;stroke:#333333;}#graph-div .marker.cross{stroke:#333333;}#graph-div svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#graph-div .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div text.actor&gt;tspan{fill:black;stroke:none;}#graph-div .actor-line{stroke:grey;}#graph-div .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#graph-div .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#graph-div #arrowhead path{fill:#333;stroke:#333;}#graph-div .sequenceNumber{fill:white;}#graph-div #sequencenumber{fill:#333;}#graph-div #crosshead path{fill:#333;stroke:#333;}#graph-div .messageText{fill:#333;stroke:none;}#graph-div .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .labelText,#graph-div .labelText&gt;tspan{fill:black;stroke:none;}#graph-div .loopText,#graph-div .loopText&gt;tspan{fill:black;stroke:none;}#graph-div .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#graph-div .note{stroke:#aaaa33;fill:#fff5ad;}#graph-div .noteText,#graph-div .noteText&gt;tspan{fill:black;stroke:none;}#graph-div .activation0{fill:#f4f4f4;stroke:#666;}#graph-div .activation1{fill:#f4f4f4;stroke:#666;}#graph-div .activation2{fill:#f4f4f4;stroke:#666;}#graph-div .actorPopupMenu{position:absolute;}#graph-div .actorPopupMenuPanel{position:absolute;fill:#ECECFF;box-shadow:0px 8px 16px 0px rgba(0,0,0,0.2);filter:drop-shadow(3px 5px 2px rgb(0 0 0 / 0.4));}#graph-div .actor-man line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .actor-man circle,#graph-div line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;stroke-width:2px;}#graph-div :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g></g><defs><symbol height="24" width="24" id="computer"><path d="M2 2v13h20v-13h-20zm18 11h-16v-9h16v9zm-10.228 6l.466-1h3.524l.467 1h-4.457zm14.228 3h-24l2-6h2.104l-1.33 4h18.45l-1.297-4h2.073l2 6zm-5-10h-14v-7h14v7z" transform="scale(.5)"></path></symbol></defs><defs><symbol clip-rule="evenodd" fill-rule="evenodd" id="database"><path d="M12.258.001l.256.004.255.005.253.008.251.01.249.012.247.015.246.016.242.019.241.02.239.023.236.024.233.027.231.028.229.031.225.032.223.034.22.036.217.038.214.04.211.041.208.043.205.045.201.046.198.048.194.05.191.051.187.053.183.054.18.056.175.057.172.059.168.06.163.061.16.063.155.064.15.066.074.033.073.033.071.034.07.034.069.035.068.035.067.035.066.035.064.036.064.036.062.036.06.036.06.037.058.037.058.037.055.038.055.038.053.038.052.038.051.039.05.039.048.039.047.039.045.04.044.04.043.04.041.04.04.041.039.041.037.041.036.041.034.041.033.042.032.042.03.042.029.042.027.042.026.043.024.043.023.043.021.043.02.043.018.044.017.043.015.044.013.044.012.044.011.045.009.044.007.045.006.045.004.045.002.045.001.045v17l-.001.045-.002.045-.004.045-.006.045-.007.045-.009.044-.011.045-.012.044-.013.044-.015.044-.017.043-.018.044-.02.043-.021.043-.023.043-.024.043-.026.043-.027.042-.029.042-.03.042-.032.042-.033.042-.034.041-.036.041-.037.041-.039.041-.04.041-.041.04-.043.04-.044.04-.045.04-.047.039-.048.039-.05.039-.051.039-.052.038-.053.038-.055.038-.055.038-.058.037-.058.037-.06.037-.06.036-.062.036-.064.036-.064.036-.066.035-.067.035-.068.035-.069.035-.07.034-.071.034-.073.033-.074.033-.15.066-.155.064-.16.063-.163.061-.168.06-.172.059-.175.057-.18.056-.183.054-.187.053-.191.051-.194.05-.198.048-.201.046-.205.045-.208.043-.211.041-.214.04-.217.038-.22.036-.223.034-.225.032-.229.031-.231.028-.233.027-.236.024-.239.023-.241.02-.242.019-.246.016-.247.015-.249.012-.251.01-.253.008-.255.005-.256.004-.258.001-.258-.001-.256-.004-.255-.005-.253-.008-.251-.01-.249-.012-.247-.015-.245-.016-.243-.019-.241-.02-.238-.023-.236-.024-.234-.027-.231-.028-.228-.031-.226-.032-.223-.034-.22-.036-.217-.038-.214-.04-.211-.041-.208-.043-.204-.045-.201-.046-.198-.048-.195-.05-.19-.051-.187-.053-.184-.054-.179-.056-.176-.057-.172-.059-.167-.06-.164-.061-.159-.063-.155-.064-.151-.066-.074-.033-.072-.033-.072-.034-.07-.034-.069-.035-.068-.035-.067-.035-.066-.035-.064-.036-.063-.036-.062-.036-.061-.036-.06-.037-.058-.037-.057-.037-.056-.038-.055-.038-.053-.038-.052-.038-.051-.039-.049-.039-.049-.039-.046-.039-.046-.04-.044-.04-.043-.04-.041-.04-.04-.041-.039-.041-.037-.041-.036-.041-.034-.041-.033-.042-.032-.042-.03-.042-.029-.042-.027-.042-.026-.043-.024-.043-.023-.043-.021-.043-.02-.043-.018-.044-.017-.043-.015-.044-.013-.044-.012-.044-.011-.045-.009-.044-.007-.045-.006-.045-.004-.045-.002-.045-.001-.045v-17l.001-.045.002-.045.004-.045.006-.045.007-.045.009-.044.011-.045.012-.044.013-.044.015-.044.017-.043.018-.044.02-.043.021-.043.023-.043.024-.043.026-.043.027-.042.029-.042.03-.042.032-.042.033-.042.034-.041.036-.041.037-.041.039-.041.04-.041.041-.04.043-.04.044-.04.046-.04.046-.039.049-.039.049-.039.051-.039.052-.038.053-.038.055-.038.056-.038.057-.037.058-.037.06-.037.061-.036.062-.036.063-.036.064-.036.066-.035.067-.035.068-.035.069-.035.07-.034.072-.034.072-.033.074-.033.151-.066.155-.064.159-.063.164-.061.167-.06.172-.059.176-.057.179-.056.184-.054.187-.053.19-.051.195-.05.198-.048.201-.046.204-.045.208-.043.211-.041.214-.04.217-.038.22-.036.223-.034.226-.032.228-.031.231-.028.234-.027.236-.024.238-.023.241-.02.243-.019.245-.016.247-.015.249-.012.251-.01.253-.008.255-.005.256-.004.258-.001.258.001zm-9.258 20.499v.01l.001.021.003.021.004.022.005.021.006.022.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.023.018.024.019.024.021.024.022.025.023.024.024.025.052.049.056.05.061.051.066.051.07.051.075.051.079.052.084.052.088.052.092.052.097.052.102.051.105.052.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.048.144.049.147.047.152.047.155.047.16.045.163.045.167.043.171.043.176.041.178.041.183.039.187.039.19.037.194.035.197.035.202.033.204.031.209.03.212.029.216.027.219.025.222.024.226.021.23.02.233.018.236.016.24.015.243.012.246.01.249.008.253.005.256.004.259.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.021.224-.024.22-.026.216-.027.212-.028.21-.031.205-.031.202-.034.198-.034.194-.036.191-.037.187-.039.183-.04.179-.04.175-.042.172-.043.168-.044.163-.045.16-.046.155-.046.152-.047.148-.048.143-.049.139-.049.136-.05.131-.05.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.053.083-.051.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.05.023-.024.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.023.01-.022.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.127l-.077.055-.08.053-.083.054-.085.053-.087.052-.09.052-.093.051-.095.05-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.045-.118.044-.12.043-.122.042-.124.042-.126.041-.128.04-.13.04-.132.038-.134.038-.135.037-.138.037-.139.035-.142.035-.143.034-.144.033-.147.032-.148.031-.15.03-.151.03-.153.029-.154.027-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.01-.179.008-.179.008-.181.006-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.006-.179-.008-.179-.008-.178-.01-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.027-.153-.029-.151-.03-.15-.03-.148-.031-.146-.032-.145-.033-.143-.034-.141-.035-.14-.035-.137-.037-.136-.037-.134-.038-.132-.038-.13-.04-.128-.04-.126-.041-.124-.042-.122-.042-.12-.044-.117-.043-.116-.045-.113-.045-.112-.046-.109-.047-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.05-.093-.052-.09-.051-.087-.052-.085-.053-.083-.054-.08-.054-.077-.054v4.127zm0-5.654v.011l.001.021.003.021.004.021.005.022.006.022.007.022.009.022.01.022.011.023.012.023.013.023.015.024.016.023.017.024.018.024.019.024.021.024.022.024.023.025.024.024.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.052.11.051.114.051.119.052.123.05.127.051.131.05.135.049.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.044.171.042.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.022.23.02.233.018.236.016.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.012.241-.015.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.048.139-.05.136-.049.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.051.051-.049.023-.025.023-.024.021-.025.02-.024.019-.024.018-.024.017-.024.015-.023.014-.023.013-.024.012-.022.01-.023.01-.023.008-.022.006-.022.006-.022.004-.021.004-.022.001-.021.001-.021v-4.139l-.077.054-.08.054-.083.054-.085.052-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.044-.118.044-.12.044-.122.042-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.035-.143.033-.144.033-.147.033-.148.031-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.009-.179.009-.179.007-.181.007-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.007-.179-.007-.179-.009-.178-.009-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.031-.146-.033-.145-.033-.143-.033-.141-.035-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.04-.126-.041-.124-.042-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.051-.093-.051-.09-.051-.087-.053-.085-.052-.083-.054-.08-.054-.077-.054v4.139zm0-5.666v.011l.001.02.003.022.004.021.005.022.006.021.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.024.018.023.019.024.021.025.022.024.023.024.024.025.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.051.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.043.171.043.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.021.23.02.233.018.236.017.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.013.241-.014.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.049.139-.049.136-.049.131-.051.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.049.023-.025.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.022.01-.023.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.153l-.077.054-.08.054-.083.053-.085.053-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.048-.105.048-.106.048-.109.046-.111.046-.114.046-.115.044-.118.044-.12.043-.122.043-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.034-.143.034-.144.033-.147.032-.148.032-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.024-.161.024-.162.023-.163.023-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.01-.178.01-.179.009-.179.007-.181.006-.182.006-.182.004-.184.003-.184.001-.185.001-.185-.001-.184-.001-.184-.003-.182-.004-.182-.006-.181-.006-.179-.007-.179-.009-.178-.01-.176-.01-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.023-.162-.023-.161-.024-.159-.024-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.032-.146-.032-.145-.033-.143-.034-.141-.034-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.041-.126-.041-.124-.041-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.048-.105-.048-.102-.048-.1-.05-.097-.049-.095-.051-.093-.051-.09-.052-.087-.052-.085-.053-.083-.053-.08-.054-.077-.054v4.153zm8.74-8.179l-.257.004-.254.005-.25.008-.247.011-.244.012-.241.014-.237.016-.233.018-.231.021-.226.022-.224.023-.22.026-.216.027-.212.028-.21.031-.205.032-.202.033-.198.034-.194.036-.191.038-.187.038-.183.04-.179.041-.175.042-.172.043-.168.043-.163.045-.16.046-.155.046-.152.048-.148.048-.143.048-.139.049-.136.05-.131.05-.126.051-.123.051-.118.051-.114.052-.11.052-.106.052-.101.052-.096.052-.092.052-.088.052-.083.052-.079.052-.074.051-.07.052-.065.051-.06.05-.056.05-.051.05-.023.025-.023.024-.021.024-.02.025-.019.024-.018.024-.017.023-.015.024-.014.023-.013.023-.012.023-.01.023-.01.022-.008.022-.006.023-.006.021-.004.022-.004.021-.001.021-.001.021.001.021.001.021.004.021.004.022.006.021.006.023.008.022.01.022.01.023.012.023.013.023.014.023.015.024.017.023.018.024.019.024.02.025.021.024.023.024.023.025.051.05.056.05.06.05.065.051.07.052.074.051.079.052.083.052.088.052.092.052.096.052.101.052.106.052.11.052.114.052.118.051.123.051.126.051.131.05.136.05.139.049.143.048.148.048.152.048.155.046.16.046.163.045.168.043.172.043.175.042.179.041.183.04.187.038.191.038.194.036.198.034.202.033.205.032.21.031.212.028.216.027.22.026.224.023.226.022.231.021.233.018.237.016.241.014.244.012.247.011.25.008.254.005.257.004.26.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.022.224-.023.22-.026.216-.027.212-.028.21-.031.205-.032.202-.033.198-.034.194-.036.191-.038.187-.038.183-.04.179-.041.175-.042.172-.043.168-.043.163-.045.16-.046.155-.046.152-.048.148-.048.143-.048.139-.049.136-.05.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.05.051-.05.023-.025.023-.024.021-.024.02-.025.019-.024.018-.024.017-.023.015-.024.014-.023.013-.023.012-.023.01-.023.01-.022.008-.022.006-.023.006-.021.004-.022.004-.021.001-.021.001-.021-.001-.021-.001-.021-.004-.021-.004-.022-.006-.021-.006-.023-.008-.022-.01-.022-.01-.023-.012-.023-.013-.023-.014-.023-.015-.024-.017-.023-.018-.024-.019-.024-.02-.025-.021-.024-.023-.024-.023-.025-.051-.05-.056-.05-.06-.05-.065-.051-.07-.052-.074-.051-.079-.052-.083-.052-.088-.052-.092-.052-.096-.052-.101-.052-.106-.052-.11-.052-.114-.052-.118-.051-.123-.051-.126-.051-.131-.05-.136-.05-.139-.049-.143-.048-.148-.048-.152-.048-.155-.046-.16-.046-.163-.045-.168-.043-.172-.043-.175-.042-.179-.041-.183-.04-.187-.038-.191-.038-.194-.036-.198-.034-.202-.033-.205-.032-.21-.031-.212-.028-.216-.027-.22-.026-.224-.023-.226-.022-.231-.021-.233-.018-.237-.016-.241-.014-.244-.012-.247-.011-.25-.008-.254-.005-.257-.004-.26-.001-.26.001z" transform="scale(.5)"></path></symbol></defs><defs><symbol height="24" width="24" id="clock"><path d="M12 2c5.514 0 10 4.486 10 10s-4.486 10-10 10-10-4.486-10-10 4.486-10 10-10zm0-2c-6.627 0-12 5.373-12 12s5.373 12 12 12 12-5.373 12-12-5.373-12-12-12zm5.848 12.459c.202.038.202.333.001.372-1.907.361-6.045 1.111-6.547 1.111-.719 0-1.301-.582-1.301-1.301 0-.512.77-5.447 1.125-7.445.034-.192.312-.181.343.014l.985 6.238 5.394 1.011z" transform="scale(.5)"></path></symbol></defs><defs><marker orient="auto" markerHeight="12" markerWidth="12" markerUnits="userSpaceOnUse" refY="5" refX="7.9" id="arrowhead"><path d="M 0 0 L 10 5 L 0 10 z"></path></marker></defs><defs><marker refY="4.5" refX="4" orient="auto" markerHeight="8" markerWidth="15" id="crosshead"><path style="stroke-dasharray: 0, 0;" d="M 1,2 L 6,7 M 6,2 L 1,7" stroke-width="1pt" stroke="#000000" fill="none"></path></marker></defs><defs><marker orient="auto" markerHeight="28" markerWidth="20" refY="7" refX="15.5" id="filled-head"><path d="M 18,7 L9,13 L14,7 L9,1 Z"></path></marker></defs><defs><marker orient="auto" markerHeight="40" markerWidth="60" refY="15" refX="15" id="sequencenumber"><circle r="6" cy="15" cx="15"></circle></marker></defs><g><rect class="note" ry="0" rx="0" height="39" width="749" stroke="#666" fill="#EDF2AE" y="75" x="447"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="80" x="822"><tspan x="822">status (receive/send): NONE/NONE</tspan></text></g><g><rect class="note" ry="0" rx="0" height="57" width="447" stroke="#666" fill="#EDF2AE" y="124" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="129" x="274"><tspan x="274">1. request connection</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="148" x="274"><tspan x="274">from agent</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="298" stroke="#666" fill="#EDF2AE" y="239" x="447"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="244" x="596"><tspan x="596">2. create Alice's SMP queue</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="158" stroke="#666" fill="#EDF2AE" y="403" x="393"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="408" x="472"><tspan x="472">status: NEW/NONE</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="1346" stroke="#666" fill="#EDF2AE" y="519" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="524" x="723"><tspan x="723">3. out-of-band invitation</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="250" stroke="#666" fill="#EDF2AE" y="616" x="1146"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="621" x="1271"><tspan x="1271">4. accept connection</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="158" stroke="#666" fill="#EDF2AE" y="732" x="1092"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="737" x="1171"><tspan x="1171">status: NONE/NEW</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="501" stroke="#666" fill="#EDF2AE" y="781" x="695"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="786" x="946"><tspan x="946">5. secure Alice's SMP queue</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="195" stroke="#666" fill="#EDF2AE" y="878" x="1073.5"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="883" x="1171"><tspan x="1171">status: NONE/SECURED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="301" stroke="#666" fill="#EDF2AE" y="927" x="895"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="932" x="1046"><tspan x="1046">6. create Bob's SMP queue</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="186" stroke="#666" fill="#EDF2AE" y="1091" x="1078"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1096" x="1171"><tspan x="1171">status: NEW/SECURED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="749" stroke="#666" fill="#EDF2AE" y="1140" x="447"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1145" x="822"><tspan x="822">7. confirm Alice's SMP queue</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="206" stroke="#666" fill="#EDF2AE" y="1237" x="1068"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1242" x="1171"><tspan x="1171">status: NEW/CONFIRMED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="206" stroke="#666" fill="#EDF2AE" y="1353" x="369"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1358" x="472"><tspan x="472">status: CONFIRMED/NEW</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="498" stroke="#666" fill="#EDF2AE" y="1584" x="447"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1589" x="696"><tspan x="696">8. secure Bob's SMP queue</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="242" stroke="#666" fill="#EDF2AE" y="1681" x="1050"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1686" x="1171"><tspan x="1171">status: CONFIRMED/SECURED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="262" stroke="#666" fill="#EDF2AE" y="1778" x="341"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1783" x="472"><tspan x="472">status: CONFIRMED/CONFIRMED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="76" width="447" stroke="#666" fill="#EDF2AE" y="1827" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1832" x="274"><tspan x="274">9. notify Alice</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1851" x="274"><tspan x="274">about connection success</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1869" x="274"><tspan x="274">(no HELLO needed in v6)</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="188" stroke="#666" fill="#EDF2AE" y="1961" x="378"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1966" x="472"><tspan x="472">status: ACTIVE/ACTIVE</tspan></text></g><g><rect class="note" ry="0" rx="0" height="57" width="250" stroke="#666" fill="#EDF2AE" y="2010" x="1146"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2015" x="1271"><tspan x="1271">10. notify Bob</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2034" x="1271"><tspan x="1271">about connection success</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="262" stroke="#666" fill="#EDF2AE" y="2144" x="1040"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2149" x="1171"><tspan x="1171">status: CONFIRMED/CONFIRMED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="188" stroke="#666" fill="#EDF2AE" y="2337" x="1077"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2342" x="1171"><tspan x="1171">status: ACTIVE/ACTIVE</tspan></text></g><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="196" x="272">createConnection</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="229" x2="468" y1="229" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="293" x="595">NEW: create SMP queue</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="312" x="595">allow sender to secure</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="345" x2="716" y1="345" x1="473"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="360" x="598">IDS: SMP queue IDs</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="393" x2="476" y1="393" x1="719"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="457" x="275">INV: invitation</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="476" x="275">to connect</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="509" x2="79" y1="509" x1="471"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="573" x="722">OOB: invitation to connect</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="606" x2="1367" y1="606" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="670" x="1273">joinConnection:</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="689" x="1273">via invitation info</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="722" x2="1175" y1="722" x1="1370"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="835" x="947">SKEY: secure queue (this command needs to be proxied)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="868" x2="724" y1="868" x1="1170"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="981" x="1047">NEW: create SMP queue</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1000" x="1047">allow sender to secure</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1033" x2="924" y1="1033" x1="1170"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1048" x="1044">IDS: SMP queue IDs</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1081" x2="1167" y1="1081" x1="921"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1194" x="947">SEND: Bob's info without sender's key (SMP confirmation with reply queues)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1227" x2="724" y1="1227" x1="1170"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1291" x="598">MSG: Bob's info without</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1310" x="598">sender server key</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1343" x2="476" y1="1343" x1="719"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1407" x="595">ACK: confirm message</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1440" x2="716" y1="1440" x1="473"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1455" x="275">CONF: connection request ID</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1474" x="275">and Bob's info</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1507" x2="79" y1="1507" x1="471"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1522" x="274">allowConnection: accept connection request,</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1541" x="274">send Alice's info</text><line style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="1574" x2="471" y1="1574" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1638" x="695">SKEY: secure queue (this command needs to be proxied)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1671" x2="916" y1="1671" x1="473"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1735" x="695">SEND: Alice's info without sender's server key (SMP confirmation without reply queues)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1768" x2="916" y1="1768" x1="473"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1918" x="275">CON: connected</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1951" x2="79" y1="1951" x1="471"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2082" x="1044">MSG: Alice's info without</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2101" x="1044">sender's server key</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="2134" x2="1167" y1="2134" x1="921"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2198" x="1270">INFO: Alice's info</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="2231" x2="1367" y1="2231" x1="1172"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2246" x="1047">ACK: confirm message</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="2279" x2="924" y1="2279" x1="1170"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2294" x="1270">CON: connected</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="2327" x2="1367" y1="2327" x1="1172"></line></svg>
\ No newline at end of file
diff --git a/protocol/diagrams/duplex-messaging/duplex-creating-v2.mmd b/protocol/diagrams/duplex-messaging/duplex-creating-v2.mmd
deleted file mode 100644
index 09ee913ff..000000000
--- a/protocol/diagrams/duplex-messaging/duplex-creating-v2.mmd
+++ /dev/null
@@ -1,71 +0,0 @@
-sequenceDiagram
-  participant A as Alice
-  participant AA as Alice's<br>agent
-  participant AS as Alice's<br>server
-  participant BS as Bob's<br>server
-  participant BA as Bob's<br>agent
-  participant B as Bob
-
-  note over AA, BA: status (receive/send): NONE/NONE
-
-  note over A, AA: 1. request connection<br>from agent
-  A ->> AA: NEW: create<br>duplex connection
- 
-  note over AA, AS: 2. create Alice's SMP queue
-  AA ->> AS: NEW: create SMP queue
-  AS ->> AA: IDS: SMP queue IDs
-  note over AA: status: NEW/NONE
-
-  AA ->> A: INV: invitation<br>to connect
-
-  note over A, B: 3. out-of-band invitation
-  A ->> B: OOB: invitation to connect
-
-  note over BA, B: 4. accept connection
-  B ->> BA: JOIN:<br>via invitation info
-  note over BA: status: NONE/NEW
-
-  note over BA, BS: 5. create Bob's SMP queue
-  BA ->> BS: NEW: create SMP queue
-  BS ->> BA: IDS: SMP queue IDs
-  note over BA: status: NEW/NEW
-
-  note over BA, AA: 6. establish Alice's SMP queue
-  BA ->> AS: SEND: Bob's info and sender server key (SMP confirmation with reply queues)
-  note over BA: status: NEW/CONFIRMED
-
-  AS ->> AA: MSG: Bob's info and<br>sender server key
-  note over AA: status: CONFIRMED/NONE
-  AA ->> AS: ACK: confirm message
-  AA ->> A: CONF: connection request ID<br>and Bob's info
-  A ->> AA: LET: accept connection request,<br>send Alice's info
-  AA ->> AS: KEY: secure queue
-  note over AA: status: SECURED/NONE
-
-  AA ->> BS: SEND: Alice's info and sender's server key (SMP confirmation without reply queues)
-  note over AA: status: SECURED/CONFIRMED
-
-  BS ->> BA: MSG: Alice's info and<br>sender's server key
-  note over BA: status: CONFIRMED/CONFIRMED
-  BA ->> B: INFO: Alice's info
-  BA ->> BS: ACK: confirm message
-  BA ->> BS: KEY: secure queue
-  note over BA: status: SECURED/CONFIRMED
-
-  BA ->> AS: SEND: HELLO: only needs to be sent once in v2
-
-  note over BA: status: SECURED/ACTIVE
-  note over BA, B: 7a. notify Bob<br>about connection success
-  BA ->> B: CON: connected
-
-  AS ->> AA: MSG: HELLO: Alice's agent<br>knows Bob can send
-  note over AA: status: SECURED/ACTIVE
-  AA ->> AS: ACK: confirm message
-  note over A, AA: 7a. notify Alice<br>about connection success
-  AA ->> A: CON: connected
-
-  AA ->> BS: SEND: HELLO: only needs to be sent once in v2
-  note over AA: status: ACTIVE/ACTIVE
-  BS ->> BA: MSG: HELLO: Bob's agent<br>knows Alice can send
-  note over BA: status: ACTIVE/ACTIVE
-  BA ->> BS: ACK: confirm message
diff --git a/protocol/diagrams/duplex-messaging/duplex-creating.mmd b/protocol/diagrams/duplex-messaging/duplex-creating.mmd
index 738bad325..5cddf6aa4 100644
--- a/protocol/diagrams/duplex-messaging/duplex-creating.mmd
+++ b/protocol/diagrams/duplex-messaging/duplex-creating.mmd
@@ -8,8 +8,8 @@ sequenceDiagram
 
   note over AA, BA: status (receive/send): NONE/NONE
 
-  note over A, AA: 1. request connection from agent
-  A ->> AA: NEW: create<br>duplex connection
+  note over A, AA: 1. request connection<br>from agent
+  A ->> AA: createConnection
  
   note over AA, AS: 2. create Alice's SMP queue
   AA ->> AS: NEW: create SMP queue
@@ -17,63 +17,58 @@ sequenceDiagram
   note over AA: status: NEW/NONE
 
   AA ->> A: INV: invitation<br>to connect
-  note over AA: status: PENDING/NONE
 
   note over A, B: 3. out-of-band invitation
   A ->> B: OOB: invitation to connect
 
   note over BA, B: 4. accept connection
-  B ->> BA: JOIN:<br>via invitation info
+  B ->> BA: joinConnection:<br>via invitation info
   note over BA: status: NONE/NEW
 
-  note over BA, AA: 5. establish Alice's SMP queue
-  BA ->> AS: SEND: Bob's info and sender server key (SMP confirmation)
-  note over BA: status: NONE/CONFIRMED
-  activate BA
+  note over BA, BS: 5. create Bob's SMP queue
+  BA ->> BS: NEW: create SMP queue
+  BS ->> BA: IDS: SMP queue IDs
+  note over BA: status: NEW/NEW
+
+  note over BA, AA: 6. confirm Alice's SMP queue
+  BA ->> AS: SEND: Bob's info and sender server key (SMP confirmation with reply queues)
+  note over BA: status: NEW/CONFIRMED
+
   AS ->> AA: MSG: Bob's info and<br>sender server key
   note over AA: status: CONFIRMED/NONE
   AA ->> AS: ACK: confirm message
   AA ->> A: CONF: connection request ID<br>and Bob's info
-  A ->> AA: LET: accept connection request,<br>send Alice's info
+  A ->> AA: allowConnection: accept connection request,<br>send Alice's info
   AA ->> AS: KEY: secure queue
   note over AA: status: SECURED/NONE
 
-  BA ->> AS: SEND: HELLO: try sending until successful
-  deactivate BA
-  note over BA: status: NONE/ACTIVE
-  AS ->> AA: MSG: HELLO: Alice's agent<br>knows Bob can send
-  note over AA: status: ACTIVE/NONE
-  AA ->> AS: ACK: confirm message
+  AA ->> BS: SEND: Alice's info and sender's server key (SMP confirmation without reply queues)
+  note over AA: status: SECURED/CONFIRMED
 
-  note over BA, BS: 6. create Bob's SMP queue
-  BA ->> BS: NEW: create SMP queue
-  BS ->> BA: IDS: SMP queue IDs
-  note over BA: status: NEW/ACTIVE
-
-  note over AA, BA: 7. establish Bob's SMP queue
-  BA ->> AS: SEND: REPLY: invitation to the connect
-  note over BA: status: PENDING/ACTIVE
-  AS ->> AA: MSG: REPLY: invitation<br>to connect
-  note over AA: status: ACTIVE/NEW
-  AA ->> AS: ACK: confirm message
-
-  AA ->> BS: SEND: Alice's info and sender's server key
-  note over AA: status: ACTIVE/CONFIRMED
-  activate AA
+  note over BA, AA: 7. confirm Bob's SMP queue
   BS ->> BA: MSG: Alice's info and<br>sender's server key
-  note over BA: status: CONFIRMED/ACTIVE
+  note over BA: status: CONFIRMED/CONFIRMED
   BA ->> B: INFO: Alice's info
   BA ->> BS: ACK: confirm message
   BA ->> BS: KEY: secure queue
+  note over BA: status: SECURED/CONFIRMED
+
+  BA ->> AS: SEND: HELLO message
+
   note over BA: status: SECURED/ACTIVE
 
-  AA ->> BS: SEND: HELLO: try sending until successful
-  deactivate AA
+  AS ->> AA: MSG: HELLO: Alice's agent<br>knows Bob can send
+  note over AA: status: SECURED/ACTIVE
+  AA ->> AS: ACK: confirm message
+  AA ->> BS: SEND: HELLO
+
+  note over A, AA: 8. notify Alice<br>about connection success
+  AA ->> A: CON: connected
   note over AA: status: ACTIVE/ACTIVE
+
   BS ->> BA: MSG: HELLO: Bob's agent<br>knows Alice can send
   note over BA: status: ACTIVE/ACTIVE
   BA ->> BS: ACK: confirm message
 
-  note over A, B: 8. notify users about connection success
-  AA ->> A: CON: connected
+  note over BA, B: 9. notify Bob<br>about connection success
   BA ->> B: CON: connected
diff --git a/protocol/diagrams/duplex-messaging/duplex-creating.svg b/protocol/diagrams/duplex-messaging/duplex-creating.svg
index 138935d3b..bea3bb23d 100644
--- a/protocol/diagrams/duplex-messaging/duplex-creating.svg
+++ b/protocol/diagrams/duplex-messaging/duplex-creating.svg
@@ -1 +1,3 @@
-<svg id="graph-div" width="100%" xmlns="http://www.w3.org/2000/svg" height="2941" style="max-width: 1470px;" viewBox="-50 -10 1470 2941"><style>#graph-div {font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#graph-div .error-icon{fill:#552222;}#graph-div .error-text{fill:#552222;stroke:#552222;}#graph-div .edge-thickness-normal{stroke-width:2px;}#graph-div .edge-thickness-thick{stroke-width:3.5px;}#graph-div .edge-pattern-solid{stroke-dasharray:0;}#graph-div .edge-pattern-dashed{stroke-dasharray:3;}#graph-div .edge-pattern-dotted{stroke-dasharray:2;}#graph-div .marker{fill:#333333;stroke:#333333;}#graph-div .marker.cross{stroke:#333333;}#graph-div svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#graph-div .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div text.actor&gt;tspan{fill:black;stroke:none;}#graph-div .actor-line{stroke:grey;}#graph-div .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#graph-div .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#graph-div #arrowhead path{fill:#333;stroke:#333;}#graph-div .sequenceNumber{fill:white;}#graph-div #sequencenumber{fill:#333;}#graph-div #crosshead path{fill:#333;stroke:#333;}#graph-div .messageText{fill:#333;stroke:#333;}#graph-div .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .labelText,#graph-div .labelText&gt;tspan{fill:black;stroke:none;}#graph-div .loopText,#graph-div .loopText&gt;tspan{fill:black;stroke:none;}#graph-div .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#graph-div .note{stroke:#aaaa33;fill:#fff5ad;}#graph-div .noteText,#graph-div .noteText&gt;tspan{fill:black;stroke:none;}#graph-div .activation0{fill:#f4f4f4;stroke:#666;}#graph-div .activation1{fill:#f4f4f4;stroke:#666;}#graph-div .activation2{fill:#f4f4f4;stroke:#666;}#graph-div :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g></g><g><line id="actor1659" x1="75" y1="5" x2="75" y2="2930" class="actor-line" stroke-width="0.5px" stroke="#999"></line><rect x="0" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="75" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="75" dy="0">Alice</tspan></text></g><g><line id="actor1660" x1="390" y1="5" x2="390" y2="2930" class="actor-line" stroke-width="0.5px" stroke="#999"></line><rect x="315" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="390" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="390" dy="-7">Alice's</tspan></text><text x="390" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="390" dy="7">agent</tspan></text></g><g><line id="actor1661" x1="647" y1="5" x2="647" y2="2930" class="actor-line" stroke-width="0.5px" stroke="#999"></line><rect x="572" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="647" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="647" dy="-7">Alice's</tspan></text><text x="647" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="647" dy="7">server</tspan></text></g><g><line id="actor1662" x1="847" y1="5" x2="847" y2="2930" class="actor-line" stroke-width="0.5px" stroke="#999"></line><rect x="772" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="847" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="847" dy="-7">Bob's</tspan></text><text x="847" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="847" dy="7">server</tspan></text></g><g><line id="actor1663" x1="1095" y1="5" x2="1095" y2="2930" class="actor-line" stroke-width="0.5px" stroke="#999"></line><rect x="1020" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="1095" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="1095" dy="-7">Bob's</tspan></text><text x="1095" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="1095" dy="7">agent</tspan></text></g><g><line id="actor1664" x1="1295" y1="5" x2="1295" y2="2930" class="actor-line" stroke-width="0.5px" stroke="#999"></line><rect x="1220" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="1295" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="1295" dy="0">Bob</tspan></text></g><defs><marker id="arrowhead" refX="9" refY="5" markerUnits="userSpaceOnUse" markerWidth="12" markerHeight="12" orient="auto"><path d="M 0 0 L 10 5 L 0 10 z"></path></marker></defs><defs><marker id="crosshead" markerWidth="15" markerHeight="8" orient="auto" refX="16" refY="4"><path fill="black" stroke="#000000" stroke-width="1px" d="M 9,2 V 6 L16,4 Z" style="stroke-dasharray: 0, 0;"></path><path fill="none" stroke="#000000" stroke-width="1px" d="M 0,1 L 6,7 M 6,1 L 0,7" style="stroke-dasharray: 0, 0;"></path></marker></defs><defs><marker id="filled-head" refX="18" refY="7" markerWidth="20" markerHeight="28" orient="auto"><path d="M 18,7 L9,13 L14,7 L9,1 Z"></path></marker></defs><defs><marker id="sequencenumber" refX="15" refY="15" markerWidth="60" markerHeight="40" orient="auto"><circle cx="15" cy="15" r="6"></circle></marker></defs><g><rect x="365" y="75" fill="#EDF2AE" stroke="#666" width="755" height="36" rx="0" ry="0" class="note"></rect><text x="743" y="80" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="743">status (receive/send): NONE/NONE</tspan></text></g><g><rect x="50" y="121" fill="#EDF2AE" stroke="#666" width="365" height="36" rx="0" ry="0" class="note"></rect><text x="233" y="126" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="233">1. request connection from agent</tspan></text></g><text x="233" y="172" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">NEW: create</text><text x="233" y="191" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">duplex connection</text><line x1="75" y1="224" x2="390" y2="224" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="365" y="234" fill="#EDF2AE" stroke="#666" width="307" height="36" rx="0" ry="0" class="note"></rect><text x="519" y="239" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="519">2. create Alice's SMP queue</tspan></text></g><text x="519" y="285" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">NEW: create SMP queue</text><line x1="390" y1="318" x2="647" y2="318" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><text x="519" y="333" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">IDS: SMP queue IDs</text><line x1="647" y1="366" x2="390" y2="366" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="315" y="376" fill="#EDF2AE" stroke="#666" width="150" height="36" rx="0" ry="0" class="note"></rect><text x="390" y="381" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="390">status: NEW/NONE</tspan></text></g><text x="233" y="427" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">INV: invitation</text><text x="233" y="446" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">to connect</text><line x1="390" y1="479" x2="75" y2="479" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="308" y="489" fill="#EDF2AE" stroke="#666" width="164" height="36" rx="0" ry="0" class="note"></rect><text x="390" y="494" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="390">status: PENDING/NONE</tspan></text></g><g><rect x="50" y="535" fill="#EDF2AE" stroke="#666" width="1270" height="36" rx="0" ry="0" class="note"></rect><text x="685" y="540" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="685">3. out-of-band invitation</tspan></text></g><text x="685" y="586" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">OOB: invitation to connect</text><line x1="75" y1="619" x2="1295" y2="619" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="1070" y="629" fill="#EDF2AE" stroke="#666" width="250" height="36" rx="0" ry="0" class="note"></rect><text x="1195" y="634" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="1195">4. accept connection</tspan></text></g><text x="1195" y="680" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">JOIN:</text><text x="1195" y="699" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">via invitation info</text><line x1="1295" y1="732" x2="1095" y2="732" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="1020" y="742" fill="#EDF2AE" stroke="#666" width="150" height="36" rx="0" ry="0" class="note"></rect><text x="1095" y="747" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="1095">status: NONE/NEW</tspan></text></g><g><rect x="365" y="788" fill="#EDF2AE" stroke="#666" width="755" height="36" rx="0" ry="0" class="note"></rect><text x="743" y="793" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="743">5. establish Alice's SMP queue</tspan></text></g><text x="871" y="839" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">SEND: Bob's info and sender server key (SMP confirmation)</text><line x1="1095" y1="872" x2="647" y2="872" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="1004.5" y="882" fill="#EDF2AE" stroke="#666" width="181" height="36" rx="0" ry="0" class="note"></rect><text x="1095" y="887" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="1095">status: NONE/CONFIRMED</tspan></text></g><g><rect x="1090" y="918" fill="#EDF2AE" stroke="#666" width="10" height="437" rx="0" ry="0" class="activation0"></rect></g><text x="519" y="933" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">MSG: Bob's info and</text><text x="519" y="952" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">sender server key</text><line x1="647" y1="985" x2="390" y2="985" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="299.5" y="995" fill="#EDF2AE" stroke="#666" width="181" height="36" rx="0" ry="0" class="note"></rect><text x="390" y="1000" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="390">status: CONFIRMED/NONE</tspan></text></g><text x="519" y="1046" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">ACK: confirm message</text><line x1="390" y1="1079" x2="647" y2="1079" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><text x="233" y="1094" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">REQ: connection request ID</text><text x="233" y="1113" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">and Bob's info</text><line x1="390" y1="1146" x2="75" y2="1146" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><text x="233" y="1161" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">ACPT: accept connection request,</text><text x="233" y="1180" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">send Alice's info</text><line x1="75" y1="1213" x2="390" y2="1213" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><text x="519" y="1228" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">KEY: secure queue</text><line x1="390" y1="1261" x2="647" y2="1261" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="307.5" y="1271" fill="#EDF2AE" stroke="#666" width="165" height="36" rx="0" ry="0" class="note"></rect><text x="390" y="1276" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="390">status: SECURED/NONE</tspan></text></g><text x="869" y="1322" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">SEND: HELLO: try sending until successful</text><line x1="1090" y1="1355" x2="647" y2="1355" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="1018.5" y="1365" fill="#EDF2AE" stroke="#666" width="153" height="36" rx="0" ry="0" class="note"></rect><text x="1095" y="1370" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="1095">status: NONE/ACTIVE</tspan></text></g><text x="519" y="1416" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">MSG: HELLO: Alice's agent</text><text x="519" y="1435" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">knows Bob can send</text><line x1="647" y1="1468" x2="390" y2="1468" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="313.5" y="1478" fill="#EDF2AE" stroke="#666" width="153" height="36" rx="0" ry="0" class="note"></rect><text x="390" y="1483" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="390">status: ACTIVE/NONE</tspan></text></g><text x="519" y="1529" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">ACK: confirm message</text><line x1="390" y1="1562" x2="647" y2="1562" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="822" y="1572" fill="#EDF2AE" stroke="#666" width="298" height="36" rx="0" ry="0" class="note"></rect><text x="971" y="1577" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="971">6. create Bob's SMP queue</tspan></text></g><text x="971" y="1623" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">NEW: create SMP queue</text><line x1="1095" y1="1656" x2="847" y2="1656" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><text x="971" y="1671" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">IDS: SMP queue IDs</text><line x1="847" y1="1704" x2="1095" y2="1704" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="1020" y="1714" fill="#EDF2AE" stroke="#666" width="150" height="36" rx="0" ry="0" class="note"></rect><text x="1095" y="1719" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="1095">status: NEW/ACTIVE</tspan></text></g><g><rect x="365" y="1760" fill="#EDF2AE" stroke="#666" width="755" height="36" rx="0" ry="0" class="note"></rect><text x="743" y="1765" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="743">7. establish Bob's SMP queue</tspan></text></g><text x="871" y="1811" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">SEND: REPLY: invitation to the connect</text><line x1="1095" y1="1844" x2="647" y2="1844" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="1008" y="1854" fill="#EDF2AE" stroke="#666" width="174" height="36" rx="0" ry="0" class="note"></rect><text x="1095" y="1859" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="1095">status: PENDING/ACTIVE</tspan></text></g><text x="519" y="1905" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">MSG: REPLY: invitation</text><text x="519" y="1924" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">to connect</text><line x1="647" y1="1957" x2="390" y2="1957" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="315" y="1967" fill="#EDF2AE" stroke="#666" width="150" height="36" rx="0" ry="0" class="note"></rect><text x="390" y="1972" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="390">status: ACTIVE/NEW</tspan></text></g><text x="519" y="2018" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">ACK: confirm message</text><line x1="390" y1="2051" x2="647" y2="2051" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><text x="619" y="2066" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">SEND: Alice's info and sender's server key</text><line x1="390" y1="2099" x2="847" y2="2099" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="294.5" y="2109" fill="#EDF2AE" stroke="#666" width="191" height="36" rx="0" ry="0" class="note"></rect><text x="390" y="2114" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="390">status: ACTIVE/CONFIRMED</tspan></text></g><g><rect x="385" y="2145" fill="#EDF2AE" stroke="#666" width="10" height="351" rx="0" ry="0" class="activation0"></rect></g><text x="971" y="2160" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">MSG: Alice's info and</text><text x="971" y="2179" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">sender's server key</text><line x1="847" y1="2212" x2="1095" y2="2212" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="999.5" y="2222" fill="#EDF2AE" stroke="#666" width="191" height="36" rx="0" ry="0" class="note"></rect><text x="1095" y="2227" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="1095">status: CONFIRMED/ACTIVE</tspan></text></g><text x="1195" y="2273" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">INFO: Alice's info</text><line x1="1095" y1="2306" x2="1295" y2="2306" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><text x="971" y="2321" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">ACK: confirm message</text><line x1="1095" y1="2354" x2="847" y2="2354" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><text x="971" y="2369" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">KEY: secure queue</text><line x1="1095" y1="2402" x2="847" y2="2402" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="1008" y="2412" fill="#EDF2AE" stroke="#666" width="174" height="36" rx="0" ry="0" class="note"></rect><text x="1095" y="2417" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="1095">status: SECURED/ACTIVE</tspan></text></g><text x="621" y="2463" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">SEND: HELLO: try sending until successful</text><line x1="395" y1="2496" x2="847" y2="2496" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="308.5" y="2506" fill="#EDF2AE" stroke="#666" width="163" height="36" rx="0" ry="0" class="note"></rect><text x="390" y="2511" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="390">status: ACTIVE/ACTIVE</tspan></text></g><text x="971" y="2557" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">MSG: HELLO: Bob's agent</text><text x="971" y="2576" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">knows Alice can send</text><line x1="847" y1="2609" x2="1095" y2="2609" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="1013.5" y="2619" fill="#EDF2AE" stroke="#666" width="163" height="36" rx="0" ry="0" class="note"></rect><text x="1095" y="2624" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="1095">status: ACTIVE/ACTIVE</tspan></text></g><text x="971" y="2670" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">ACK: confirm message</text><line x1="1095" y1="2703" x2="847" y2="2703" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="50" y="2713" fill="#EDF2AE" stroke="#666" width="1270" height="36" rx="0" ry="0" class="note"></rect><text x="685" y="2718" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 14px; font-weight: 400;"><tspan x="685">8. notify users about connection success</tspan></text></g><text x="233" y="2764" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">CON: connected</text><line x1="390" y1="2797" x2="75" y2="2797" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><text x="1195" y="2812" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial, sans-serif; font-size: 16px; font-weight: 400;">CON: connected</text><line x1="1095" y1="2845" x2="1295" y2="2845" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="0" y="2865" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="75" y="2897.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="75" dy="0">Alice</tspan></text></g><g><rect x="315" y="2865" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="390" y="2897.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="390" dy="-7">Alice's</tspan></text><text x="390" y="2897.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="390" dy="7">agent</tspan></text></g><g><rect x="572" y="2865" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="647" y="2897.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="647" dy="-7">Alice's</tspan></text><text x="647" y="2897.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="647" dy="7">server</tspan></text></g><g><rect x="772" y="2865" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="847" y="2897.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="847" dy="-7">Bob's</tspan></text><text x="847" y="2897.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="847" dy="7">server</tspan></text></g><g><rect x="1020" y="2865" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="1095" y="2897.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="1095" dy="-7">Bob's</tspan></text><text x="1095" y="2897.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="1095" dy="7">agent</tspan></text></g><g><rect x="1220" y="2865" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="1295" y="2897.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="1295" dy="0">Bob</tspan></text></g></svg>
\ No newline at end of file
+<?xml version="1.0" encoding="UTF-8"?>
+<?xml-stylesheet href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.2/css/all.min.css" type="text/css"?>
+<svg aria-roledescription="sequence" role="graphics-document document" viewBox="-50 -10 1546 2482" style="max-width: 100%;" xmlns="http://www.w3.org/2000/svg" width="100%" id="graph-div" height="100%" xmlns:xlink="http://www.w3.org/1999/xlink"><g><rect class="actor actor-bottom" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="1296"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="1371"><tspan dy="0" x="1371">Bob</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="BA" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="1096"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="1171"><tspan dy="-8" x="1171">Bob's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="1171"><tspan dy="8" x="1171">agent</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="BS" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="845"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="920"><tspan dy="-8" x="920">Bob's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="920"><tspan dy="8" x="920">server</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="AS" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="645"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="720"><tspan dy="-8" x="720">Alice's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="720"><tspan dy="8" x="720">server</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="AA" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="397"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="472"><tspan dy="-8" x="472">Alice's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="472"><tspan dy="8" x="472">agent</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="2396" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="2428.5" x="75"><tspan dy="0" x="75">Alice</tspan></text></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="1371" y1="5" x1="1371" id="actor1777"></line><g id="root-1777"><rect class="actor actor-top" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="1296"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="1371"><tspan dy="0" x="1371">Bob</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="1171" y1="5" x1="1171" id="actor1776"></line><g id="root-1776"><rect class="actor actor-top" ry="3" rx="3" name="BA" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="1096"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="1171"><tspan dy="-8" x="1171">Bob's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="1171"><tspan dy="8" x="1171">agent</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="920" y1="5" x1="920" id="actor1775"></line><g id="root-1775"><rect class="actor actor-top" ry="3" rx="3" name="BS" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="845"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="920"><tspan dy="-8" x="920">Bob's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="920"><tspan dy="8" x="920">server</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="720" y1="5" x1="720" id="actor1774"></line><g id="root-1774"><rect class="actor actor-top" ry="3" rx="3" name="AS" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="645"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="720"><tspan dy="-8" x="720">Alice's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="720"><tspan dy="8" x="720">server</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="472" y1="5" x1="472" id="actor1773"></line><g id="root-1773"><rect class="actor actor-top" ry="3" rx="3" name="AA" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="397"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="472"><tspan dy="-8" x="472">Alice's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="472"><tspan dy="8" x="472">agent</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="2396" x2="75" y1="5" x1="75" id="actor1772"></line><g id="root-1772"><rect class="actor actor-top" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="75"><tspan dy="0" x="75">Alice</tspan></text></g></g><style>#graph-div{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#graph-div .error-icon{fill:#552222;}#graph-div .error-text{fill:#552222;stroke:#552222;}#graph-div .edge-thickness-normal{stroke-width:2px;}#graph-div .edge-thickness-thick{stroke-width:3.5px;}#graph-div .edge-pattern-solid{stroke-dasharray:0;}#graph-div .edge-pattern-dashed{stroke-dasharray:3;}#graph-div .edge-pattern-dotted{stroke-dasharray:2;}#graph-div .marker{fill:#333333;stroke:#333333;}#graph-div .marker.cross{stroke:#333333;}#graph-div svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#graph-div .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div text.actor&gt;tspan{fill:black;stroke:none;}#graph-div .actor-line{stroke:grey;}#graph-div .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#graph-div .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#graph-div #arrowhead path{fill:#333;stroke:#333;}#graph-div .sequenceNumber{fill:white;}#graph-div #sequencenumber{fill:#333;}#graph-div #crosshead path{fill:#333;stroke:#333;}#graph-div .messageText{fill:#333;stroke:none;}#graph-div .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .labelText,#graph-div .labelText&gt;tspan{fill:black;stroke:none;}#graph-div .loopText,#graph-div .loopText&gt;tspan{fill:black;stroke:none;}#graph-div .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#graph-div .note{stroke:#aaaa33;fill:#fff5ad;}#graph-div .noteText,#graph-div .noteText&gt;tspan{fill:black;stroke:none;}#graph-div .activation0{fill:#f4f4f4;stroke:#666;}#graph-div .activation1{fill:#f4f4f4;stroke:#666;}#graph-div .activation2{fill:#f4f4f4;stroke:#666;}#graph-div .actorPopupMenu{position:absolute;}#graph-div .actorPopupMenuPanel{position:absolute;fill:#ECECFF;box-shadow:0px 8px 16px 0px rgba(0,0,0,0.2);filter:drop-shadow(3px 5px 2px rgb(0 0 0 / 0.4));}#graph-div .actor-man line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .actor-man circle,#graph-div line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;stroke-width:2px;}#graph-div :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g></g><defs><symbol height="24" width="24" id="computer"><path d="M2 2v13h20v-13h-20zm18 11h-16v-9h16v9zm-10.228 6l.466-1h3.524l.467 1h-4.457zm14.228 3h-24l2-6h2.104l-1.33 4h18.45l-1.297-4h2.073l2 6zm-5-10h-14v-7h14v7z" transform="scale(.5)"></path></symbol></defs><defs><symbol clip-rule="evenodd" fill-rule="evenodd" id="database"><path d="M12.258.001l.256.004.255.005.253.008.251.01.249.012.247.015.246.016.242.019.241.02.239.023.236.024.233.027.231.028.229.031.225.032.223.034.22.036.217.038.214.04.211.041.208.043.205.045.201.046.198.048.194.05.191.051.187.053.183.054.18.056.175.057.172.059.168.06.163.061.16.063.155.064.15.066.074.033.073.033.071.034.07.034.069.035.068.035.067.035.066.035.064.036.064.036.062.036.06.036.06.037.058.037.058.037.055.038.055.038.053.038.052.038.051.039.05.039.048.039.047.039.045.04.044.04.043.04.041.04.04.041.039.041.037.041.036.041.034.041.033.042.032.042.03.042.029.042.027.042.026.043.024.043.023.043.021.043.02.043.018.044.017.043.015.044.013.044.012.044.011.045.009.044.007.045.006.045.004.045.002.045.001.045v17l-.001.045-.002.045-.004.045-.006.045-.007.045-.009.044-.011.045-.012.044-.013.044-.015.044-.017.043-.018.044-.02.043-.021.043-.023.043-.024.043-.026.043-.027.042-.029.042-.03.042-.032.042-.033.042-.034.041-.036.041-.037.041-.039.041-.04.041-.041.04-.043.04-.044.04-.045.04-.047.039-.048.039-.05.039-.051.039-.052.038-.053.038-.055.038-.055.038-.058.037-.058.037-.06.037-.06.036-.062.036-.064.036-.064.036-.066.035-.067.035-.068.035-.069.035-.07.034-.071.034-.073.033-.074.033-.15.066-.155.064-.16.063-.163.061-.168.06-.172.059-.175.057-.18.056-.183.054-.187.053-.191.051-.194.05-.198.048-.201.046-.205.045-.208.043-.211.041-.214.04-.217.038-.22.036-.223.034-.225.032-.229.031-.231.028-.233.027-.236.024-.239.023-.241.02-.242.019-.246.016-.247.015-.249.012-.251.01-.253.008-.255.005-.256.004-.258.001-.258-.001-.256-.004-.255-.005-.253-.008-.251-.01-.249-.012-.247-.015-.245-.016-.243-.019-.241-.02-.238-.023-.236-.024-.234-.027-.231-.028-.228-.031-.226-.032-.223-.034-.22-.036-.217-.038-.214-.04-.211-.041-.208-.043-.204-.045-.201-.046-.198-.048-.195-.05-.19-.051-.187-.053-.184-.054-.179-.056-.176-.057-.172-.059-.167-.06-.164-.061-.159-.063-.155-.064-.151-.066-.074-.033-.072-.033-.072-.034-.07-.034-.069-.035-.068-.035-.067-.035-.066-.035-.064-.036-.063-.036-.062-.036-.061-.036-.06-.037-.058-.037-.057-.037-.056-.038-.055-.038-.053-.038-.052-.038-.051-.039-.049-.039-.049-.039-.046-.039-.046-.04-.044-.04-.043-.04-.041-.04-.04-.041-.039-.041-.037-.041-.036-.041-.034-.041-.033-.042-.032-.042-.03-.042-.029-.042-.027-.042-.026-.043-.024-.043-.023-.043-.021-.043-.02-.043-.018-.044-.017-.043-.015-.044-.013-.044-.012-.044-.011-.045-.009-.044-.007-.045-.006-.045-.004-.045-.002-.045-.001-.045v-17l.001-.045.002-.045.004-.045.006-.045.007-.045.009-.044.011-.045.012-.044.013-.044.015-.044.017-.043.018-.044.02-.043.021-.043.023-.043.024-.043.026-.043.027-.042.029-.042.03-.042.032-.042.033-.042.034-.041.036-.041.037-.041.039-.041.04-.041.041-.04.043-.04.044-.04.046-.04.046-.039.049-.039.049-.039.051-.039.052-.038.053-.038.055-.038.056-.038.057-.037.058-.037.06-.037.061-.036.062-.036.063-.036.064-.036.066-.035.067-.035.068-.035.069-.035.07-.034.072-.034.072-.033.074-.033.151-.066.155-.064.159-.063.164-.061.167-.06.172-.059.176-.057.179-.056.184-.054.187-.053.19-.051.195-.05.198-.048.201-.046.204-.045.208-.043.211-.041.214-.04.217-.038.22-.036.223-.034.226-.032.228-.031.231-.028.234-.027.236-.024.238-.023.241-.02.243-.019.245-.016.247-.015.249-.012.251-.01.253-.008.255-.005.256-.004.258-.001.258.001zm-9.258 20.499v.01l.001.021.003.021.004.022.005.021.006.022.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.023.018.024.019.024.021.024.022.025.023.024.024.025.052.049.056.05.061.051.066.051.07.051.075.051.079.052.084.052.088.052.092.052.097.052.102.051.105.052.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.048.144.049.147.047.152.047.155.047.16.045.163.045.167.043.171.043.176.041.178.041.183.039.187.039.19.037.194.035.197.035.202.033.204.031.209.03.212.029.216.027.219.025.222.024.226.021.23.02.233.018.236.016.24.015.243.012.246.01.249.008.253.005.256.004.259.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.021.224-.024.22-.026.216-.027.212-.028.21-.031.205-.031.202-.034.198-.034.194-.036.191-.037.187-.039.183-.04.179-.04.175-.042.172-.043.168-.044.163-.045.16-.046.155-.046.152-.047.148-.048.143-.049.139-.049.136-.05.131-.05.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.053.083-.051.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.05.023-.024.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.023.01-.022.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.127l-.077.055-.08.053-.083.054-.085.053-.087.052-.09.052-.093.051-.095.05-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.045-.118.044-.12.043-.122.042-.124.042-.126.041-.128.04-.13.04-.132.038-.134.038-.135.037-.138.037-.139.035-.142.035-.143.034-.144.033-.147.032-.148.031-.15.03-.151.03-.153.029-.154.027-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.01-.179.008-.179.008-.181.006-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.006-.179-.008-.179-.008-.178-.01-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.027-.153-.029-.151-.03-.15-.03-.148-.031-.146-.032-.145-.033-.143-.034-.141-.035-.14-.035-.137-.037-.136-.037-.134-.038-.132-.038-.13-.04-.128-.04-.126-.041-.124-.042-.122-.042-.12-.044-.117-.043-.116-.045-.113-.045-.112-.046-.109-.047-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.05-.093-.052-.09-.051-.087-.052-.085-.053-.083-.054-.08-.054-.077-.054v4.127zm0-5.654v.011l.001.021.003.021.004.021.005.022.006.022.007.022.009.022.01.022.011.023.012.023.013.023.015.024.016.023.017.024.018.024.019.024.021.024.022.024.023.025.024.024.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.052.11.051.114.051.119.052.123.05.127.051.131.05.135.049.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.044.171.042.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.022.23.02.233.018.236.016.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.012.241-.015.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.048.139-.05.136-.049.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.051.051-.049.023-.025.023-.024.021-.025.02-.024.019-.024.018-.024.017-.024.015-.023.014-.023.013-.024.012-.022.01-.023.01-.023.008-.022.006-.022.006-.022.004-.021.004-.022.001-.021.001-.021v-4.139l-.077.054-.08.054-.083.054-.085.052-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.044-.118.044-.12.044-.122.042-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.035-.143.033-.144.033-.147.033-.148.031-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.009-.179.009-.179.007-.181.007-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.007-.179-.007-.179-.009-.178-.009-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.031-.146-.033-.145-.033-.143-.033-.141-.035-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.04-.126-.041-.124-.042-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.051-.093-.051-.09-.051-.087-.053-.085-.052-.083-.054-.08-.054-.077-.054v4.139zm0-5.666v.011l.001.02.003.022.004.021.005.022.006.021.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.024.018.023.019.024.021.025.022.024.023.024.024.025.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.051.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.043.171.043.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.021.23.02.233.018.236.017.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.013.241-.014.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.049.139-.049.136-.049.131-.051.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.049.023-.025.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.022.01-.023.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.153l-.077.054-.08.054-.083.053-.085.053-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.048-.105.048-.106.048-.109.046-.111.046-.114.046-.115.044-.118.044-.12.043-.122.043-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.034-.143.034-.144.033-.147.032-.148.032-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.024-.161.024-.162.023-.163.023-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.01-.178.01-.179.009-.179.007-.181.006-.182.006-.182.004-.184.003-.184.001-.185.001-.185-.001-.184-.001-.184-.003-.182-.004-.182-.006-.181-.006-.179-.007-.179-.009-.178-.01-.176-.01-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.023-.162-.023-.161-.024-.159-.024-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.032-.146-.032-.145-.033-.143-.034-.141-.034-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.041-.126-.041-.124-.041-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.048-.105-.048-.102-.048-.1-.05-.097-.049-.095-.051-.093-.051-.09-.052-.087-.052-.085-.053-.083-.053-.08-.054-.077-.054v4.153zm8.74-8.179l-.257.004-.254.005-.25.008-.247.011-.244.012-.241.014-.237.016-.233.018-.231.021-.226.022-.224.023-.22.026-.216.027-.212.028-.21.031-.205.032-.202.033-.198.034-.194.036-.191.038-.187.038-.183.04-.179.041-.175.042-.172.043-.168.043-.163.045-.16.046-.155.046-.152.048-.148.048-.143.048-.139.049-.136.05-.131.05-.126.051-.123.051-.118.051-.114.052-.11.052-.106.052-.101.052-.096.052-.092.052-.088.052-.083.052-.079.052-.074.051-.07.052-.065.051-.06.05-.056.05-.051.05-.023.025-.023.024-.021.024-.02.025-.019.024-.018.024-.017.023-.015.024-.014.023-.013.023-.012.023-.01.023-.01.022-.008.022-.006.023-.006.021-.004.022-.004.021-.001.021-.001.021.001.021.001.021.004.021.004.022.006.021.006.023.008.022.01.022.01.023.012.023.013.023.014.023.015.024.017.023.018.024.019.024.02.025.021.024.023.024.023.025.051.05.056.05.06.05.065.051.07.052.074.051.079.052.083.052.088.052.092.052.096.052.101.052.106.052.11.052.114.052.118.051.123.051.126.051.131.05.136.05.139.049.143.048.148.048.152.048.155.046.16.046.163.045.168.043.172.043.175.042.179.041.183.04.187.038.191.038.194.036.198.034.202.033.205.032.21.031.212.028.216.027.22.026.224.023.226.022.231.021.233.018.237.016.241.014.244.012.247.011.25.008.254.005.257.004.26.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.022.224-.023.22-.026.216-.027.212-.028.21-.031.205-.032.202-.033.198-.034.194-.036.191-.038.187-.038.183-.04.179-.041.175-.042.172-.043.168-.043.163-.045.16-.046.155-.046.152-.048.148-.048.143-.048.139-.049.136-.05.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.05.051-.05.023-.025.023-.024.021-.024.02-.025.019-.024.018-.024.017-.023.015-.024.014-.023.013-.023.012-.023.01-.023.01-.022.008-.022.006-.023.006-.021.004-.022.004-.021.001-.021.001-.021-.001-.021-.001-.021-.004-.021-.004-.022-.006-.021-.006-.023-.008-.022-.01-.022-.01-.023-.012-.023-.013-.023-.014-.023-.015-.024-.017-.023-.018-.024-.019-.024-.02-.025-.021-.024-.023-.024-.023-.025-.051-.05-.056-.05-.06-.05-.065-.051-.07-.052-.074-.051-.079-.052-.083-.052-.088-.052-.092-.052-.096-.052-.101-.052-.106-.052-.11-.052-.114-.052-.118-.051-.123-.051-.126-.051-.131-.05-.136-.05-.139-.049-.143-.048-.148-.048-.152-.048-.155-.046-.16-.046-.163-.045-.168-.043-.172-.043-.175-.042-.179-.041-.183-.04-.187-.038-.191-.038-.194-.036-.198-.034-.202-.033-.205-.032-.21-.031-.212-.028-.216-.027-.22-.026-.224-.023-.226-.022-.231-.021-.233-.018-.237-.016-.241-.014-.244-.012-.247-.011-.25-.008-.254-.005-.257-.004-.26-.001-.26.001z" transform="scale(.5)"></path></symbol></defs><defs><symbol height="24" width="24" id="clock"><path d="M12 2c5.514 0 10 4.486 10 10s-4.486 10-10 10-10-4.486-10-10 4.486-10 10-10zm0-2c-6.627 0-12 5.373-12 12s5.373 12 12 12 12-5.373 12-12-5.373-12-12-12zm5.848 12.459c.202.038.202.333.001.372-1.907.361-6.045 1.111-6.547 1.111-.719 0-1.301-.582-1.301-1.301 0-.512.77-5.447 1.125-7.445.034-.192.312-.181.343.014l.985 6.238 5.394 1.011z" transform="scale(.5)"></path></symbol></defs><defs><marker orient="auto" markerHeight="12" markerWidth="12" markerUnits="userSpaceOnUse" refY="5" refX="7.9" id="arrowhead"><path d="M 0 0 L 10 5 L 0 10 z"></path></marker></defs><defs><marker refY="4.5" refX="4" orient="auto" markerHeight="8" markerWidth="15" id="crosshead"><path style="stroke-dasharray: 0, 0;" d="M 1,2 L 6,7 M 6,2 L 1,7" stroke-width="1pt" stroke="#000000" fill="none"></path></marker></defs><defs><marker orient="auto" markerHeight="28" markerWidth="20" refY="7" refX="15.5" id="filled-head"><path d="M 18,7 L9,13 L14,7 L9,1 Z"></path></marker></defs><defs><marker orient="auto" markerHeight="40" markerWidth="60" refY="15" refX="15" id="sequencenumber"><circle r="6" cy="15" cx="15"></circle></marker></defs><g><rect class="note" ry="0" rx="0" height="39" width="749" stroke="#666" fill="#EDF2AE" y="75" x="447"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="80" x="822"><tspan x="822">status (receive/send): NONE/NONE</tspan></text></g><g><rect class="note" ry="0" rx="0" height="57" width="447" stroke="#666" fill="#EDF2AE" y="124" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="129" x="274"><tspan x="274">1. request connection</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="148" x="274"><tspan x="274">from agent</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="298" stroke="#666" fill="#EDF2AE" y="239" x="447"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="244" x="596"><tspan x="596">2. create Alice's SMP queue</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="158" stroke="#666" fill="#EDF2AE" y="403" x="393"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="408" x="472"><tspan x="472">status: NEW/NONE</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="1346" stroke="#666" fill="#EDF2AE" y="519" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="524" x="723"><tspan x="723">3. out-of-band invitation</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="250" stroke="#666" fill="#EDF2AE" y="616" x="1146"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="621" x="1271"><tspan x="1271">4. accept connection</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="158" stroke="#666" fill="#EDF2AE" y="732" x="1092"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="737" x="1171"><tspan x="1171">status: NONE/NEW</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="501" stroke="#666" fill="#EDF2AE" y="781" x="695"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="786" x="946"><tspan x="946">5. secure Alice's SMP queue</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="195" stroke="#666" fill="#EDF2AE" y="878" x="1073.5"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="883" x="1171"><tspan x="1171">status: NONE/SECURED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="301" stroke="#666" fill="#EDF2AE" y="927" x="895"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="932" x="1046"><tspan x="1046">6. create Bob's SMP queue</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="186" stroke="#666" fill="#EDF2AE" y="1091" x="1078"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1096" x="1171"><tspan x="1171">status: NEW/SECURED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="749" stroke="#666" fill="#EDF2AE" y="1140" x="447"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1145" x="822"><tspan x="822">7. confirm Alice's SMP queue</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="206" stroke="#666" fill="#EDF2AE" y="1237" x="1068"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1242" x="1171"><tspan x="1171">status: NEW/CONFIRMED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="206" stroke="#666" fill="#EDF2AE" y="1353" x="369"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1358" x="472"><tspan x="472">status: CONFIRMED/NEW</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="498" stroke="#666" fill="#EDF2AE" y="1584" x="447"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1589" x="696"><tspan x="696">8. secure Bob's SMP queue</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="242" stroke="#666" fill="#EDF2AE" y="1681" x="1050"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1686" x="1171"><tspan x="1171">status: CONFIRMED/SECURED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="262" stroke="#666" fill="#EDF2AE" y="1778" x="341"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1783" x="472"><tspan x="472">status: CONFIRMED/CONFIRMED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="76" width="447" stroke="#666" fill="#EDF2AE" y="1827" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1832" x="274"><tspan x="274">9. notify Alice</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1851" x="274"><tspan x="274">about connection success</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1869" x="274"><tspan x="274">(no HELLO needed in v6)</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="188" stroke="#666" fill="#EDF2AE" y="1961" x="378"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1966" x="472"><tspan x="472">status: ACTIVE/ACTIVE</tspan></text></g><g><rect class="note" ry="0" rx="0" height="57" width="250" stroke="#666" fill="#EDF2AE" y="2010" x="1146"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2015" x="1271"><tspan x="1271">10. notify Bob</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2034" x="1271"><tspan x="1271">about connection success</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="262" stroke="#666" fill="#EDF2AE" y="2144" x="1040"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2149" x="1171"><tspan x="1171">status: CONFIRMED/CONFIRMED</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="188" stroke="#666" fill="#EDF2AE" y="2337" x="1077"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2342" x="1171"><tspan x="1171">status: ACTIVE/ACTIVE</tspan></text></g><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="196" x="272">createConnection</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="229" x2="468" y1="229" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="293" x="595">NEW: create SMP queue</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="312" x="595">allow sender to secure</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="345" x2="716" y1="345" x1="473"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="360" x="598">IDS: SMP queue IDs</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="393" x2="476" y1="393" x1="719"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="457" x="275">INV: invitation</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="476" x="275">to connect</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="509" x2="79" y1="509" x1="471"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="573" x="722">OOB: invitation to connect</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="606" x2="1367" y1="606" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="670" x="1273">joinConnection:</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="689" x="1273">via invitation info</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="722" x2="1175" y1="722" x1="1370"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="835" x="947">SKEY: secure queue (this command needs to be proxied)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="868" x2="724" y1="868" x1="1170"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="981" x="1047">NEW: create SMP queue</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1000" x="1047">allow sender to secure</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1033" x2="924" y1="1033" x1="1170"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1048" x="1044">IDS: SMP queue IDs</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1081" x2="1167" y1="1081" x1="921"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1194" x="947">SEND: Bob's info without sender's key (SMP confirmation with reply queues)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1227" x2="724" y1="1227" x1="1170"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1291" x="598">MSG: Bob's info without</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1310" x="598">sender server key</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1343" x2="476" y1="1343" x1="719"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1407" x="595">ACK: confirm message</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1440" x2="716" y1="1440" x1="473"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1455" x="275">CONF: connection request ID</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1474" x="275">and Bob's info</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1507" x2="79" y1="1507" x1="471"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1522" x="274">allowConnection: accept connection request,</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1541" x="274">send Alice's info</text><line style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="1574" x2="471" y1="1574" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1638" x="695">SKEY: secure queue (this command needs to be proxied)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1671" x2="916" y1="1671" x1="473"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1735" x="695">SEND: Alice's info without sender's server key (SMP confirmation without reply queues)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1768" x2="916" y1="1768" x1="473"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1918" x="275">CON: connected</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1951" x2="79" y1="1951" x1="471"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2082" x="1044">MSG: Alice's info without</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2101" x="1044">sender's server key</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="2134" x2="1167" y1="2134" x1="921"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2198" x="1270">INFO: Alice's info</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="2231" x2="1367" y1="2231" x1="1172"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2246" x="1047">ACK: confirm message</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="2279" x2="924" y1="2279" x1="1170"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="2294" x="1270">CON: connected</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="2327" x2="1367" y1="2327" x1="1172"></line></svg>
\ No newline at end of file
diff --git a/protocol/diagrams/duplex-messaging/queue-rotation-fast.mmd b/protocol/diagrams/duplex-messaging/queue-rotation-fast.mmd
new file mode 100644
index 000000000..75887dd0b
--- /dev/null
+++ b/protocol/diagrams/duplex-messaging/queue-rotation-fast.mmd
@@ -0,0 +1,17 @@
+sequenceDiagram
+  participant A as Alice
+  participant R as Current server<br>that has A's<br>receive queue
+  participant R' as New server<br>that has the new A's<br>receive queue
+  participant S as Server<br>that has A's send queue<br>(B's receive queue)
+  participant B as Bob
+
+  A ->> R': NEW: create new queue<br>(allow SKEY)
+  A ->> S: SEND: QADD (R'): send address<br>of the new queue(s)
+  S ->> B: MSG: QADD (R')
+  B ->> R': SKEY: secure new queue
+  B ->> R': SEND: QTEST
+  R' ->> A: MSG: QTEST
+  A ->> R: DEL: delete the old queue
+  B ->> R': SEND: send messages to the new queue
+  R' ->> A: MSG: receive messages from the new queue
+  
\ No newline at end of file
diff --git a/protocol/diagrams/duplex-messaging/queue-rotation-fast.svg b/protocol/diagrams/duplex-messaging/queue-rotation-fast.svg
new file mode 100644
index 000000000..823074823
--- /dev/null
+++ b/protocol/diagrams/duplex-messaging/queue-rotation-fast.svg
@@ -0,0 +1,3 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<?xml-stylesheet href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.2/css/all.min.css" type="text/css"?>
+<svg aria-roledescription="sequence" role="graphics-document document" viewBox="-50 -10 1169 641" style="max-width: 100%;" xmlns="http://www.w3.org/2000/svg" width="100%" id="graph-div" height="100%" xmlns:xlink="http://www.w3.org/1999/xlink"><g><rect class="actor actor-bottom" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="555" x="919"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="587.5" x="994"><tspan dy="0" x="994">Bob</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="S" height="65" width="195" stroke="#666" fill="#eaeaea" y="555" x="674"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="587.5" x="771.5"><tspan dy="-16" x="771.5">Server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="587.5" x="771.5"><tspan dy="0" x="771.5">that has A's send queue</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="587.5" x="771.5"><tspan dy="16" x="771.5">(B's receive queue)</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="R'" height="65" width="167" stroke="#666" fill="#eaeaea" y="555" x="457"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="587.5" x="540.5"><tspan dy="-16" x="540.5">New server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="587.5" x="540.5"><tspan dy="0" x="540.5">that has the new A's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="587.5" x="540.5"><tspan dy="16" x="540.5">receive queue</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="R" height="65" width="150" stroke="#666" fill="#eaeaea" y="555" x="257"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="587.5" x="332"><tspan dy="-16" x="332">Current server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="587.5" x="332"><tspan dy="0" x="332">that has A's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="587.5" x="332"><tspan dy="16" x="332">receive queue</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="555" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="587.5" x="75"><tspan dy="0" x="75">Alice</tspan></text></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="555" x2="994" y1="5" x1="994" id="actor1771"></line><g id="root-1771"><rect class="actor actor-top" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="919"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="994"><tspan dy="0" x="994">Bob</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="555" x2="771.5" y1="5" x1="771.5" id="actor1770"></line><g id="root-1770"><rect class="actor actor-top" ry="3" rx="3" name="S" height="65" width="195" stroke="#666" fill="#eaeaea" y="0" x="674"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="771.5"><tspan dy="-16" x="771.5">Server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="771.5"><tspan dy="0" x="771.5">that has A's send queue</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="771.5"><tspan dy="16" x="771.5">(B's receive queue)</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="555" x2="540.5" y1="5" x1="540.5" id="actor1769"></line><g id="root-1769"><rect class="actor actor-top" ry="3" rx="3" name="R'" height="65" width="167" stroke="#666" fill="#eaeaea" y="0" x="457"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="540.5"><tspan dy="-16" x="540.5">New server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="540.5"><tspan dy="0" x="540.5">that has the new A's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="540.5"><tspan dy="16" x="540.5">receive queue</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="555" x2="332" y1="5" x1="332" id="actor1768"></line><g id="root-1768"><rect class="actor actor-top" ry="3" rx="3" name="R" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="257"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="332"><tspan dy="-16" x="332">Current server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="332"><tspan dy="0" x="332">that has A's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="332"><tspan dy="16" x="332">receive queue</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="555" x2="75" y1="5" x1="75" id="actor1767"></line><g id="root-1767"><rect class="actor actor-top" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="75"><tspan dy="0" x="75">Alice</tspan></text></g></g><style>#graph-div{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#graph-div .error-icon{fill:#552222;}#graph-div .error-text{fill:#552222;stroke:#552222;}#graph-div .edge-thickness-normal{stroke-width:2px;}#graph-div .edge-thickness-thick{stroke-width:3.5px;}#graph-div .edge-pattern-solid{stroke-dasharray:0;}#graph-div .edge-pattern-dashed{stroke-dasharray:3;}#graph-div .edge-pattern-dotted{stroke-dasharray:2;}#graph-div .marker{fill:#333333;stroke:#333333;}#graph-div .marker.cross{stroke:#333333;}#graph-div svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#graph-div .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div text.actor&gt;tspan{fill:black;stroke:none;}#graph-div .actor-line{stroke:grey;}#graph-div .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#graph-div .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#graph-div #arrowhead path{fill:#333;stroke:#333;}#graph-div .sequenceNumber{fill:white;}#graph-div #sequencenumber{fill:#333;}#graph-div #crosshead path{fill:#333;stroke:#333;}#graph-div .messageText{fill:#333;stroke:none;}#graph-div .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .labelText,#graph-div .labelText&gt;tspan{fill:black;stroke:none;}#graph-div .loopText,#graph-div .loopText&gt;tspan{fill:black;stroke:none;}#graph-div .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#graph-div .note{stroke:#aaaa33;fill:#fff5ad;}#graph-div .noteText,#graph-div .noteText&gt;tspan{fill:black;stroke:none;}#graph-div .activation0{fill:#f4f4f4;stroke:#666;}#graph-div .activation1{fill:#f4f4f4;stroke:#666;}#graph-div .activation2{fill:#f4f4f4;stroke:#666;}#graph-div .actorPopupMenu{position:absolute;}#graph-div .actorPopupMenuPanel{position:absolute;fill:#ECECFF;box-shadow:0px 8px 16px 0px rgba(0,0,0,0.2);filter:drop-shadow(3px 5px 2px rgb(0 0 0 / 0.4));}#graph-div .actor-man line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .actor-man circle,#graph-div line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;stroke-width:2px;}#graph-div :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g></g><defs><symbol height="24" width="24" id="computer"><path d="M2 2v13h20v-13h-20zm18 11h-16v-9h16v9zm-10.228 6l.466-1h3.524l.467 1h-4.457zm14.228 3h-24l2-6h2.104l-1.33 4h18.45l-1.297-4h2.073l2 6zm-5-10h-14v-7h14v7z" transform="scale(.5)"></path></symbol></defs><defs><symbol clip-rule="evenodd" fill-rule="evenodd" id="database"><path d="M12.258.001l.256.004.255.005.253.008.251.01.249.012.247.015.246.016.242.019.241.02.239.023.236.024.233.027.231.028.229.031.225.032.223.034.22.036.217.038.214.04.211.041.208.043.205.045.201.046.198.048.194.05.191.051.187.053.183.054.18.056.175.057.172.059.168.06.163.061.16.063.155.064.15.066.074.033.073.033.071.034.07.034.069.035.068.035.067.035.066.035.064.036.064.036.062.036.06.036.06.037.058.037.058.037.055.038.055.038.053.038.052.038.051.039.05.039.048.039.047.039.045.04.044.04.043.04.041.04.04.041.039.041.037.041.036.041.034.041.033.042.032.042.03.042.029.042.027.042.026.043.024.043.023.043.021.043.02.043.018.044.017.043.015.044.013.044.012.044.011.045.009.044.007.045.006.045.004.045.002.045.001.045v17l-.001.045-.002.045-.004.045-.006.045-.007.045-.009.044-.011.045-.012.044-.013.044-.015.044-.017.043-.018.044-.02.043-.021.043-.023.043-.024.043-.026.043-.027.042-.029.042-.03.042-.032.042-.033.042-.034.041-.036.041-.037.041-.039.041-.04.041-.041.04-.043.04-.044.04-.045.04-.047.039-.048.039-.05.039-.051.039-.052.038-.053.038-.055.038-.055.038-.058.037-.058.037-.06.037-.06.036-.062.036-.064.036-.064.036-.066.035-.067.035-.068.035-.069.035-.07.034-.071.034-.073.033-.074.033-.15.066-.155.064-.16.063-.163.061-.168.06-.172.059-.175.057-.18.056-.183.054-.187.053-.191.051-.194.05-.198.048-.201.046-.205.045-.208.043-.211.041-.214.04-.217.038-.22.036-.223.034-.225.032-.229.031-.231.028-.233.027-.236.024-.239.023-.241.02-.242.019-.246.016-.247.015-.249.012-.251.01-.253.008-.255.005-.256.004-.258.001-.258-.001-.256-.004-.255-.005-.253-.008-.251-.01-.249-.012-.247-.015-.245-.016-.243-.019-.241-.02-.238-.023-.236-.024-.234-.027-.231-.028-.228-.031-.226-.032-.223-.034-.22-.036-.217-.038-.214-.04-.211-.041-.208-.043-.204-.045-.201-.046-.198-.048-.195-.05-.19-.051-.187-.053-.184-.054-.179-.056-.176-.057-.172-.059-.167-.06-.164-.061-.159-.063-.155-.064-.151-.066-.074-.033-.072-.033-.072-.034-.07-.034-.069-.035-.068-.035-.067-.035-.066-.035-.064-.036-.063-.036-.062-.036-.061-.036-.06-.037-.058-.037-.057-.037-.056-.038-.055-.038-.053-.038-.052-.038-.051-.039-.049-.039-.049-.039-.046-.039-.046-.04-.044-.04-.043-.04-.041-.04-.04-.041-.039-.041-.037-.041-.036-.041-.034-.041-.033-.042-.032-.042-.03-.042-.029-.042-.027-.042-.026-.043-.024-.043-.023-.043-.021-.043-.02-.043-.018-.044-.017-.043-.015-.044-.013-.044-.012-.044-.011-.045-.009-.044-.007-.045-.006-.045-.004-.045-.002-.045-.001-.045v-17l.001-.045.002-.045.004-.045.006-.045.007-.045.009-.044.011-.045.012-.044.013-.044.015-.044.017-.043.018-.044.02-.043.021-.043.023-.043.024-.043.026-.043.027-.042.029-.042.03-.042.032-.042.033-.042.034-.041.036-.041.037-.041.039-.041.04-.041.041-.04.043-.04.044-.04.046-.04.046-.039.049-.039.049-.039.051-.039.052-.038.053-.038.055-.038.056-.038.057-.037.058-.037.06-.037.061-.036.062-.036.063-.036.064-.036.066-.035.067-.035.068-.035.069-.035.07-.034.072-.034.072-.033.074-.033.151-.066.155-.064.159-.063.164-.061.167-.06.172-.059.176-.057.179-.056.184-.054.187-.053.19-.051.195-.05.198-.048.201-.046.204-.045.208-.043.211-.041.214-.04.217-.038.22-.036.223-.034.226-.032.228-.031.231-.028.234-.027.236-.024.238-.023.241-.02.243-.019.245-.016.247-.015.249-.012.251-.01.253-.008.255-.005.256-.004.258-.001.258.001zm-9.258 20.499v.01l.001.021.003.021.004.022.005.021.006.022.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.023.018.024.019.024.021.024.022.025.023.024.024.025.052.049.056.05.061.051.066.051.07.051.075.051.079.052.084.052.088.052.092.052.097.052.102.051.105.052.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.048.144.049.147.047.152.047.155.047.16.045.163.045.167.043.171.043.176.041.178.041.183.039.187.039.19.037.194.035.197.035.202.033.204.031.209.03.212.029.216.027.219.025.222.024.226.021.23.02.233.018.236.016.24.015.243.012.246.01.249.008.253.005.256.004.259.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.021.224-.024.22-.026.216-.027.212-.028.21-.031.205-.031.202-.034.198-.034.194-.036.191-.037.187-.039.183-.04.179-.04.175-.042.172-.043.168-.044.163-.045.16-.046.155-.046.152-.047.148-.048.143-.049.139-.049.136-.05.131-.05.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.053.083-.051.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.05.023-.024.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.023.01-.022.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.127l-.077.055-.08.053-.083.054-.085.053-.087.052-.09.052-.093.051-.095.05-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.045-.118.044-.12.043-.122.042-.124.042-.126.041-.128.04-.13.04-.132.038-.134.038-.135.037-.138.037-.139.035-.142.035-.143.034-.144.033-.147.032-.148.031-.15.03-.151.03-.153.029-.154.027-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.01-.179.008-.179.008-.181.006-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.006-.179-.008-.179-.008-.178-.01-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.027-.153-.029-.151-.03-.15-.03-.148-.031-.146-.032-.145-.033-.143-.034-.141-.035-.14-.035-.137-.037-.136-.037-.134-.038-.132-.038-.13-.04-.128-.04-.126-.041-.124-.042-.122-.042-.12-.044-.117-.043-.116-.045-.113-.045-.112-.046-.109-.047-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.05-.093-.052-.09-.051-.087-.052-.085-.053-.083-.054-.08-.054-.077-.054v4.127zm0-5.654v.011l.001.021.003.021.004.021.005.022.006.022.007.022.009.022.01.022.011.023.012.023.013.023.015.024.016.023.017.024.018.024.019.024.021.024.022.024.023.025.024.024.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.052.11.051.114.051.119.052.123.05.127.051.131.05.135.049.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.044.171.042.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.022.23.02.233.018.236.016.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.012.241-.015.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.048.139-.05.136-.049.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.051.051-.049.023-.025.023-.024.021-.025.02-.024.019-.024.018-.024.017-.024.015-.023.014-.023.013-.024.012-.022.01-.023.01-.023.008-.022.006-.022.006-.022.004-.021.004-.022.001-.021.001-.021v-4.139l-.077.054-.08.054-.083.054-.085.052-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.044-.118.044-.12.044-.122.042-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.035-.143.033-.144.033-.147.033-.148.031-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.009-.179.009-.179.007-.181.007-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.007-.179-.007-.179-.009-.178-.009-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.031-.146-.033-.145-.033-.143-.033-.141-.035-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.04-.126-.041-.124-.042-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.051-.093-.051-.09-.051-.087-.053-.085-.052-.083-.054-.08-.054-.077-.054v4.139zm0-5.666v.011l.001.02.003.022.004.021.005.022.006.021.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.024.018.023.019.024.021.025.022.024.023.024.024.025.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.051.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.043.171.043.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.021.23.02.233.018.236.017.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.013.241-.014.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.049.139-.049.136-.049.131-.051.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.049.023-.025.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.022.01-.023.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.153l-.077.054-.08.054-.083.053-.085.053-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.048-.105.048-.106.048-.109.046-.111.046-.114.046-.115.044-.118.044-.12.043-.122.043-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.034-.143.034-.144.033-.147.032-.148.032-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.024-.161.024-.162.023-.163.023-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.01-.178.01-.179.009-.179.007-.181.006-.182.006-.182.004-.184.003-.184.001-.185.001-.185-.001-.184-.001-.184-.003-.182-.004-.182-.006-.181-.006-.179-.007-.179-.009-.178-.01-.176-.01-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.023-.162-.023-.161-.024-.159-.024-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.032-.146-.032-.145-.033-.143-.034-.141-.034-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.041-.126-.041-.124-.041-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.048-.105-.048-.102-.048-.1-.05-.097-.049-.095-.051-.093-.051-.09-.052-.087-.052-.085-.053-.083-.053-.08-.054-.077-.054v4.153zm8.74-8.179l-.257.004-.254.005-.25.008-.247.011-.244.012-.241.014-.237.016-.233.018-.231.021-.226.022-.224.023-.22.026-.216.027-.212.028-.21.031-.205.032-.202.033-.198.034-.194.036-.191.038-.187.038-.183.04-.179.041-.175.042-.172.043-.168.043-.163.045-.16.046-.155.046-.152.048-.148.048-.143.048-.139.049-.136.05-.131.05-.126.051-.123.051-.118.051-.114.052-.11.052-.106.052-.101.052-.096.052-.092.052-.088.052-.083.052-.079.052-.074.051-.07.052-.065.051-.06.05-.056.05-.051.05-.023.025-.023.024-.021.024-.02.025-.019.024-.018.024-.017.023-.015.024-.014.023-.013.023-.012.023-.01.023-.01.022-.008.022-.006.023-.006.021-.004.022-.004.021-.001.021-.001.021.001.021.001.021.004.021.004.022.006.021.006.023.008.022.01.022.01.023.012.023.013.023.014.023.015.024.017.023.018.024.019.024.02.025.021.024.023.024.023.025.051.05.056.05.06.05.065.051.07.052.074.051.079.052.083.052.088.052.092.052.096.052.101.052.106.052.11.052.114.052.118.051.123.051.126.051.131.05.136.05.139.049.143.048.148.048.152.048.155.046.16.046.163.045.168.043.172.043.175.042.179.041.183.04.187.038.191.038.194.036.198.034.202.033.205.032.21.031.212.028.216.027.22.026.224.023.226.022.231.021.233.018.237.016.241.014.244.012.247.011.25.008.254.005.257.004.26.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.022.224-.023.22-.026.216-.027.212-.028.21-.031.205-.032.202-.033.198-.034.194-.036.191-.038.187-.038.183-.04.179-.041.175-.042.172-.043.168-.043.163-.045.16-.046.155-.046.152-.048.148-.048.143-.048.139-.049.136-.05.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.05.051-.05.023-.025.023-.024.021-.024.02-.025.019-.024.018-.024.017-.023.015-.024.014-.023.013-.023.012-.023.01-.023.01-.022.008-.022.006-.023.006-.021.004-.022.004-.021.001-.021.001-.021-.001-.021-.001-.021-.004-.021-.004-.022-.006-.021-.006-.023-.008-.022-.01-.022-.01-.023-.012-.023-.013-.023-.014-.023-.015-.024-.017-.023-.018-.024-.019-.024-.02-.025-.021-.024-.023-.024-.023-.025-.051-.05-.056-.05-.06-.05-.065-.051-.07-.052-.074-.051-.079-.052-.083-.052-.088-.052-.092-.052-.096-.052-.101-.052-.106-.052-.11-.052-.114-.052-.118-.051-.123-.051-.126-.051-.131-.05-.136-.05-.139-.049-.143-.048-.148-.048-.152-.048-.155-.046-.16-.046-.163-.045-.168-.043-.172-.043-.175-.042-.179-.041-.183-.04-.187-.038-.191-.038-.194-.036-.198-.034-.202-.033-.205-.032-.21-.031-.212-.028-.216-.027-.22-.026-.224-.023-.226-.022-.231-.021-.233-.018-.237-.016-.241-.014-.244-.012-.247-.011-.25-.008-.254-.005-.257-.004-.26-.001-.26.001z" transform="scale(.5)"></path></symbol></defs><defs><symbol height="24" width="24" id="clock"><path d="M12 2c5.514 0 10 4.486 10 10s-4.486 10-10 10-10-4.486-10-10 4.486-10 10-10zm0-2c-6.627 0-12 5.373-12 12s5.373 12 12 12 12-5.373 12-12-5.373-12-12-12zm5.848 12.459c.202.038.202.333.001.372-1.907.361-6.045 1.111-6.547 1.111-.719 0-1.301-.582-1.301-1.301 0-.512.77-5.447 1.125-7.445.034-.192.312-.181.343.014l.985 6.238 5.394 1.011z" transform="scale(.5)"></path></symbol></defs><defs><marker orient="auto" markerHeight="12" markerWidth="12" markerUnits="userSpaceOnUse" refY="5" refX="7.9" id="arrowhead"><path d="M 0 0 L 10 5 L 0 10 z"></path></marker></defs><defs><marker refY="4.5" refX="4" orient="auto" markerHeight="8" markerWidth="15" id="crosshead"><path style="stroke-dasharray: 0, 0;" d="M 1,2 L 6,7 M 6,2 L 1,7" stroke-width="1pt" stroke="#000000" fill="none"></path></marker></defs><defs><marker orient="auto" markerHeight="28" markerWidth="20" refY="7" refX="15.5" id="filled-head"><path d="M 18,7 L9,13 L14,7 L9,1 Z"></path></marker></defs><defs><marker orient="auto" markerHeight="40" markerWidth="60" refY="15" refX="15" id="sequencenumber"><circle r="6" cy="15" cx="15"></circle></marker></defs><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="80" x="306">NEW: create new queue</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="99" x="306">(allow SKEY)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="132" x2="536.5" y1="132" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="147" x="422">SEND: QADD (R'): send address</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="166" x="422">of the new queue(s)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="199" x2="767.5" y1="199" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="214" x="881">MSG: QADD (R')</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="247" x2="990" y1="247" x1="772.5"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="262" x="769">SKEY: secure new queue</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="295" x2="544.5" y1="295" x1="993"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="310" x="769">SEND: QTEST</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="343" x2="544.5" y1="343" x1="993"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="358" x="309">MSG: QTEST</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="391" x2="79" y1="391" x1="539.5"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="406" x="202">DEL: delete the old queue</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="439" x2="328" y1="439" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="454" x="769">SEND: send messages to the new queue</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="487" x2="544.5" y1="487" x1="993"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="502" x="309">MSG: receive messages from the new queue</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="535" x2="79" y1="535" x1="539.5"></line></svg>
\ No newline at end of file
diff --git a/protocol/diagrams/duplex-messaging/queue-rotation.mmd b/protocol/diagrams/duplex-messaging/queue-rotation.mmd
new file mode 100644
index 000000000..9572a2c48
--- /dev/null
+++ b/protocol/diagrams/duplex-messaging/queue-rotation.mmd
@@ -0,0 +1,21 @@
+sequenceDiagram
+  participant A as Alice
+  participant R as Current server<br>that has A's<br>receive queue
+  participant R' as New server<br>that has the new A's<br>receive queue
+  participant S as Server<br>that has A's send queue<br>(B's receive queue)
+  participant B as Bob
+
+  A ->> R': NEW: create new queue
+  A ->> S: SEND: QADD (R'): send address<br>of the new queue(s)
+  S ->> B: MSG: QADD (R')
+  B ->> R: SEND: QKEY (R'): sender's key<br>for the new queue(s)
+  R ->> A: MSG: QKEY(R')
+  A ->> R': KEY: secure new queue
+  A ->> S: SEND: QUSE (R'): instruction to use new queue(s)
+  S ->> B: MSG: QUSE (R')
+  B ->> R': SEND: QTEST
+  R' ->> A: MSG: QTEST
+  A ->> R: DEL: delete the old queue
+  B ->> R': SEND: send messages to the new queue
+  R' ->> A: MSG: receive messages from the new queue
+  
\ No newline at end of file
diff --git a/protocol/diagrams/duplex-messaging/queue-rotation.svg b/protocol/diagrams/duplex-messaging/queue-rotation.svg
new file mode 100644
index 000000000..d477cd622
--- /dev/null
+++ b/protocol/diagrams/duplex-messaging/queue-rotation.svg
@@ -0,0 +1,3 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<?xml-stylesheet href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.2/css/all.min.css" type="text/css"?>
+<svg aria-roledescription="sequence" role="graphics-document document" viewBox="-50 -10 1169 833" style="max-width: 100%;" xmlns="http://www.w3.org/2000/svg" width="100%" id="graph-div" height="100%" xmlns:xlink="http://www.w3.org/1999/xlink"><g><rect class="actor actor-bottom" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="747" x="919"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="779.5" x="994"><tspan dy="0" x="994">Bob</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="S" height="65" width="195" stroke="#666" fill="#eaeaea" y="747" x="674"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="779.5" x="771.5"><tspan dy="-16" x="771.5">Server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="779.5" x="771.5"><tspan dy="0" x="771.5">that has A's send queue</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="779.5" x="771.5"><tspan dy="16" x="771.5">(B's receive queue)</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="R'" height="65" width="167" stroke="#666" fill="#eaeaea" y="747" x="457"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="779.5" x="540.5"><tspan dy="-16" x="540.5">New server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="779.5" x="540.5"><tspan dy="0" x="540.5">that has the new A's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="779.5" x="540.5"><tspan dy="16" x="540.5">receive queue</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="R" height="65" width="150" stroke="#666" fill="#eaeaea" y="747" x="257"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="779.5" x="332"><tspan dy="-16" x="332">Current server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="779.5" x="332"><tspan dy="0" x="332">that has A's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="779.5" x="332"><tspan dy="16" x="332">receive queue</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="747" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="779.5" x="75"><tspan dy="0" x="75">Alice</tspan></text></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="747" x2="994" y1="5" x1="994" id="actor1481"></line><g id="root-1481"><rect class="actor actor-top" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="919"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="994"><tspan dy="0" x="994">Bob</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="747" x2="771.5" y1="5" x1="771.5" id="actor1480"></line><g id="root-1480"><rect class="actor actor-top" ry="3" rx="3" name="S" height="65" width="195" stroke="#666" fill="#eaeaea" y="0" x="674"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="771.5"><tspan dy="-16" x="771.5">Server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="771.5"><tspan dy="0" x="771.5">that has A's send queue</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="771.5"><tspan dy="16" x="771.5">(B's receive queue)</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="747" x2="540.5" y1="5" x1="540.5" id="actor1479"></line><g id="root-1479"><rect class="actor actor-top" ry="3" rx="3" name="R'" height="65" width="167" stroke="#666" fill="#eaeaea" y="0" x="457"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="540.5"><tspan dy="-16" x="540.5">New server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="540.5"><tspan dy="0" x="540.5">that has the new A's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="540.5"><tspan dy="16" x="540.5">receive queue</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="747" x2="332" y1="5" x1="332" id="actor1478"></line><g id="root-1478"><rect class="actor actor-top" ry="3" rx="3" name="R" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="257"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="332"><tspan dy="-16" x="332">Current server</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="332"><tspan dy="0" x="332">that has A's</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="332"><tspan dy="16" x="332">receive queue</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="747" x2="75" y1="5" x1="75" id="actor1477"></line><g id="root-1477"><rect class="actor actor-top" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="75"><tspan dy="0" x="75">Alice</tspan></text></g></g><style>#graph-div{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#graph-div .error-icon{fill:#552222;}#graph-div .error-text{fill:#552222;stroke:#552222;}#graph-div .edge-thickness-normal{stroke-width:2px;}#graph-div .edge-thickness-thick{stroke-width:3.5px;}#graph-div .edge-pattern-solid{stroke-dasharray:0;}#graph-div .edge-pattern-dashed{stroke-dasharray:3;}#graph-div .edge-pattern-dotted{stroke-dasharray:2;}#graph-div .marker{fill:#333333;stroke:#333333;}#graph-div .marker.cross{stroke:#333333;}#graph-div svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#graph-div .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div text.actor&gt;tspan{fill:black;stroke:none;}#graph-div .actor-line{stroke:grey;}#graph-div .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#graph-div .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#graph-div #arrowhead path{fill:#333;stroke:#333;}#graph-div .sequenceNumber{fill:white;}#graph-div #sequencenumber{fill:#333;}#graph-div #crosshead path{fill:#333;stroke:#333;}#graph-div .messageText{fill:#333;stroke:none;}#graph-div .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .labelText,#graph-div .labelText&gt;tspan{fill:black;stroke:none;}#graph-div .loopText,#graph-div .loopText&gt;tspan{fill:black;stroke:none;}#graph-div .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#graph-div .note{stroke:#aaaa33;fill:#fff5ad;}#graph-div .noteText,#graph-div .noteText&gt;tspan{fill:black;stroke:none;}#graph-div .activation0{fill:#f4f4f4;stroke:#666;}#graph-div .activation1{fill:#f4f4f4;stroke:#666;}#graph-div .activation2{fill:#f4f4f4;stroke:#666;}#graph-div .actorPopupMenu{position:absolute;}#graph-div .actorPopupMenuPanel{position:absolute;fill:#ECECFF;box-shadow:0px 8px 16px 0px rgba(0,0,0,0.2);filter:drop-shadow(3px 5px 2px rgb(0 0 0 / 0.4));}#graph-div .actor-man line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .actor-man circle,#graph-div line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;stroke-width:2px;}#graph-div :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g></g><defs><symbol height="24" width="24" id="computer"><path d="M2 2v13h20v-13h-20zm18 11h-16v-9h16v9zm-10.228 6l.466-1h3.524l.467 1h-4.457zm14.228 3h-24l2-6h2.104l-1.33 4h18.45l-1.297-4h2.073l2 6zm-5-10h-14v-7h14v7z" transform="scale(.5)"></path></symbol></defs><defs><symbol clip-rule="evenodd" fill-rule="evenodd" id="database"><path d="M12.258.001l.256.004.255.005.253.008.251.01.249.012.247.015.246.016.242.019.241.02.239.023.236.024.233.027.231.028.229.031.225.032.223.034.22.036.217.038.214.04.211.041.208.043.205.045.201.046.198.048.194.05.191.051.187.053.183.054.18.056.175.057.172.059.168.06.163.061.16.063.155.064.15.066.074.033.073.033.071.034.07.034.069.035.068.035.067.035.066.035.064.036.064.036.062.036.06.036.06.037.058.037.058.037.055.038.055.038.053.038.052.038.051.039.05.039.048.039.047.039.045.04.044.04.043.04.041.04.04.041.039.041.037.041.036.041.034.041.033.042.032.042.03.042.029.042.027.042.026.043.024.043.023.043.021.043.02.043.018.044.017.043.015.044.013.044.012.044.011.045.009.044.007.045.006.045.004.045.002.045.001.045v17l-.001.045-.002.045-.004.045-.006.045-.007.045-.009.044-.011.045-.012.044-.013.044-.015.044-.017.043-.018.044-.02.043-.021.043-.023.043-.024.043-.026.043-.027.042-.029.042-.03.042-.032.042-.033.042-.034.041-.036.041-.037.041-.039.041-.04.041-.041.04-.043.04-.044.04-.045.04-.047.039-.048.039-.05.039-.051.039-.052.038-.053.038-.055.038-.055.038-.058.037-.058.037-.06.037-.06.036-.062.036-.064.036-.064.036-.066.035-.067.035-.068.035-.069.035-.07.034-.071.034-.073.033-.074.033-.15.066-.155.064-.16.063-.163.061-.168.06-.172.059-.175.057-.18.056-.183.054-.187.053-.191.051-.194.05-.198.048-.201.046-.205.045-.208.043-.211.041-.214.04-.217.038-.22.036-.223.034-.225.032-.229.031-.231.028-.233.027-.236.024-.239.023-.241.02-.242.019-.246.016-.247.015-.249.012-.251.01-.253.008-.255.005-.256.004-.258.001-.258-.001-.256-.004-.255-.005-.253-.008-.251-.01-.249-.012-.247-.015-.245-.016-.243-.019-.241-.02-.238-.023-.236-.024-.234-.027-.231-.028-.228-.031-.226-.032-.223-.034-.22-.036-.217-.038-.214-.04-.211-.041-.208-.043-.204-.045-.201-.046-.198-.048-.195-.05-.19-.051-.187-.053-.184-.054-.179-.056-.176-.057-.172-.059-.167-.06-.164-.061-.159-.063-.155-.064-.151-.066-.074-.033-.072-.033-.072-.034-.07-.034-.069-.035-.068-.035-.067-.035-.066-.035-.064-.036-.063-.036-.062-.036-.061-.036-.06-.037-.058-.037-.057-.037-.056-.038-.055-.038-.053-.038-.052-.038-.051-.039-.049-.039-.049-.039-.046-.039-.046-.04-.044-.04-.043-.04-.041-.04-.04-.041-.039-.041-.037-.041-.036-.041-.034-.041-.033-.042-.032-.042-.03-.042-.029-.042-.027-.042-.026-.043-.024-.043-.023-.043-.021-.043-.02-.043-.018-.044-.017-.043-.015-.044-.013-.044-.012-.044-.011-.045-.009-.044-.007-.045-.006-.045-.004-.045-.002-.045-.001-.045v-17l.001-.045.002-.045.004-.045.006-.045.007-.045.009-.044.011-.045.012-.044.013-.044.015-.044.017-.043.018-.044.02-.043.021-.043.023-.043.024-.043.026-.043.027-.042.029-.042.03-.042.032-.042.033-.042.034-.041.036-.041.037-.041.039-.041.04-.041.041-.04.043-.04.044-.04.046-.04.046-.039.049-.039.049-.039.051-.039.052-.038.053-.038.055-.038.056-.038.057-.037.058-.037.06-.037.061-.036.062-.036.063-.036.064-.036.066-.035.067-.035.068-.035.069-.035.07-.034.072-.034.072-.033.074-.033.151-.066.155-.064.159-.063.164-.061.167-.06.172-.059.176-.057.179-.056.184-.054.187-.053.19-.051.195-.05.198-.048.201-.046.204-.045.208-.043.211-.041.214-.04.217-.038.22-.036.223-.034.226-.032.228-.031.231-.028.234-.027.236-.024.238-.023.241-.02.243-.019.245-.016.247-.015.249-.012.251-.01.253-.008.255-.005.256-.004.258-.001.258.001zm-9.258 20.499v.01l.001.021.003.021.004.022.005.021.006.022.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.023.018.024.019.024.021.024.022.025.023.024.024.025.052.049.056.05.061.051.066.051.07.051.075.051.079.052.084.052.088.052.092.052.097.052.102.051.105.052.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.048.144.049.147.047.152.047.155.047.16.045.163.045.167.043.171.043.176.041.178.041.183.039.187.039.19.037.194.035.197.035.202.033.204.031.209.03.212.029.216.027.219.025.222.024.226.021.23.02.233.018.236.016.24.015.243.012.246.01.249.008.253.005.256.004.259.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.021.224-.024.22-.026.216-.027.212-.028.21-.031.205-.031.202-.034.198-.034.194-.036.191-.037.187-.039.183-.04.179-.04.175-.042.172-.043.168-.044.163-.045.16-.046.155-.046.152-.047.148-.048.143-.049.139-.049.136-.05.131-.05.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.053.083-.051.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.05.023-.024.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.023.01-.022.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.127l-.077.055-.08.053-.083.054-.085.053-.087.052-.09.052-.093.051-.095.05-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.045-.118.044-.12.043-.122.042-.124.042-.126.041-.128.04-.13.04-.132.038-.134.038-.135.037-.138.037-.139.035-.142.035-.143.034-.144.033-.147.032-.148.031-.15.03-.151.03-.153.029-.154.027-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.01-.179.008-.179.008-.181.006-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.006-.179-.008-.179-.008-.178-.01-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.027-.153-.029-.151-.03-.15-.03-.148-.031-.146-.032-.145-.033-.143-.034-.141-.035-.14-.035-.137-.037-.136-.037-.134-.038-.132-.038-.13-.04-.128-.04-.126-.041-.124-.042-.122-.042-.12-.044-.117-.043-.116-.045-.113-.045-.112-.046-.109-.047-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.05-.093-.052-.09-.051-.087-.052-.085-.053-.083-.054-.08-.054-.077-.054v4.127zm0-5.654v.011l.001.021.003.021.004.021.005.022.006.022.007.022.009.022.01.022.011.023.012.023.013.023.015.024.016.023.017.024.018.024.019.024.021.024.022.024.023.025.024.024.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.052.11.051.114.051.119.052.123.05.127.051.131.05.135.049.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.044.171.042.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.022.23.02.233.018.236.016.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.012.241-.015.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.048.139-.05.136-.049.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.051.051-.049.023-.025.023-.024.021-.025.02-.024.019-.024.018-.024.017-.024.015-.023.014-.023.013-.024.012-.022.01-.023.01-.023.008-.022.006-.022.006-.022.004-.021.004-.022.001-.021.001-.021v-4.139l-.077.054-.08.054-.083.054-.085.052-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.044-.118.044-.12.044-.122.042-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.035-.143.033-.144.033-.147.033-.148.031-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.009-.179.009-.179.007-.181.007-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.007-.179-.007-.179-.009-.178-.009-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.031-.146-.033-.145-.033-.143-.033-.141-.035-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.04-.126-.041-.124-.042-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.051-.093-.051-.09-.051-.087-.053-.085-.052-.083-.054-.08-.054-.077-.054v4.139zm0-5.666v.011l.001.02.003.022.004.021.005.022.006.021.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.024.018.023.019.024.021.025.022.024.023.024.024.025.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.051.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.043.171.043.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.021.23.02.233.018.236.017.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.013.241-.014.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.049.139-.049.136-.049.131-.051.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.049.023-.025.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.022.01-.023.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.153l-.077.054-.08.054-.083.053-.085.053-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.048-.105.048-.106.048-.109.046-.111.046-.114.046-.115.044-.118.044-.12.043-.122.043-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.034-.143.034-.144.033-.147.032-.148.032-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.024-.161.024-.162.023-.163.023-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.01-.178.01-.179.009-.179.007-.181.006-.182.006-.182.004-.184.003-.184.001-.185.001-.185-.001-.184-.001-.184-.003-.182-.004-.182-.006-.181-.006-.179-.007-.179-.009-.178-.01-.176-.01-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.023-.162-.023-.161-.024-.159-.024-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.032-.146-.032-.145-.033-.143-.034-.141-.034-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.041-.126-.041-.124-.041-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.048-.105-.048-.102-.048-.1-.05-.097-.049-.095-.051-.093-.051-.09-.052-.087-.052-.085-.053-.083-.053-.08-.054-.077-.054v4.153zm8.74-8.179l-.257.004-.254.005-.25.008-.247.011-.244.012-.241.014-.237.016-.233.018-.231.021-.226.022-.224.023-.22.026-.216.027-.212.028-.21.031-.205.032-.202.033-.198.034-.194.036-.191.038-.187.038-.183.04-.179.041-.175.042-.172.043-.168.043-.163.045-.16.046-.155.046-.152.048-.148.048-.143.048-.139.049-.136.05-.131.05-.126.051-.123.051-.118.051-.114.052-.11.052-.106.052-.101.052-.096.052-.092.052-.088.052-.083.052-.079.052-.074.051-.07.052-.065.051-.06.05-.056.05-.051.05-.023.025-.023.024-.021.024-.02.025-.019.024-.018.024-.017.023-.015.024-.014.023-.013.023-.012.023-.01.023-.01.022-.008.022-.006.023-.006.021-.004.022-.004.021-.001.021-.001.021.001.021.001.021.004.021.004.022.006.021.006.023.008.022.01.022.01.023.012.023.013.023.014.023.015.024.017.023.018.024.019.024.02.025.021.024.023.024.023.025.051.05.056.05.06.05.065.051.07.052.074.051.079.052.083.052.088.052.092.052.096.052.101.052.106.052.11.052.114.052.118.051.123.051.126.051.131.05.136.05.139.049.143.048.148.048.152.048.155.046.16.046.163.045.168.043.172.043.175.042.179.041.183.04.187.038.191.038.194.036.198.034.202.033.205.032.21.031.212.028.216.027.22.026.224.023.226.022.231.021.233.018.237.016.241.014.244.012.247.011.25.008.254.005.257.004.26.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.022.224-.023.22-.026.216-.027.212-.028.21-.031.205-.032.202-.033.198-.034.194-.036.191-.038.187-.038.183-.04.179-.041.175-.042.172-.043.168-.043.163-.045.16-.046.155-.046.152-.048.148-.048.143-.048.139-.049.136-.05.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.05.051-.05.023-.025.023-.024.021-.024.02-.025.019-.024.018-.024.017-.023.015-.024.014-.023.013-.023.012-.023.01-.023.01-.022.008-.022.006-.023.006-.021.004-.022.004-.021.001-.021.001-.021-.001-.021-.001-.021-.004-.021-.004-.022-.006-.021-.006-.023-.008-.022-.01-.022-.01-.023-.012-.023-.013-.023-.014-.023-.015-.024-.017-.023-.018-.024-.019-.024-.02-.025-.021-.024-.023-.024-.023-.025-.051-.05-.056-.05-.06-.05-.065-.051-.07-.052-.074-.051-.079-.052-.083-.052-.088-.052-.092-.052-.096-.052-.101-.052-.106-.052-.11-.052-.114-.052-.118-.051-.123-.051-.126-.051-.131-.05-.136-.05-.139-.049-.143-.048-.148-.048-.152-.048-.155-.046-.16-.046-.163-.045-.168-.043-.172-.043-.175-.042-.179-.041-.183-.04-.187-.038-.191-.038-.194-.036-.198-.034-.202-.033-.205-.032-.21-.031-.212-.028-.216-.027-.22-.026-.224-.023-.226-.022-.231-.021-.233-.018-.237-.016-.241-.014-.244-.012-.247-.011-.25-.008-.254-.005-.257-.004-.26-.001-.26.001z" transform="scale(.5)"></path></symbol></defs><defs><symbol height="24" width="24" id="clock"><path d="M12 2c5.514 0 10 4.486 10 10s-4.486 10-10 10-10-4.486-10-10 4.486-10 10-10zm0-2c-6.627 0-12 5.373-12 12s5.373 12 12 12 12-5.373 12-12-5.373-12-12-12zm5.848 12.459c.202.038.202.333.001.372-1.907.361-6.045 1.111-6.547 1.111-.719 0-1.301-.582-1.301-1.301 0-.512.77-5.447 1.125-7.445.034-.192.312-.181.343.014l.985 6.238 5.394 1.011z" transform="scale(.5)"></path></symbol></defs><defs><marker orient="auto" markerHeight="12" markerWidth="12" markerUnits="userSpaceOnUse" refY="5" refX="7.9" id="arrowhead"><path d="M 0 0 L 10 5 L 0 10 z"></path></marker></defs><defs><marker refY="4.5" refX="4" orient="auto" markerHeight="8" markerWidth="15" id="crosshead"><path style="stroke-dasharray: 0, 0;" d="M 1,2 L 6,7 M 6,2 L 1,7" stroke-width="1pt" stroke="#000000" fill="none"></path></marker></defs><defs><marker orient="auto" markerHeight="28" markerWidth="20" refY="7" refX="15.5" id="filled-head"><path d="M 18,7 L9,13 L14,7 L9,1 Z"></path></marker></defs><defs><marker orient="auto" markerHeight="40" markerWidth="60" refY="15" refX="15" id="sequencenumber"><circle r="6" cy="15" cx="15"></circle></marker></defs><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="80" x="306">NEW: create new queue</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="113" x2="536.5" y1="113" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="128" x="422">SEND: QADD (R'): send address</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="147" x="422">of the new queue(s)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="180" x2="767.5" y1="180" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="195" x="881">MSG: QADD (R')</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="228" x2="990" y1="228" x1="772.5"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="243" x="665">SEND: QKEY (R'): sender's key</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="262" x="665">for the new queue(s)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="295" x2="336" y1="295" x1="993"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="310" x="205">MSG: QKEY(R')</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="343" x2="79" y1="343" x1="331"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="358" x="306">KEY: secure new queue</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="391" x2="536.5" y1="391" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="406" x="422">SEND: QUSE (R'): instruction to use new queue(s)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="439" x2="767.5" y1="439" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="454" x="881">MSG: QUSE (R')</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="487" x2="990" y1="487" x1="772.5"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="502" x="769">SEND: QTEST</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="535" x2="544.5" y1="535" x1="993"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="550" x="309">MSG: QTEST</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="583" x2="79" y1="583" x1="539.5"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="598" x="202">DEL: delete the old queue</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="631" x2="328" y1="631" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="646" x="769">SEND: send messages to the new queue</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="679" x2="544.5" y1="679" x1="993"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="694" x="309">MSG: receive messages from the new queue</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="727" x2="79" y1="727" x1="539.5"></line></svg>
\ No newline at end of file
diff --git a/protocol/diagrams/notifications/register-token-detailed.mmd b/protocol/diagrams/notifications/register-token-detailed.mmd
new file mode 100644
index 000000000..bceef296f
--- /dev/null
+++ b/protocol/diagrams/notifications/register-token-detailed.mmd
@@ -0,0 +1,30 @@
+sequenceDiagram
+  participant M as mobile app
+  participant C as chat core
+  participant A as agent
+  participant P as push server
+  participant APN as APN
+
+  note over M, APN: get device token
+  M ->> APN: registerForRemoteNotifications()
+  APN ->> M: device token
+
+  note over M, P: register device token with push server
+  M ->> C: /_ntf register <token>
+  C ->> A: registerNtfToken(<token>)
+  A ->> P: TNEW
+  P ->> A: ID (tokenId)
+  A ->> C: registered
+  C ->> M: registered
+
+  note over M, APN: verify device token
+  P ->> APN: E2E encrypted code<br>in background<br>notification
+  APN ->> M: deliver background notification with e2ee verification token
+  M ->> C: /_ntf verify <e2ee code>
+  C ->> A: verifyNtfToken(<e2ee code>)
+  A ->> P: TVFY code
+  P ->> A: OK / ERR
+  A ->> C: verified
+  C ->> M: verified
+
+  note over M, APN: now token ID can be used
diff --git a/protocol/diagrams/notifications/register-token.mmd b/protocol/diagrams/notifications/register-token.mmd
index bceef296f..caa05d716 100644
--- a/protocol/diagrams/notifications/register-token.mmd
+++ b/protocol/diagrams/notifications/register-token.mmd
@@ -1,30 +1,26 @@
 sequenceDiagram
-  participant M as mobile app
-  participant C as chat core
+  participant C as client app
   participant A as agent
-  participant P as push server
-  participant APN as APN
+  participant P as SimpleX<br>Notification<br>Server
+  participant APN as Apple<br>Push Notifications<br>Server
 
-  note over M, APN: get device token
-  M ->> APN: registerForRemoteNotifications()
-  APN ->> M: device token
+  note over C, APN: get device token
+  C ->> APN: registerForRemoteNotifications()
+  APN ->> C: device token
 
-  note over M, P: register device token with push server
-  M ->> C: /_ntf register <token>
-  C ->> A: registerNtfToken(<token>)
+  note over C, P: register device token with push server
+  C ->> A: registerToken
   A ->> P: TNEW
   P ->> A: ID (tokenId)
   A ->> C: registered
-  C ->> M: registered
 
-  note over M, APN: verify device token
+  note over C, APN: verify device token
   P ->> APN: E2E encrypted code<br>in background<br>notification
-  APN ->> M: deliver background notification with e2ee verification token
-  M ->> C: /_ntf verify <e2ee code>
-  C ->> A: verifyNtfToken(<e2ee code>)
+  APN ->> C: deliver background notification with e2ee verification token
+  C ->> A: verifyToken<br>(<e2ee code>)
   A ->> P: TVFY code
   P ->> A: OK / ERR
   A ->> C: verified
-  C ->> M: verified
 
-  note over M, APN: now token ID can be used
+  note over C, APN: now token ID can be used
+  
\ No newline at end of file
diff --git a/protocol/diagrams/notifications/register-token.svg b/protocol/diagrams/notifications/register-token.svg
new file mode 100644
index 000000000..662a185da
--- /dev/null
+++ b/protocol/diagrams/notifications/register-token.svg
@@ -0,0 +1,3 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<?xml-stylesheet href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.2/css/all.min.css" type="text/css"?>
+<svg aria-roledescription="sequence" role="graphics-document document" viewBox="-50 -10 867 1000" style="max-width: 100%;" xmlns="http://www.w3.org/2000/svg" width="100%" id="graph-div" height="100%" xmlns:xlink="http://www.w3.org/1999/xlink"><g><rect class="actor actor-bottom" ry="3" rx="3" name="APN" height="65" width="152" stroke="#666" fill="#eaeaea" y="914" x="615"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="946.5" x="691"><tspan dy="-16" x="691">Apple</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="946.5" x="691"><tspan dy="0" x="691">Push Notifications</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="946.5" x="691"><tspan dy="16" x="691">Server</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="P" height="65" width="150" stroke="#666" fill="#eaeaea" y="914" x="400"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="946.5" x="475"><tspan dy="-16" x="475">SimpleX</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="946.5" x="475"><tspan dy="0" x="475">Notification</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="946.5" x="475"><tspan dy="16" x="475">Server</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="914" x="200"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="946.5" x="275"><tspan dy="0" x="275">agent</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="C" height="65" width="150" stroke="#666" fill="#eaeaea" y="914" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="946.5" x="75"><tspan dy="0" x="75">client app</tspan></text></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="914" x2="691" y1="5" x1="691" id="actor2348"></line><g id="root-2348"><rect class="actor actor-top" ry="3" rx="3" name="APN" height="65" width="152" stroke="#666" fill="#eaeaea" y="0" x="615"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="691"><tspan dy="-16" x="691">Apple</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="691"><tspan dy="0" x="691">Push Notifications</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="691"><tspan dy="16" x="691">Server</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="914" x2="475" y1="5" x1="475" id="actor2347"></line><g id="root-2347"><rect class="actor actor-top" ry="3" rx="3" name="P" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="400"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="475"><tspan dy="-16" x="475">SimpleX</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="475"><tspan dy="0" x="475">Notification</tspan></text><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="475"><tspan dy="16" x="475">Server</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="914" x2="275" y1="5" x1="275" id="actor2346"></line><g id="root-2346"><rect class="actor actor-top" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="200"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="275"><tspan dy="0" x="275">agent</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="914" x2="75" y1="5" x1="75" id="actor2345"></line><g id="root-2345"><rect class="actor actor-top" ry="3" rx="3" name="C" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="75"><tspan dy="0" x="75">client app</tspan></text></g></g><style>#graph-div{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#graph-div .error-icon{fill:#552222;}#graph-div .error-text{fill:#552222;stroke:#552222;}#graph-div .edge-thickness-normal{stroke-width:2px;}#graph-div .edge-thickness-thick{stroke-width:3.5px;}#graph-div .edge-pattern-solid{stroke-dasharray:0;}#graph-div .edge-pattern-dashed{stroke-dasharray:3;}#graph-div .edge-pattern-dotted{stroke-dasharray:2;}#graph-div .marker{fill:#333333;stroke:#333333;}#graph-div .marker.cross{stroke:#333333;}#graph-div svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#graph-div .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div text.actor&gt;tspan{fill:black;stroke:none;}#graph-div .actor-line{stroke:grey;}#graph-div .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#graph-div .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#graph-div #arrowhead path{fill:#333;stroke:#333;}#graph-div .sequenceNumber{fill:white;}#graph-div #sequencenumber{fill:#333;}#graph-div #crosshead path{fill:#333;stroke:#333;}#graph-div .messageText{fill:#333;stroke:none;}#graph-div .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .labelText,#graph-div .labelText&gt;tspan{fill:black;stroke:none;}#graph-div .loopText,#graph-div .loopText&gt;tspan{fill:black;stroke:none;}#graph-div .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#graph-div .note{stroke:#aaaa33;fill:#fff5ad;}#graph-div .noteText,#graph-div .noteText&gt;tspan{fill:black;stroke:none;}#graph-div .activation0{fill:#f4f4f4;stroke:#666;}#graph-div .activation1{fill:#f4f4f4;stroke:#666;}#graph-div .activation2{fill:#f4f4f4;stroke:#666;}#graph-div .actorPopupMenu{position:absolute;}#graph-div .actorPopupMenuPanel{position:absolute;fill:#ECECFF;box-shadow:0px 8px 16px 0px rgba(0,0,0,0.2);filter:drop-shadow(3px 5px 2px rgb(0 0 0 / 0.4));}#graph-div .actor-man line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .actor-man circle,#graph-div line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;stroke-width:2px;}#graph-div :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g></g><defs><symbol height="24" width="24" id="computer"><path d="M2 2v13h20v-13h-20zm18 11h-16v-9h16v9zm-10.228 6l.466-1h3.524l.467 1h-4.457zm14.228 3h-24l2-6h2.104l-1.33 4h18.45l-1.297-4h2.073l2 6zm-5-10h-14v-7h14v7z" transform="scale(.5)"></path></symbol></defs><defs><symbol clip-rule="evenodd" fill-rule="evenodd" id="database"><path d="M12.258.001l.256.004.255.005.253.008.251.01.249.012.247.015.246.016.242.019.241.02.239.023.236.024.233.027.231.028.229.031.225.032.223.034.22.036.217.038.214.04.211.041.208.043.205.045.201.046.198.048.194.05.191.051.187.053.183.054.18.056.175.057.172.059.168.06.163.061.16.063.155.064.15.066.074.033.073.033.071.034.07.034.069.035.068.035.067.035.066.035.064.036.064.036.062.036.06.036.06.037.058.037.058.037.055.038.055.038.053.038.052.038.051.039.05.039.048.039.047.039.045.04.044.04.043.04.041.04.04.041.039.041.037.041.036.041.034.041.033.042.032.042.03.042.029.042.027.042.026.043.024.043.023.043.021.043.02.043.018.044.017.043.015.044.013.044.012.044.011.045.009.044.007.045.006.045.004.045.002.045.001.045v17l-.001.045-.002.045-.004.045-.006.045-.007.045-.009.044-.011.045-.012.044-.013.044-.015.044-.017.043-.018.044-.02.043-.021.043-.023.043-.024.043-.026.043-.027.042-.029.042-.03.042-.032.042-.033.042-.034.041-.036.041-.037.041-.039.041-.04.041-.041.04-.043.04-.044.04-.045.04-.047.039-.048.039-.05.039-.051.039-.052.038-.053.038-.055.038-.055.038-.058.037-.058.037-.06.037-.06.036-.062.036-.064.036-.064.036-.066.035-.067.035-.068.035-.069.035-.07.034-.071.034-.073.033-.074.033-.15.066-.155.064-.16.063-.163.061-.168.06-.172.059-.175.057-.18.056-.183.054-.187.053-.191.051-.194.05-.198.048-.201.046-.205.045-.208.043-.211.041-.214.04-.217.038-.22.036-.223.034-.225.032-.229.031-.231.028-.233.027-.236.024-.239.023-.241.02-.242.019-.246.016-.247.015-.249.012-.251.01-.253.008-.255.005-.256.004-.258.001-.258-.001-.256-.004-.255-.005-.253-.008-.251-.01-.249-.012-.247-.015-.245-.016-.243-.019-.241-.02-.238-.023-.236-.024-.234-.027-.231-.028-.228-.031-.226-.032-.223-.034-.22-.036-.217-.038-.214-.04-.211-.041-.208-.043-.204-.045-.201-.046-.198-.048-.195-.05-.19-.051-.187-.053-.184-.054-.179-.056-.176-.057-.172-.059-.167-.06-.164-.061-.159-.063-.155-.064-.151-.066-.074-.033-.072-.033-.072-.034-.07-.034-.069-.035-.068-.035-.067-.035-.066-.035-.064-.036-.063-.036-.062-.036-.061-.036-.06-.037-.058-.037-.057-.037-.056-.038-.055-.038-.053-.038-.052-.038-.051-.039-.049-.039-.049-.039-.046-.039-.046-.04-.044-.04-.043-.04-.041-.04-.04-.041-.039-.041-.037-.041-.036-.041-.034-.041-.033-.042-.032-.042-.03-.042-.029-.042-.027-.042-.026-.043-.024-.043-.023-.043-.021-.043-.02-.043-.018-.044-.017-.043-.015-.044-.013-.044-.012-.044-.011-.045-.009-.044-.007-.045-.006-.045-.004-.045-.002-.045-.001-.045v-17l.001-.045.002-.045.004-.045.006-.045.007-.045.009-.044.011-.045.012-.044.013-.044.015-.044.017-.043.018-.044.02-.043.021-.043.023-.043.024-.043.026-.043.027-.042.029-.042.03-.042.032-.042.033-.042.034-.041.036-.041.037-.041.039-.041.04-.041.041-.04.043-.04.044-.04.046-.04.046-.039.049-.039.049-.039.051-.039.052-.038.053-.038.055-.038.056-.038.057-.037.058-.037.06-.037.061-.036.062-.036.063-.036.064-.036.066-.035.067-.035.068-.035.069-.035.07-.034.072-.034.072-.033.074-.033.151-.066.155-.064.159-.063.164-.061.167-.06.172-.059.176-.057.179-.056.184-.054.187-.053.19-.051.195-.05.198-.048.201-.046.204-.045.208-.043.211-.041.214-.04.217-.038.22-.036.223-.034.226-.032.228-.031.231-.028.234-.027.236-.024.238-.023.241-.02.243-.019.245-.016.247-.015.249-.012.251-.01.253-.008.255-.005.256-.004.258-.001.258.001zm-9.258 20.499v.01l.001.021.003.021.004.022.005.021.006.022.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.023.018.024.019.024.021.024.022.025.023.024.024.025.052.049.056.05.061.051.066.051.07.051.075.051.079.052.084.052.088.052.092.052.097.052.102.051.105.052.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.048.144.049.147.047.152.047.155.047.16.045.163.045.167.043.171.043.176.041.178.041.183.039.187.039.19.037.194.035.197.035.202.033.204.031.209.03.212.029.216.027.219.025.222.024.226.021.23.02.233.018.236.016.24.015.243.012.246.01.249.008.253.005.256.004.259.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.021.224-.024.22-.026.216-.027.212-.028.21-.031.205-.031.202-.034.198-.034.194-.036.191-.037.187-.039.183-.04.179-.04.175-.042.172-.043.168-.044.163-.045.16-.046.155-.046.152-.047.148-.048.143-.049.139-.049.136-.05.131-.05.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.053.083-.051.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.05.023-.024.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.023.01-.022.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.127l-.077.055-.08.053-.083.054-.085.053-.087.052-.09.052-.093.051-.095.05-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.045-.118.044-.12.043-.122.042-.124.042-.126.041-.128.04-.13.04-.132.038-.134.038-.135.037-.138.037-.139.035-.142.035-.143.034-.144.033-.147.032-.148.031-.15.03-.151.03-.153.029-.154.027-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.01-.179.008-.179.008-.181.006-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.006-.179-.008-.179-.008-.178-.01-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.027-.153-.029-.151-.03-.15-.03-.148-.031-.146-.032-.145-.033-.143-.034-.141-.035-.14-.035-.137-.037-.136-.037-.134-.038-.132-.038-.13-.04-.128-.04-.126-.041-.124-.042-.122-.042-.12-.044-.117-.043-.116-.045-.113-.045-.112-.046-.109-.047-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.05-.093-.052-.09-.051-.087-.052-.085-.053-.083-.054-.08-.054-.077-.054v4.127zm0-5.654v.011l.001.021.003.021.004.021.005.022.006.022.007.022.009.022.01.022.011.023.012.023.013.023.015.024.016.023.017.024.018.024.019.024.021.024.022.024.023.025.024.024.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.052.11.051.114.051.119.052.123.05.127.051.131.05.135.049.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.044.171.042.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.022.23.02.233.018.236.016.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.012.241-.015.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.048.139-.05.136-.049.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.051.051-.049.023-.025.023-.024.021-.025.02-.024.019-.024.018-.024.017-.024.015-.023.014-.023.013-.024.012-.022.01-.023.01-.023.008-.022.006-.022.006-.022.004-.021.004-.022.001-.021.001-.021v-4.139l-.077.054-.08.054-.083.054-.085.052-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.044-.118.044-.12.044-.122.042-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.035-.143.033-.144.033-.147.033-.148.031-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.009-.179.009-.179.007-.181.007-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.007-.179-.007-.179-.009-.178-.009-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.031-.146-.033-.145-.033-.143-.033-.141-.035-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.04-.126-.041-.124-.042-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.051-.093-.051-.09-.051-.087-.053-.085-.052-.083-.054-.08-.054-.077-.054v4.139zm0-5.666v.011l.001.02.003.022.004.021.005.022.006.021.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.024.018.023.019.024.021.025.022.024.023.024.024.025.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.051.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.043.171.043.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.021.23.02.233.018.236.017.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.013.241-.014.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.049.139-.049.136-.049.131-.051.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.049.023-.025.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.022.01-.023.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.153l-.077.054-.08.054-.083.053-.085.053-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.048-.105.048-.106.048-.109.046-.111.046-.114.046-.115.044-.118.044-.12.043-.122.043-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.034-.143.034-.144.033-.147.032-.148.032-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.024-.161.024-.162.023-.163.023-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.01-.178.01-.179.009-.179.007-.181.006-.182.006-.182.004-.184.003-.184.001-.185.001-.185-.001-.184-.001-.184-.003-.182-.004-.182-.006-.181-.006-.179-.007-.179-.009-.178-.01-.176-.01-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.023-.162-.023-.161-.024-.159-.024-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.032-.146-.032-.145-.033-.143-.034-.141-.034-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.041-.126-.041-.124-.041-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.048-.105-.048-.102-.048-.1-.05-.097-.049-.095-.051-.093-.051-.09-.052-.087-.052-.085-.053-.083-.053-.08-.054-.077-.054v4.153zm8.74-8.179l-.257.004-.254.005-.25.008-.247.011-.244.012-.241.014-.237.016-.233.018-.231.021-.226.022-.224.023-.22.026-.216.027-.212.028-.21.031-.205.032-.202.033-.198.034-.194.036-.191.038-.187.038-.183.04-.179.041-.175.042-.172.043-.168.043-.163.045-.16.046-.155.046-.152.048-.148.048-.143.048-.139.049-.136.05-.131.05-.126.051-.123.051-.118.051-.114.052-.11.052-.106.052-.101.052-.096.052-.092.052-.088.052-.083.052-.079.052-.074.051-.07.052-.065.051-.06.05-.056.05-.051.05-.023.025-.023.024-.021.024-.02.025-.019.024-.018.024-.017.023-.015.024-.014.023-.013.023-.012.023-.01.023-.01.022-.008.022-.006.023-.006.021-.004.022-.004.021-.001.021-.001.021.001.021.001.021.004.021.004.022.006.021.006.023.008.022.01.022.01.023.012.023.013.023.014.023.015.024.017.023.018.024.019.024.02.025.021.024.023.024.023.025.051.05.056.05.06.05.065.051.07.052.074.051.079.052.083.052.088.052.092.052.096.052.101.052.106.052.11.052.114.052.118.051.123.051.126.051.131.05.136.05.139.049.143.048.148.048.152.048.155.046.16.046.163.045.168.043.172.043.175.042.179.041.183.04.187.038.191.038.194.036.198.034.202.033.205.032.21.031.212.028.216.027.22.026.224.023.226.022.231.021.233.018.237.016.241.014.244.012.247.011.25.008.254.005.257.004.26.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.022.224-.023.22-.026.216-.027.212-.028.21-.031.205-.032.202-.033.198-.034.194-.036.191-.038.187-.038.183-.04.179-.041.175-.042.172-.043.168-.043.163-.045.16-.046.155-.046.152-.048.148-.048.143-.048.139-.049.136-.05.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.05.051-.05.023-.025.023-.024.021-.024.02-.025.019-.024.018-.024.017-.023.015-.024.014-.023.013-.023.012-.023.01-.023.01-.022.008-.022.006-.023.006-.021.004-.022.004-.021.001-.021.001-.021-.001-.021-.001-.021-.004-.021-.004-.022-.006-.021-.006-.023-.008-.022-.01-.022-.01-.023-.012-.023-.013-.023-.014-.023-.015-.024-.017-.023-.018-.024-.019-.024-.02-.025-.021-.024-.023-.024-.023-.025-.051-.05-.056-.05-.06-.05-.065-.051-.07-.052-.074-.051-.079-.052-.083-.052-.088-.052-.092-.052-.096-.052-.101-.052-.106-.052-.11-.052-.114-.052-.118-.051-.123-.051-.126-.051-.131-.05-.136-.05-.139-.049-.143-.048-.148-.048-.152-.048-.155-.046-.16-.046-.163-.045-.168-.043-.172-.043-.175-.042-.179-.041-.183-.04-.187-.038-.191-.038-.194-.036-.198-.034-.202-.033-.205-.032-.21-.031-.212-.028-.216-.027-.22-.026-.224-.023-.226-.022-.231-.021-.233-.018-.237-.016-.241-.014-.244-.012-.247-.011-.25-.008-.254-.005-.257-.004-.26-.001-.26.001z" transform="scale(.5)"></path></symbol></defs><defs><symbol height="24" width="24" id="clock"><path d="M12 2c5.514 0 10 4.486 10 10s-4.486 10-10 10-10-4.486-10-10 4.486-10 10-10zm0-2c-6.627 0-12 5.373-12 12s5.373 12 12 12 12-5.373 12-12-5.373-12-12-12zm5.848 12.459c.202.038.202.333.001.372-1.907.361-6.045 1.111-6.547 1.111-.719 0-1.301-.582-1.301-1.301 0-.512.77-5.447 1.125-7.445.034-.192.312-.181.343.014l.985 6.238 5.394 1.011z" transform="scale(.5)"></path></symbol></defs><defs><marker orient="auto" markerHeight="12" markerWidth="12" markerUnits="userSpaceOnUse" refY="5" refX="7.9" id="arrowhead"><path d="M 0 0 L 10 5 L 0 10 z"></path></marker></defs><defs><marker refY="4.5" refX="4" orient="auto" markerHeight="8" markerWidth="15" id="crosshead"><path style="stroke-dasharray: 0, 0;" d="M 1,2 L 6,7 M 6,2 L 1,7" stroke-width="1pt" stroke="#000000" fill="none"></path></marker></defs><defs><marker orient="auto" markerHeight="28" markerWidth="20" refY="7" refX="15.5" id="filled-head"><path d="M 18,7 L9,13 L14,7 L9,1 Z"></path></marker></defs><defs><marker orient="auto" markerHeight="40" markerWidth="60" refY="15" refX="15" id="sequencenumber"><circle r="6" cy="15" cx="15"></circle></marker></defs><g><rect class="note" ry="0" rx="0" height="39" width="666" stroke="#666" fill="#EDF2AE" y="75" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="80" x="383"><tspan x="383">get device token</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="450" stroke="#666" fill="#EDF2AE" y="220" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="225" x="275"><tspan x="275">register device token with push server</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="666" stroke="#666" fill="#EDF2AE" y="461" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="466" x="383"><tspan x="383">verify device token</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="666" stroke="#666" fill="#EDF2AE" y="855" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="860" x="383"><tspan x="383">now token ID can be used</tspan></text></g><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="129" x="382">registerForRemoteNotifications()</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="162" x2="687" y1="162" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="177" x="385">device token</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="210" x2="79" y1="210" x1="690"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="274" x="174">registerToken</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="307" x2="271" y1="307" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="322" x="374">TNEW</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="355" x2="471" y1="355" x1="276"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="370" x="377">ID (tokenId)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="403" x2="279" y1="403" x1="474"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="418" x="177">registered</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="451" x2="79" y1="451" x1="274"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="515" x="582">E2E encrypted code</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="534" x="582">in background</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="552" x="582">notification</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="586" x2="687" y1="586" x1="476"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="601" x="385">deliver background notification with e2ee verification token</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="634" x2="79" y1="634" x1="690"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="649" x="174">verifyToken</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="668" x="174">(&lt;e2ee code&gt;)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="701" x2="271" y1="701" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="716" x="374">TVFY code</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="749" x2="471" y1="749" x1="276"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="764" x="377">OK / ERR</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="797" x2="279" y1="797" x1="474"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="812" x="177">verified</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="845" x2="79" y1="845" x1="274"></line></svg>
\ No newline at end of file
diff --git a/protocol/diagrams/notifications/subscription-detailed.mmd b/protocol/diagrams/notifications/subscription-detailed.mmd
new file mode 100644
index 000000000..0db7cd7cc
--- /dev/null
+++ b/protocol/diagrams/notifications/subscription-detailed.mmd
@@ -0,0 +1,40 @@
+sequenceDiagram
+  participant M as mobile app
+  participant C as chat core
+  participant A as agent
+  participant S as SMP server
+  participant N as NTF server
+  participant APN as APN
+
+  note over M, APN: register subscription
+
+  alt register existing
+    M -->> A: on /_ntf register, for subscribed queues
+  else create new connection
+    A -->> S: NEW / JOIN
+    note over A, S: ...<br>Connection handshake<br>...
+    S -->> A: CON
+  end
+  A ->> S: NKEY nKey
+  S ->> A: NID nId
+  A ->> N: SNEW tknId dhKey (smpServer, nId, nKey)
+  N ->> A: ID subId dhKey
+  N ->> S: NSUB nId
+  S ->> N: OK [/ NMSG]
+
+  note over M, APN: notify about message
+
+  S ->> N: NMSG
+  N ->> APN: APNSMutableContent<br>ntfQueue, nonce
+  APN ->> M: UNMutableNotificationContent
+  note over M, S: ...<br>Client awaken, message is received<br>...
+  S ->> M: message
+  note over M: mutate notification
+
+  note over M, APN: change APN token
+
+  APN ->> M: new device token
+  M -->> C: /_ntf_sub update tkn
+  C -->> A: updateNtfToken()
+  A -->> N: TUPD tknId newDeviceToken
+  note over M, N: ...<br>Verify token<br>...
diff --git a/protocol/diagrams/notifications/subscription.mmd b/protocol/diagrams/notifications/subscription.mmd
index 0db7cd7cc..8b4db971c 100644
--- a/protocol/diagrams/notifications/subscription.mmd
+++ b/protocol/diagrams/notifications/subscription.mmd
@@ -1,17 +1,16 @@
 sequenceDiagram
-  participant M as mobile app
-  participant C as chat core
+  participant C as client app
   participant A as agent
   participant S as SMP server
   participant N as NTF server
   participant APN as APN
 
-  note over M, APN: register subscription
+  note over C, APN: register subscription
 
   alt register existing
-    M -->> A: on /_ntf register, for subscribed queues
+    C -->> A: registerToken
   else create new connection
-    A -->> S: NEW / JOIN
+    A -->> S: create/joinConnection
     note over A, S: ...<br>Connection handshake<br>...
     S -->> A: CON
   end
@@ -20,21 +19,20 @@ sequenceDiagram
   A ->> N: SNEW tknId dhKey (smpServer, nId, nKey)
   N ->> A: ID subId dhKey
   N ->> S: NSUB nId
-  S ->> N: OK [/ NMSG]
+  S ->> N: OK / NMSG:<br>confirm subscription
 
-  note over M, APN: notify about message
+  note over C, APN: notify about message
 
   S ->> N: NMSG
   N ->> APN: APNSMutableContent<br>ntfQueue, nonce
-  APN ->> M: UNMutableNotificationContent
-  note over M, S: ...<br>Client awaken, message is received<br>...
-  S ->> M: message
-  note over M: mutate notification
+  APN ->> C: UNMutableNotificationContent
+  note over C, S: ...<br>Client awaken, message is received<br>...
+  S ->> C: message
+  note over C: show notification
 
-  note over M, APN: change APN token
+  note over C, APN: change APN token
 
-  APN ->> M: new device token
-  M -->> C: /_ntf_sub update tkn
-  C -->> A: updateNtfToken()
+  APN ->> C: new device token
+  C -->> A: updateToken()
   A -->> N: TUPD tknId newDeviceToken
-  note over M, N: ...<br>Verify token<br>...
+  note over C, N: ...<br>Verify token<br>...
diff --git a/protocol/diagrams/notifications/subscription.svg b/protocol/diagrams/notifications/subscription.svg
new file mode 100644
index 000000000..49840ce58
--- /dev/null
+++ b/protocol/diagrams/notifications/subscription.svg
@@ -0,0 +1,3 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<?xml-stylesheet href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.2/css/all.min.css" type="text/css"?>
+<svg aria-roledescription="sequence" role="graphics-document document" viewBox="-50 -10 1127 1531" style="max-width: 100%;" xmlns="http://www.w3.org/2000/svg" width="100%" id="graph-div" height="100%" xmlns:xlink="http://www.w3.org/1999/xlink"><g><rect class="actor actor-bottom" ry="3" rx="3" name="APN" height="65" width="150" stroke="#666" fill="#eaeaea" y="1445" x="877"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="1477.5" x="952"><tspan dy="0" x="952">APN</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="N" height="65" width="150" stroke="#666" fill="#eaeaea" y="1445" x="648"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="1477.5" x="723"><tspan dy="0" x="723">NTF server</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="S" height="65" width="150" stroke="#666" fill="#eaeaea" y="1445" x="429"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="1477.5" x="504"><tspan dy="0" x="504">SMP server</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="1445" x="200"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="1477.5" x="275"><tspan dy="0" x="275">agent</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="C" height="65" width="150" stroke="#666" fill="#eaeaea" y="1445" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="1477.5" x="75"><tspan dy="0" x="75">client app</tspan></text></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="1445" x2="952" y1="5" x1="952" id="actor3147"></line><g id="root-3147"><rect class="actor actor-top" ry="3" rx="3" name="APN" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="877"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="952"><tspan dy="0" x="952">APN</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="1445" x2="723" y1="5" x1="723" id="actor3146"></line><g id="root-3146"><rect class="actor actor-top" ry="3" rx="3" name="N" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="648"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="723"><tspan dy="0" x="723">NTF server</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="1445" x2="504" y1="5" x1="504" id="actor3145"></line><g id="root-3145"><rect class="actor actor-top" ry="3" rx="3" name="S" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="429"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="504"><tspan dy="0" x="504">SMP server</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="1445" x2="275" y1="5" x1="275" id="actor3144"></line><g id="root-3144"><rect class="actor actor-top" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="200"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="275"><tspan dy="0" x="275">agent</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="1445" x2="75" y1="5" x1="75" id="actor3143"></line><g id="root-3143"><rect class="actor actor-top" ry="3" rx="3" name="C" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="75"><tspan dy="0" x="75">client app</tspan></text></g></g><style>#graph-div{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#graph-div .error-icon{fill:#552222;}#graph-div .error-text{fill:#552222;stroke:#552222;}#graph-div .edge-thickness-normal{stroke-width:2px;}#graph-div .edge-thickness-thick{stroke-width:3.5px;}#graph-div .edge-pattern-solid{stroke-dasharray:0;}#graph-div .edge-pattern-dashed{stroke-dasharray:3;}#graph-div .edge-pattern-dotted{stroke-dasharray:2;}#graph-div .marker{fill:#333333;stroke:#333333;}#graph-div .marker.cross{stroke:#333333;}#graph-div svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#graph-div .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div text.actor&gt;tspan{fill:black;stroke:none;}#graph-div .actor-line{stroke:grey;}#graph-div .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#graph-div .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#graph-div #arrowhead path{fill:#333;stroke:#333;}#graph-div .sequenceNumber{fill:white;}#graph-div #sequencenumber{fill:#333;}#graph-div #crosshead path{fill:#333;stroke:#333;}#graph-div .messageText{fill:#333;stroke:none;}#graph-div .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .labelText,#graph-div .labelText&gt;tspan{fill:black;stroke:none;}#graph-div .loopText,#graph-div .loopText&gt;tspan{fill:black;stroke:none;}#graph-div .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#graph-div .note{stroke:#aaaa33;fill:#fff5ad;}#graph-div .noteText,#graph-div .noteText&gt;tspan{fill:black;stroke:none;}#graph-div .activation0{fill:#f4f4f4;stroke:#666;}#graph-div .activation1{fill:#f4f4f4;stroke:#666;}#graph-div .activation2{fill:#f4f4f4;stroke:#666;}#graph-div .actorPopupMenu{position:absolute;}#graph-div .actorPopupMenuPanel{position:absolute;fill:#ECECFF;box-shadow:0px 8px 16px 0px rgba(0,0,0,0.2);filter:drop-shadow(3px 5px 2px rgb(0 0 0 / 0.4));}#graph-div .actor-man line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .actor-man circle,#graph-div line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;stroke-width:2px;}#graph-div :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g></g><defs><symbol height="24" width="24" id="computer"><path d="M2 2v13h20v-13h-20zm18 11h-16v-9h16v9zm-10.228 6l.466-1h3.524l.467 1h-4.457zm14.228 3h-24l2-6h2.104l-1.33 4h18.45l-1.297-4h2.073l2 6zm-5-10h-14v-7h14v7z" transform="scale(.5)"></path></symbol></defs><defs><symbol clip-rule="evenodd" fill-rule="evenodd" id="database"><path d="M12.258.001l.256.004.255.005.253.008.251.01.249.012.247.015.246.016.242.019.241.02.239.023.236.024.233.027.231.028.229.031.225.032.223.034.22.036.217.038.214.04.211.041.208.043.205.045.201.046.198.048.194.05.191.051.187.053.183.054.18.056.175.057.172.059.168.06.163.061.16.063.155.064.15.066.074.033.073.033.071.034.07.034.069.035.068.035.067.035.066.035.064.036.064.036.062.036.06.036.06.037.058.037.058.037.055.038.055.038.053.038.052.038.051.039.05.039.048.039.047.039.045.04.044.04.043.04.041.04.04.041.039.041.037.041.036.041.034.041.033.042.032.042.03.042.029.042.027.042.026.043.024.043.023.043.021.043.02.043.018.044.017.043.015.044.013.044.012.044.011.045.009.044.007.045.006.045.004.045.002.045.001.045v17l-.001.045-.002.045-.004.045-.006.045-.007.045-.009.044-.011.045-.012.044-.013.044-.015.044-.017.043-.018.044-.02.043-.021.043-.023.043-.024.043-.026.043-.027.042-.029.042-.03.042-.032.042-.033.042-.034.041-.036.041-.037.041-.039.041-.04.041-.041.04-.043.04-.044.04-.045.04-.047.039-.048.039-.05.039-.051.039-.052.038-.053.038-.055.038-.055.038-.058.037-.058.037-.06.037-.06.036-.062.036-.064.036-.064.036-.066.035-.067.035-.068.035-.069.035-.07.034-.071.034-.073.033-.074.033-.15.066-.155.064-.16.063-.163.061-.168.06-.172.059-.175.057-.18.056-.183.054-.187.053-.191.051-.194.05-.198.048-.201.046-.205.045-.208.043-.211.041-.214.04-.217.038-.22.036-.223.034-.225.032-.229.031-.231.028-.233.027-.236.024-.239.023-.241.02-.242.019-.246.016-.247.015-.249.012-.251.01-.253.008-.255.005-.256.004-.258.001-.258-.001-.256-.004-.255-.005-.253-.008-.251-.01-.249-.012-.247-.015-.245-.016-.243-.019-.241-.02-.238-.023-.236-.024-.234-.027-.231-.028-.228-.031-.226-.032-.223-.034-.22-.036-.217-.038-.214-.04-.211-.041-.208-.043-.204-.045-.201-.046-.198-.048-.195-.05-.19-.051-.187-.053-.184-.054-.179-.056-.176-.057-.172-.059-.167-.06-.164-.061-.159-.063-.155-.064-.151-.066-.074-.033-.072-.033-.072-.034-.07-.034-.069-.035-.068-.035-.067-.035-.066-.035-.064-.036-.063-.036-.062-.036-.061-.036-.06-.037-.058-.037-.057-.037-.056-.038-.055-.038-.053-.038-.052-.038-.051-.039-.049-.039-.049-.039-.046-.039-.046-.04-.044-.04-.043-.04-.041-.04-.04-.041-.039-.041-.037-.041-.036-.041-.034-.041-.033-.042-.032-.042-.03-.042-.029-.042-.027-.042-.026-.043-.024-.043-.023-.043-.021-.043-.02-.043-.018-.044-.017-.043-.015-.044-.013-.044-.012-.044-.011-.045-.009-.044-.007-.045-.006-.045-.004-.045-.002-.045-.001-.045v-17l.001-.045.002-.045.004-.045.006-.045.007-.045.009-.044.011-.045.012-.044.013-.044.015-.044.017-.043.018-.044.02-.043.021-.043.023-.043.024-.043.026-.043.027-.042.029-.042.03-.042.032-.042.033-.042.034-.041.036-.041.037-.041.039-.041.04-.041.041-.04.043-.04.044-.04.046-.04.046-.039.049-.039.049-.039.051-.039.052-.038.053-.038.055-.038.056-.038.057-.037.058-.037.06-.037.061-.036.062-.036.063-.036.064-.036.066-.035.067-.035.068-.035.069-.035.07-.034.072-.034.072-.033.074-.033.151-.066.155-.064.159-.063.164-.061.167-.06.172-.059.176-.057.179-.056.184-.054.187-.053.19-.051.195-.05.198-.048.201-.046.204-.045.208-.043.211-.041.214-.04.217-.038.22-.036.223-.034.226-.032.228-.031.231-.028.234-.027.236-.024.238-.023.241-.02.243-.019.245-.016.247-.015.249-.012.251-.01.253-.008.255-.005.256-.004.258-.001.258.001zm-9.258 20.499v.01l.001.021.003.021.004.022.005.021.006.022.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.023.018.024.019.024.021.024.022.025.023.024.024.025.052.049.056.05.061.051.066.051.07.051.075.051.079.052.084.052.088.052.092.052.097.052.102.051.105.052.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.048.144.049.147.047.152.047.155.047.16.045.163.045.167.043.171.043.176.041.178.041.183.039.187.039.19.037.194.035.197.035.202.033.204.031.209.03.212.029.216.027.219.025.222.024.226.021.23.02.233.018.236.016.24.015.243.012.246.01.249.008.253.005.256.004.259.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.021.224-.024.22-.026.216-.027.212-.028.21-.031.205-.031.202-.034.198-.034.194-.036.191-.037.187-.039.183-.04.179-.04.175-.042.172-.043.168-.044.163-.045.16-.046.155-.046.152-.047.148-.048.143-.049.139-.049.136-.05.131-.05.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.053.083-.051.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.05.023-.024.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.023.01-.022.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.127l-.077.055-.08.053-.083.054-.085.053-.087.052-.09.052-.093.051-.095.05-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.045-.118.044-.12.043-.122.042-.124.042-.126.041-.128.04-.13.04-.132.038-.134.038-.135.037-.138.037-.139.035-.142.035-.143.034-.144.033-.147.032-.148.031-.15.03-.151.03-.153.029-.154.027-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.01-.179.008-.179.008-.181.006-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.006-.179-.008-.179-.008-.178-.01-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.027-.153-.029-.151-.03-.15-.03-.148-.031-.146-.032-.145-.033-.143-.034-.141-.035-.14-.035-.137-.037-.136-.037-.134-.038-.132-.038-.13-.04-.128-.04-.126-.041-.124-.042-.122-.042-.12-.044-.117-.043-.116-.045-.113-.045-.112-.046-.109-.047-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.05-.093-.052-.09-.051-.087-.052-.085-.053-.083-.054-.08-.054-.077-.054v4.127zm0-5.654v.011l.001.021.003.021.004.021.005.022.006.022.007.022.009.022.01.022.011.023.012.023.013.023.015.024.016.023.017.024.018.024.019.024.021.024.022.024.023.025.024.024.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.052.11.051.114.051.119.052.123.05.127.051.131.05.135.049.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.044.171.042.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.022.23.02.233.018.236.016.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.012.241-.015.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.048.139-.05.136-.049.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.051.051-.049.023-.025.023-.024.021-.025.02-.024.019-.024.018-.024.017-.024.015-.023.014-.023.013-.024.012-.022.01-.023.01-.023.008-.022.006-.022.006-.022.004-.021.004-.022.001-.021.001-.021v-4.139l-.077.054-.08.054-.083.054-.085.052-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.044-.118.044-.12.044-.122.042-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.035-.143.033-.144.033-.147.033-.148.031-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.009-.179.009-.179.007-.181.007-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.007-.179-.007-.179-.009-.178-.009-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.031-.146-.033-.145-.033-.143-.033-.141-.035-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.04-.126-.041-.124-.042-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.051-.093-.051-.09-.051-.087-.053-.085-.052-.083-.054-.08-.054-.077-.054v4.139zm0-5.666v.011l.001.02.003.022.004.021.005.022.006.021.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.024.018.023.019.024.021.025.022.024.023.024.024.025.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.051.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.043.171.043.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.021.23.02.233.018.236.017.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.013.241-.014.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.049.139-.049.136-.049.131-.051.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.049.023-.025.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.022.01-.023.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.153l-.077.054-.08.054-.083.053-.085.053-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.048-.105.048-.106.048-.109.046-.111.046-.114.046-.115.044-.118.044-.12.043-.122.043-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.034-.143.034-.144.033-.147.032-.148.032-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.024-.161.024-.162.023-.163.023-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.01-.178.01-.179.009-.179.007-.181.006-.182.006-.182.004-.184.003-.184.001-.185.001-.185-.001-.184-.001-.184-.003-.182-.004-.182-.006-.181-.006-.179-.007-.179-.009-.178-.01-.176-.01-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.023-.162-.023-.161-.024-.159-.024-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.032-.146-.032-.145-.033-.143-.034-.141-.034-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.041-.126-.041-.124-.041-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.048-.105-.048-.102-.048-.1-.05-.097-.049-.095-.051-.093-.051-.09-.052-.087-.052-.085-.053-.083-.053-.08-.054-.077-.054v4.153zm8.74-8.179l-.257.004-.254.005-.25.008-.247.011-.244.012-.241.014-.237.016-.233.018-.231.021-.226.022-.224.023-.22.026-.216.027-.212.028-.21.031-.205.032-.202.033-.198.034-.194.036-.191.038-.187.038-.183.04-.179.041-.175.042-.172.043-.168.043-.163.045-.16.046-.155.046-.152.048-.148.048-.143.048-.139.049-.136.05-.131.05-.126.051-.123.051-.118.051-.114.052-.11.052-.106.052-.101.052-.096.052-.092.052-.088.052-.083.052-.079.052-.074.051-.07.052-.065.051-.06.05-.056.05-.051.05-.023.025-.023.024-.021.024-.02.025-.019.024-.018.024-.017.023-.015.024-.014.023-.013.023-.012.023-.01.023-.01.022-.008.022-.006.023-.006.021-.004.022-.004.021-.001.021-.001.021.001.021.001.021.004.021.004.022.006.021.006.023.008.022.01.022.01.023.012.023.013.023.014.023.015.024.017.023.018.024.019.024.02.025.021.024.023.024.023.025.051.05.056.05.06.05.065.051.07.052.074.051.079.052.083.052.088.052.092.052.096.052.101.052.106.052.11.052.114.052.118.051.123.051.126.051.131.05.136.05.139.049.143.048.148.048.152.048.155.046.16.046.163.045.168.043.172.043.175.042.179.041.183.04.187.038.191.038.194.036.198.034.202.033.205.032.21.031.212.028.216.027.22.026.224.023.226.022.231.021.233.018.237.016.241.014.244.012.247.011.25.008.254.005.257.004.26.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.022.224-.023.22-.026.216-.027.212-.028.21-.031.205-.032.202-.033.198-.034.194-.036.191-.038.187-.038.183-.04.179-.041.175-.042.172-.043.168-.043.163-.045.16-.046.155-.046.152-.048.148-.048.143-.048.139-.049.136-.05.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.05.051-.05.023-.025.023-.024.021-.024.02-.025.019-.024.018-.024.017-.023.015-.024.014-.023.013-.023.012-.023.01-.023.01-.022.008-.022.006-.023.006-.021.004-.022.004-.021.001-.021.001-.021-.001-.021-.001-.021-.004-.021-.004-.022-.006-.021-.006-.023-.008-.022-.01-.022-.01-.023-.012-.023-.013-.023-.014-.023-.015-.024-.017-.023-.018-.024-.019-.024-.02-.025-.021-.024-.023-.024-.023-.025-.051-.05-.056-.05-.06-.05-.065-.051-.07-.052-.074-.051-.079-.052-.083-.052-.088-.052-.092-.052-.096-.052-.101-.052-.106-.052-.11-.052-.114-.052-.118-.051-.123-.051-.126-.051-.131-.05-.136-.05-.139-.049-.143-.048-.148-.048-.152-.048-.155-.046-.16-.046-.163-.045-.168-.043-.172-.043-.175-.042-.179-.041-.183-.04-.187-.038-.191-.038-.194-.036-.198-.034-.202-.033-.205-.032-.21-.031-.212-.028-.216-.027-.22-.026-.224-.023-.226-.022-.231-.021-.233-.018-.237-.016-.241-.014-.244-.012-.247-.011-.25-.008-.254-.005-.257-.004-.26-.001-.26.001z" transform="scale(.5)"></path></symbol></defs><defs><symbol height="24" width="24" id="clock"><path d="M12 2c5.514 0 10 4.486 10 10s-4.486 10-10 10-10-4.486-10-10 4.486-10 10-10zm0-2c-6.627 0-12 5.373-12 12s5.373 12 12 12 12-5.373 12-12-5.373-12-12-12zm5.848 12.459c.202.038.202.333.001.372-1.907.361-6.045 1.111-6.547 1.111-.719 0-1.301-.582-1.301-1.301 0-.512.77-5.447 1.125-7.445.034-.192.312-.181.343.014l.985 6.238 5.394 1.011z" transform="scale(.5)"></path></symbol></defs><defs><marker orient="auto" markerHeight="12" markerWidth="12" markerUnits="userSpaceOnUse" refY="5" refX="7.9" id="arrowhead"><path d="M 0 0 L 10 5 L 0 10 z"></path></marker></defs><defs><marker refY="4.5" refX="4" orient="auto" markerHeight="8" markerWidth="15" id="crosshead"><path style="stroke-dasharray: 0, 0;" d="M 1,2 L 6,7 M 6,2 L 1,7" stroke-width="1pt" stroke="#000000" fill="none"></path></marker></defs><defs><marker orient="auto" markerHeight="28" markerWidth="20" refY="7" refX="15.5" id="filled-head"><path d="M 18,7 L9,13 L14,7 L9,1 Z"></path></marker></defs><defs><marker orient="auto" markerHeight="40" markerWidth="60" refY="15" refX="15" id="sequencenumber"><circle r="6" cy="15" cx="15"></circle></marker></defs><g><rect class="note" ry="0" rx="0" height="39" width="927" stroke="#666" fill="#EDF2AE" y="75" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="80" x="514"><tspan x="514">register subscription</tspan></text></g><g><rect class="note" ry="0" rx="0" height="76" width="279" stroke="#666" fill="#EDF2AE" y="310" x="250"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="315" x="390"><tspan x="390">...</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="334" x="390"><tspan x="390">Connection handshake</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="352" x="390"><tspan x="390">...</tspan></text></g><g><line class="loopLine" y2="124" x2="539" y1="124" x1="64"></line><line class="loopLine" y2="444" x2="539" y1="124" x1="539"></line><line class="loopLine" y2="444" x2="539" y1="444" x1="64"></line><line class="loopLine" y2="444" x2="64" y1="124" x1="64"></line><line style="stroke-dasharray: 3, 3;" class="loopLine" y2="222" x2="539" y1="222" x1="64"></line><polygon class="labelBox" points="64,124 114,124 114,137 105.6,144 64,144"></polygon><text style="font-size: 16px; font-weight: 400;" class="labelText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="137" x="89">alt</text><text style="font-size: 16px; font-weight: 400;" class="loopText" text-anchor="middle" y="142" x="326.5"><tspan x="326.5">[register existing]</tspan></text><text style="font-size: 16px; font-weight: 400;" class="loopText" text-anchor="middle" y="240" x="301.5">[create new connection]</text></g><g><rect class="note" ry="0" rx="0" height="39" width="927" stroke="#666" fill="#EDF2AE" y="761" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="766" x="514"><tspan x="514">notify about message</tspan></text></g><g><rect class="note" ry="0" rx="0" height="76" width="479" stroke="#666" fill="#EDF2AE" y="973" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="978" x="290"><tspan x="290">...</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="997" x="290"><tspan x="290">Client awaken, message is received</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1015" x="290"><tspan x="290">...</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="150" stroke="#666" fill="#EDF2AE" y="1107" x="0"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1112" x="75"><tspan x="75">show notification</tspan></text></g><g><rect class="note" ry="0" rx="0" height="39" width="927" stroke="#666" fill="#EDF2AE" y="1156" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1161" x="514"><tspan x="514">change APN token</tspan></text></g><g><rect class="note" ry="0" rx="0" height="76" width="698" stroke="#666" fill="#EDF2AE" y="1349" x="50"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1354" x="399"><tspan x="399">...</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1373" x="399"><tspan x="399">Verify token</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1391" x="399"><tspan x="399">...</tspan></text></g><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="174" x="174">registerToken</text><line style="stroke-dasharray: 3, 3; fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine1" y2="207" x2="271" y1="207" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="267" x="388">create/joinConnection</text><line style="stroke-dasharray: 3, 3; fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine1" y2="300" x2="500" y1="300" x1="276"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="401" x="391">CON</text><line style="stroke-dasharray: 3, 3; fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine1" y2="434" x2="279" y1="434" x1="503"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="459" x="388">NKEY nKey</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="492" x2="500" y1="492" x1="276"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="507" x="391">NID nId</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="540" x2="279" y1="540" x1="503"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="555" x="498">SNEW tknId dhKey (smpServer, nId, nKey)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="588" x2="719" y1="588" x1="276"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="603" x="501">ID subId dhKey</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="636" x2="279" y1="636" x1="722"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="651" x="615">NSUB nId</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="684" x2="508" y1="684" x1="722"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="699" x="612">OK / NMSG:</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="718" x="612">confirm subscription</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="751" x2="719" y1="751" x1="505"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="815" x="612">NMSG</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="848" x2="719" y1="848" x1="505"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="863" x="836">APNSMutableContent</text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="882" x="836">ntfQueue, nonce</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="915" x2="948" y1="915" x1="724"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="930" x="515">UNMutableNotificationContent</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="963" x2="79" y1="963" x1="951"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1064" x="291">message</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1097" x2="79" y1="1097" x1="503"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1210" x="515">new device token</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="1243" x2="79" y1="1243" x1="951"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1258" x="174">updateToken()</text><line style="stroke-dasharray: 3, 3; fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine1" y2="1291" x2="271" y1="1291" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="1306" x="498">TUPD tknId newDeviceToken</text><line style="stroke-dasharray: 3, 3; fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine1" y2="1339" x2="719" y1="1339" x1="276"></line></svg>
\ No newline at end of file
diff --git a/protocol/diagrams/simplex-messaging/simplex-creating-fast.mmd b/protocol/diagrams/simplex-messaging/simplex-creating-fast.mmd
new file mode 100644
index 000000000..48a59988d
--- /dev/null
+++ b/protocol/diagrams/simplex-messaging/simplex-creating-fast.mmd
@@ -0,0 +1,23 @@
+sequenceDiagram
+  participant B as Bob (sender)
+  participant S as server (queue RID)
+  participant A as Alice (recipient)
+
+  note over A: creating queue<br>("public" key RK<br>for msg retrieval)
+  A ->> S: 1. create queue ("NEW")
+  S ->> A: respond with queue RID and SID ("IDS")
+
+  note over A: out-of-band msg<br>(sender's queue SID<br>and "public" key EK<br>to encrypt msgs)
+  A -->> B: 2. send out-of-band message
+
+  note over B: secure queue<br>(with "public" key SK for<br>sending messages)
+  B ->> S: 3. confirm queue ("SKEY" command authorized with SK)
+
+  note over B: confirm queue<br>(public key<br>for e2e encryption<br>and any optional<br>encrypted info.)
+  B ->> S: 4. confirm queue ("SEND" command authorized with SK)
+
+  S ->> A: 5. deliver Bob's message (MSG)
+  note over A: decrypt message<br>("private" key EK)
+  A ->> S: acknowledge message (ACK)
+
+  note over S: 6. simplex<br>queue RID<br>is ready to use!
diff --git a/protocol/diagrams/simplex-messaging/simplex-creating-fast.svg b/protocol/diagrams/simplex-messaging/simplex-creating-fast.svg
new file mode 100644
index 000000000..37337435f
--- /dev/null
+++ b/protocol/diagrams/simplex-messaging/simplex-creating-fast.svg
@@ -0,0 +1,3 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<?xml-stylesheet href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.2/css/all.min.css" type="text/css"?>
+<svg aria-roledescription="sequence" role="graphics-document document" viewBox="-68 -10 1074.5 1059" style="max-width: 100%;" xmlns="http://www.w3.org/2000/svg" width="100%" id="graph-div" height="100%" xmlns:xlink="http://www.w3.org/1999/xlink"><g><rect class="actor actor-bottom" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="973" x="802"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="1005.5" x="877"><tspan dy="0" x="877">Alice (recipient)</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="S" height="65" width="150" stroke="#666" fill="#eaeaea" y="973" x="459"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="1005.5" x="534"><tspan dy="0" x="534">server (queue RID)</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="973" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="1005.5" x="75"><tspan dy="0" x="75">Bob (sender)</tspan></text></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="973" x2="877" y1="5" x1="877" id="actor515"></line><g id="root-515"><rect class="actor actor-top" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="802"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="877"><tspan dy="0" x="877">Alice (recipient)</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="973" x2="534" y1="5" x1="534" id="actor514"></line><g id="root-514"><rect class="actor actor-top" ry="3" rx="3" name="S" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="459"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="534"><tspan dy="0" x="534">server (queue RID)</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="973" x2="75" y1="5" x1="75" id="actor513"></line><g id="root-513"><rect class="actor actor-top" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="75"><tspan dy="0" x="75">Bob (sender)</tspan></text></g></g><style>#graph-div{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#graph-div .error-icon{fill:#552222;}#graph-div .error-text{fill:#552222;stroke:#552222;}#graph-div .edge-thickness-normal{stroke-width:2px;}#graph-div .edge-thickness-thick{stroke-width:3.5px;}#graph-div .edge-pattern-solid{stroke-dasharray:0;}#graph-div .edge-pattern-dashed{stroke-dasharray:3;}#graph-div .edge-pattern-dotted{stroke-dasharray:2;}#graph-div .marker{fill:#333333;stroke:#333333;}#graph-div .marker.cross{stroke:#333333;}#graph-div svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#graph-div .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div text.actor&gt;tspan{fill:black;stroke:none;}#graph-div .actor-line{stroke:grey;}#graph-div .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#graph-div .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#graph-div #arrowhead path{fill:#333;stroke:#333;}#graph-div .sequenceNumber{fill:white;}#graph-div #sequencenumber{fill:#333;}#graph-div #crosshead path{fill:#333;stroke:#333;}#graph-div .messageText{fill:#333;stroke:none;}#graph-div .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .labelText,#graph-div .labelText&gt;tspan{fill:black;stroke:none;}#graph-div .loopText,#graph-div .loopText&gt;tspan{fill:black;stroke:none;}#graph-div .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#graph-div .note{stroke:#aaaa33;fill:#fff5ad;}#graph-div .noteText,#graph-div .noteText&gt;tspan{fill:black;stroke:none;}#graph-div .activation0{fill:#f4f4f4;stroke:#666;}#graph-div .activation1{fill:#f4f4f4;stroke:#666;}#graph-div .activation2{fill:#f4f4f4;stroke:#666;}#graph-div .actorPopupMenu{position:absolute;}#graph-div .actorPopupMenuPanel{position:absolute;fill:#ECECFF;box-shadow:0px 8px 16px 0px rgba(0,0,0,0.2);filter:drop-shadow(3px 5px 2px rgb(0 0 0 / 0.4));}#graph-div .actor-man line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .actor-man circle,#graph-div line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;stroke-width:2px;}#graph-div :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g></g><defs><symbol height="24" width="24" id="computer"><path d="M2 2v13h20v-13h-20zm18 11h-16v-9h16v9zm-10.228 6l.466-1h3.524l.467 1h-4.457zm14.228 3h-24l2-6h2.104l-1.33 4h18.45l-1.297-4h2.073l2 6zm-5-10h-14v-7h14v7z" transform="scale(.5)"></path></symbol></defs><defs><symbol clip-rule="evenodd" fill-rule="evenodd" id="database"><path d="M12.258.001l.256.004.255.005.253.008.251.01.249.012.247.015.246.016.242.019.241.02.239.023.236.024.233.027.231.028.229.031.225.032.223.034.22.036.217.038.214.04.211.041.208.043.205.045.201.046.198.048.194.05.191.051.187.053.183.054.18.056.175.057.172.059.168.06.163.061.16.063.155.064.15.066.074.033.073.033.071.034.07.034.069.035.068.035.067.035.066.035.064.036.064.036.062.036.06.036.06.037.058.037.058.037.055.038.055.038.053.038.052.038.051.039.05.039.048.039.047.039.045.04.044.04.043.04.041.04.04.041.039.041.037.041.036.041.034.041.033.042.032.042.03.042.029.042.027.042.026.043.024.043.023.043.021.043.02.043.018.044.017.043.015.044.013.044.012.044.011.045.009.044.007.045.006.045.004.045.002.045.001.045v17l-.001.045-.002.045-.004.045-.006.045-.007.045-.009.044-.011.045-.012.044-.013.044-.015.044-.017.043-.018.044-.02.043-.021.043-.023.043-.024.043-.026.043-.027.042-.029.042-.03.042-.032.042-.033.042-.034.041-.036.041-.037.041-.039.041-.04.041-.041.04-.043.04-.044.04-.045.04-.047.039-.048.039-.05.039-.051.039-.052.038-.053.038-.055.038-.055.038-.058.037-.058.037-.06.037-.06.036-.062.036-.064.036-.064.036-.066.035-.067.035-.068.035-.069.035-.07.034-.071.034-.073.033-.074.033-.15.066-.155.064-.16.063-.163.061-.168.06-.172.059-.175.057-.18.056-.183.054-.187.053-.191.051-.194.05-.198.048-.201.046-.205.045-.208.043-.211.041-.214.04-.217.038-.22.036-.223.034-.225.032-.229.031-.231.028-.233.027-.236.024-.239.023-.241.02-.242.019-.246.016-.247.015-.249.012-.251.01-.253.008-.255.005-.256.004-.258.001-.258-.001-.256-.004-.255-.005-.253-.008-.251-.01-.249-.012-.247-.015-.245-.016-.243-.019-.241-.02-.238-.023-.236-.024-.234-.027-.231-.028-.228-.031-.226-.032-.223-.034-.22-.036-.217-.038-.214-.04-.211-.041-.208-.043-.204-.045-.201-.046-.198-.048-.195-.05-.19-.051-.187-.053-.184-.054-.179-.056-.176-.057-.172-.059-.167-.06-.164-.061-.159-.063-.155-.064-.151-.066-.074-.033-.072-.033-.072-.034-.07-.034-.069-.035-.068-.035-.067-.035-.066-.035-.064-.036-.063-.036-.062-.036-.061-.036-.06-.037-.058-.037-.057-.037-.056-.038-.055-.038-.053-.038-.052-.038-.051-.039-.049-.039-.049-.039-.046-.039-.046-.04-.044-.04-.043-.04-.041-.04-.04-.041-.039-.041-.037-.041-.036-.041-.034-.041-.033-.042-.032-.042-.03-.042-.029-.042-.027-.042-.026-.043-.024-.043-.023-.043-.021-.043-.02-.043-.018-.044-.017-.043-.015-.044-.013-.044-.012-.044-.011-.045-.009-.044-.007-.045-.006-.045-.004-.045-.002-.045-.001-.045v-17l.001-.045.002-.045.004-.045.006-.045.007-.045.009-.044.011-.045.012-.044.013-.044.015-.044.017-.043.018-.044.02-.043.021-.043.023-.043.024-.043.026-.043.027-.042.029-.042.03-.042.032-.042.033-.042.034-.041.036-.041.037-.041.039-.041.04-.041.041-.04.043-.04.044-.04.046-.04.046-.039.049-.039.049-.039.051-.039.052-.038.053-.038.055-.038.056-.038.057-.037.058-.037.06-.037.061-.036.062-.036.063-.036.064-.036.066-.035.067-.035.068-.035.069-.035.07-.034.072-.034.072-.033.074-.033.151-.066.155-.064.159-.063.164-.061.167-.06.172-.059.176-.057.179-.056.184-.054.187-.053.19-.051.195-.05.198-.048.201-.046.204-.045.208-.043.211-.041.214-.04.217-.038.22-.036.223-.034.226-.032.228-.031.231-.028.234-.027.236-.024.238-.023.241-.02.243-.019.245-.016.247-.015.249-.012.251-.01.253-.008.255-.005.256-.004.258-.001.258.001zm-9.258 20.499v.01l.001.021.003.021.004.022.005.021.006.022.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.023.018.024.019.024.021.024.022.025.023.024.024.025.052.049.056.05.061.051.066.051.07.051.075.051.079.052.084.052.088.052.092.052.097.052.102.051.105.052.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.048.144.049.147.047.152.047.155.047.16.045.163.045.167.043.171.043.176.041.178.041.183.039.187.039.19.037.194.035.197.035.202.033.204.031.209.03.212.029.216.027.219.025.222.024.226.021.23.02.233.018.236.016.24.015.243.012.246.01.249.008.253.005.256.004.259.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.021.224-.024.22-.026.216-.027.212-.028.21-.031.205-.031.202-.034.198-.034.194-.036.191-.037.187-.039.183-.04.179-.04.175-.042.172-.043.168-.044.163-.045.16-.046.155-.046.152-.047.148-.048.143-.049.139-.049.136-.05.131-.05.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.053.083-.051.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.05.023-.024.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.023.01-.022.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.127l-.077.055-.08.053-.083.054-.085.053-.087.052-.09.052-.093.051-.095.05-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.045-.118.044-.12.043-.122.042-.124.042-.126.041-.128.04-.13.04-.132.038-.134.038-.135.037-.138.037-.139.035-.142.035-.143.034-.144.033-.147.032-.148.031-.15.03-.151.03-.153.029-.154.027-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.01-.179.008-.179.008-.181.006-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.006-.179-.008-.179-.008-.178-.01-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.027-.153-.029-.151-.03-.15-.03-.148-.031-.146-.032-.145-.033-.143-.034-.141-.035-.14-.035-.137-.037-.136-.037-.134-.038-.132-.038-.13-.04-.128-.04-.126-.041-.124-.042-.122-.042-.12-.044-.117-.043-.116-.045-.113-.045-.112-.046-.109-.047-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.05-.093-.052-.09-.051-.087-.052-.085-.053-.083-.054-.08-.054-.077-.054v4.127zm0-5.654v.011l.001.021.003.021.004.021.005.022.006.022.007.022.009.022.01.022.011.023.012.023.013.023.015.024.016.023.017.024.018.024.019.024.021.024.022.024.023.025.024.024.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.052.11.051.114.051.119.052.123.05.127.051.131.05.135.049.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.044.171.042.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.022.23.02.233.018.236.016.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.012.241-.015.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.048.139-.05.136-.049.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.051.051-.049.023-.025.023-.024.021-.025.02-.024.019-.024.018-.024.017-.024.015-.023.014-.023.013-.024.012-.022.01-.023.01-.023.008-.022.006-.022.006-.022.004-.021.004-.022.001-.021.001-.021v-4.139l-.077.054-.08.054-.083.054-.085.052-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.044-.118.044-.12.044-.122.042-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.035-.143.033-.144.033-.147.033-.148.031-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.009-.179.009-.179.007-.181.007-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.007-.179-.007-.179-.009-.178-.009-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.031-.146-.033-.145-.033-.143-.033-.141-.035-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.04-.126-.041-.124-.042-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.051-.093-.051-.09-.051-.087-.053-.085-.052-.083-.054-.08-.054-.077-.054v4.139zm0-5.666v.011l.001.02.003.022.004.021.005.022.006.021.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.024.018.023.019.024.021.025.022.024.023.024.024.025.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.051.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.043.171.043.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.021.23.02.233.018.236.017.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.013.241-.014.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.049.139-.049.136-.049.131-.051.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.049.023-.025.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.022.01-.023.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.153l-.077.054-.08.054-.083.053-.085.053-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.048-.105.048-.106.048-.109.046-.111.046-.114.046-.115.044-.118.044-.12.043-.122.043-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.034-.143.034-.144.033-.147.032-.148.032-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.024-.161.024-.162.023-.163.023-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.01-.178.01-.179.009-.179.007-.181.006-.182.006-.182.004-.184.003-.184.001-.185.001-.185-.001-.184-.001-.184-.003-.182-.004-.182-.006-.181-.006-.179-.007-.179-.009-.178-.01-.176-.01-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.023-.162-.023-.161-.024-.159-.024-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.032-.146-.032-.145-.033-.143-.034-.141-.034-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.041-.126-.041-.124-.041-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.048-.105-.048-.102-.048-.1-.05-.097-.049-.095-.051-.093-.051-.09-.052-.087-.052-.085-.053-.083-.053-.08-.054-.077-.054v4.153zm8.74-8.179l-.257.004-.254.005-.25.008-.247.011-.244.012-.241.014-.237.016-.233.018-.231.021-.226.022-.224.023-.22.026-.216.027-.212.028-.21.031-.205.032-.202.033-.198.034-.194.036-.191.038-.187.038-.183.04-.179.041-.175.042-.172.043-.168.043-.163.045-.16.046-.155.046-.152.048-.148.048-.143.048-.139.049-.136.05-.131.05-.126.051-.123.051-.118.051-.114.052-.11.052-.106.052-.101.052-.096.052-.092.052-.088.052-.083.052-.079.052-.074.051-.07.052-.065.051-.06.05-.056.05-.051.05-.023.025-.023.024-.021.024-.02.025-.019.024-.018.024-.017.023-.015.024-.014.023-.013.023-.012.023-.01.023-.01.022-.008.022-.006.023-.006.021-.004.022-.004.021-.001.021-.001.021.001.021.001.021.004.021.004.022.006.021.006.023.008.022.01.022.01.023.012.023.013.023.014.023.015.024.017.023.018.024.019.024.02.025.021.024.023.024.023.025.051.05.056.05.06.05.065.051.07.052.074.051.079.052.083.052.088.052.092.052.096.052.101.052.106.052.11.052.114.052.118.051.123.051.126.051.131.05.136.05.139.049.143.048.148.048.152.048.155.046.16.046.163.045.168.043.172.043.175.042.179.041.183.04.187.038.191.038.194.036.198.034.202.033.205.032.21.031.212.028.216.027.22.026.224.023.226.022.231.021.233.018.237.016.241.014.244.012.247.011.25.008.254.005.257.004.26.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.022.224-.023.22-.026.216-.027.212-.028.21-.031.205-.032.202-.033.198-.034.194-.036.191-.038.187-.038.183-.04.179-.041.175-.042.172-.043.168-.043.163-.045.16-.046.155-.046.152-.048.148-.048.143-.048.139-.049.136-.05.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.05.051-.05.023-.025.023-.024.021-.024.02-.025.019-.024.018-.024.017-.023.015-.024.014-.023.013-.023.012-.023.01-.023.01-.022.008-.022.006-.023.006-.021.004-.022.004-.021.001-.021.001-.021-.001-.021-.001-.021-.004-.021-.004-.022-.006-.021-.006-.023-.008-.022-.01-.022-.01-.023-.012-.023-.013-.023-.014-.023-.015-.024-.017-.023-.018-.024-.019-.024-.02-.025-.021-.024-.023-.024-.023-.025-.051-.05-.056-.05-.06-.05-.065-.051-.07-.052-.074-.051-.079-.052-.083-.052-.088-.052-.092-.052-.096-.052-.101-.052-.106-.052-.11-.052-.114-.052-.118-.051-.123-.051-.126-.051-.131-.05-.136-.05-.139-.049-.143-.048-.148-.048-.152-.048-.155-.046-.16-.046-.163-.045-.168-.043-.172-.043-.175-.042-.179-.041-.183-.04-.187-.038-.191-.038-.194-.036-.198-.034-.202-.033-.205-.032-.21-.031-.212-.028-.216-.027-.22-.026-.224-.023-.226-.022-.231-.021-.233-.018-.237-.016-.241-.014-.244-.012-.247-.011-.25-.008-.254-.005-.257-.004-.26-.001-.26.001z" transform="scale(.5)"></path></symbol></defs><defs><symbol height="24" width="24" id="clock"><path d="M12 2c5.514 0 10 4.486 10 10s-4.486 10-10 10-10-4.486-10-10 4.486-10 10-10zm0-2c-6.627 0-12 5.373-12 12s5.373 12 12 12 12-5.373 12-12-5.373-12-12-12zm5.848 12.459c.202.038.202.333.001.372-1.907.361-6.045 1.111-6.547 1.111-.719 0-1.301-.582-1.301-1.301 0-.512.77-5.447 1.125-7.445.034-.192.312-.181.343.014l.985 6.238 5.394 1.011z" transform="scale(.5)"></path></symbol></defs><defs><marker orient="auto" markerHeight="12" markerWidth="12" markerUnits="userSpaceOnUse" refY="5" refX="7.9" id="arrowhead"><path d="M 0 0 L 10 5 L 0 10 z"></path></marker></defs><defs><marker refY="4.5" refX="4" orient="auto" markerHeight="8" markerWidth="15" id="crosshead"><path style="stroke-dasharray: 0, 0;" d="M 1,2 L 6,7 M 6,2 L 1,7" stroke-width="1pt" stroke="#000000" fill="none"></path></marker></defs><defs><marker orient="auto" markerHeight="28" markerWidth="20" refY="7" refX="15.5" id="filled-head"><path d="M 18,7 L9,13 L14,7 L9,1 Z"></path></marker></defs><defs><marker orient="auto" markerHeight="40" markerWidth="60" refY="15" refX="15" id="sequencenumber"><circle r="6" cy="15" cx="15"></circle></marker></defs><g><rect class="note" ry="0" rx="0" height="76" width="150" stroke="#666" fill="#EDF2AE" y="75" x="802"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="80" x="877"><tspan x="877">creating queue</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="99" x="877"><tspan x="877">("public" key RK</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="117" x="877"><tspan x="877">for msg retrieval)</tspan></text></g><g><rect class="note" ry="0" rx="0" height="94" width="159" stroke="#666" fill="#EDF2AE" y="257" x="797.5"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="262" x="877"><tspan x="877">out-of-band msg</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="281" x="877"><tspan x="877">(sender's queue SID</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="299" x="877"><tspan x="877">and "public" key EK</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="318" x="877"><tspan x="877">to encrypt msgs)</tspan></text></g><g><rect class="note" ry="0" rx="0" height="76" width="186" stroke="#666" fill="#EDF2AE" y="409" x="-18"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="414" x="75"><tspan x="75">secure queue</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="433" x="75"><tspan x="75">(with "public" key SK for</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="451" x="75"><tspan x="75">sending messages)</tspan></text></g><g><rect class="note" ry="0" rx="0" height="113" width="150" stroke="#666" fill="#EDF2AE" y="543" x="0"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="548" x="75"><tspan x="75">confirm queue</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="567" x="75"><tspan x="75">(public key</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="585" x="75"><tspan x="75">for e2e encryption</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="604" x="75"><tspan x="75">and any optional</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="622" x="75"><tspan x="75">encrypted info.)</tspan></text></g><g><rect class="note" ry="0" rx="0" height="57" width="150" stroke="#666" fill="#EDF2AE" y="762" x="802"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="767" x="877"><tspan x="877">decrypt message</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="786" x="877"><tspan x="877">("private" key EK)</tspan></text></g><g><rect class="note" ry="0" rx="0" height="76" width="150" stroke="#666" fill="#EDF2AE" y="877" x="459"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="882" x="534"><tspan x="534">6. simplex</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="901" x="534"><tspan x="534">queue RID</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="919" x="534"><tspan x="534">is ready to use!</tspan></text></g><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="166" x="707">1. create queue ("NEW")</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="199" x2="538" y1="199" x1="876"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="214" x="704">respond with queue RID and SID ("IDS")</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="247" x2="873" y1="247" x1="535"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="366" x="478">2. send out-of-band message</text><line style="stroke-dasharray: 3, 3; fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine1" y2="399" x2="79" y1="399" x1="876"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="500" x="303">3. confirm queue ("SKEY" command authorized with SK)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="533" x2="530" y1="533" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="671" x="303">4. confirm queue ("SEND" command authorized with SK)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="704" x2="530" y1="704" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="719" x="704">5. deliver Bob's message (MSG)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="752" x2="873" y1="752" x1="535"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="834" x="707">acknowledge message (ACK)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="867" x2="538" y1="867" x1="876"></line></svg>
\ No newline at end of file
diff --git a/protocol/diagrams/simplex-messaging/simplex-creating.mmd b/protocol/diagrams/simplex-messaging/simplex-creating.mmd
index 5116c3bed..f38c174e8 100644
--- a/protocol/diagrams/simplex-messaging/simplex-creating.mmd
+++ b/protocol/diagrams/simplex-messaging/simplex-creating.mmd
@@ -10,11 +10,13 @@ sequenceDiagram
   note over A: out-of-band msg<br>(sender's queue SID<br>and "public" key EK<br>to encrypt msgs)
   A -->> B: 2. send out-of-band message
 
-  note over B: confirm queue<br>("public" key SK for<br>sending messages<br>and any optional<br>info encrypted with<br>"public" key EK)
+  note over B: confirm queue<br>("public" key SK for<br>sending messages,<br>public key for<br>e2e encryption<br>and any optional<br>encrypted info)
   B ->> S: 3. confirm queue ("SEND" command not signed)
 
-  S ->> A: 4. deliver Bob's message
+  S ->> A: 4. deliver Bob's message (MSG)
   note over A: decrypt message<br>("private" key EK)
+  A ->> S: acknowledge message (ACK)
+
   A ->> S: 5. secure queue ("KEY", RK-signed)
 
   note over S: 6. simplex<br>queue RID<br>is ready to use!
diff --git a/protocol/diagrams/simplex-messaging/simplex-creating.svg b/protocol/diagrams/simplex-messaging/simplex-creating.svg
index 325fbb6cf..33dd288b3 100644
--- a/protocol/diagrams/simplex-messaging/simplex-creating.svg
+++ b/protocol/diagrams/simplex-messaging/simplex-creating.svg
@@ -1 +1,3 @@
-<svg id="mermaid-1603362111631" width="100%" xmlns="http://www.w3.org/2000/svg" height="875" style="max-width: 1006px;" viewBox="-50 -10 1006 875"><style>#mermaid-1603362111631{font-family:"trebuchet ms",verdana,arial;font-size:16px;fill:#333;}#mermaid-1603362111631 .error-icon{fill:#552222;}#mermaid-1603362111631 .error-text{fill:#552222;stroke:#552222;}#mermaid-1603362111631 .edge-thickness-normal{stroke-width:2px;}#mermaid-1603362111631 .edge-thickness-thick{stroke-width:3.5px;}#mermaid-1603362111631 .edge-pattern-solid{stroke-dasharray:0;}#mermaid-1603362111631 .edge-pattern-dashed{stroke-dasharray:3;}#mermaid-1603362111631 .edge-pattern-dotted{stroke-dasharray:2;}#mermaid-1603362111631 .marker{fill:#333333;}#mermaid-1603362111631 .marker.cross{stroke:#333333;}#mermaid-1603362111631 svg{font-family:"trebuchet ms",verdana,arial;font-size:16px;}#mermaid-1603362111631 .actor{stroke:hsl(259.6261682243,59.7765363128%,87.9019607843%);fill:#ECECFF;}#mermaid-1603362111631 text.actor &gt; tspan{fill:black;stroke:none;}#mermaid-1603362111631 .actor-line{stroke:grey;}#mermaid-1603362111631 .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#mermaid-1603362111631 .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#mermaid-1603362111631 #arrowhead path{fill:#333;stroke:#333;}#mermaid-1603362111631 .sequenceNumber{fill:white;}#mermaid-1603362111631 #sequencenumber{fill:#333;}#mermaid-1603362111631 #crosshead path{fill:#333;stroke:#333;}#mermaid-1603362111631 .messageText{fill:#333;stroke:#333;}#mermaid-1603362111631 .labelBox{stroke:hsl(259.6261682243,59.7765363128%,87.9019607843%);fill:#ECECFF;}#mermaid-1603362111631 .labelText,#mermaid-1603362111631 .labelText &gt; tspan{fill:black;stroke:none;}#mermaid-1603362111631 .loopText,#mermaid-1603362111631 .loopText &gt; tspan{fill:black;stroke:none;}#mermaid-1603362111631 .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243,59.7765363128%,87.9019607843%);fill:hsl(259.6261682243,59.7765363128%,87.9019607843%);}#mermaid-1603362111631 .note{stroke:#aaaa33;fill:#fff5ad;}#mermaid-1603362111631 .noteText,#mermaid-1603362111631 .noteText &gt; tspan{fill:black;stroke:none;}#mermaid-1603362111631 .activation0{fill:#f4f4f4;stroke:#666;}#mermaid-1603362111631 .activation1{fill:#f4f4f4;stroke:#666;}#mermaid-1603362111631 .activation2{fill:#f4f4f4;stroke:#666;}#mermaid-1603362111631:root{--mermaid-font-family:"trebuchet ms",verdana,arial;}#mermaid-1603362111631 sequence{fill:apa;}</style><g></g><g><line id="actor612" x1="75" y1="5" x2="75" y2="864" class="actor-line" stroke-width="0.5px" stroke="#999"></line><rect x="0" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="75" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="75" dy="0">Bob (sender)</tspan></text></g><g><line id="actor613" x1="484" y1="5" x2="484" y2="864" class="actor-line" stroke-width="0.5px" stroke="#999"></line><rect x="409" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="484" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="484" dy="0">server (queue RID)</tspan></text></g><g><line id="actor614" x1="831" y1="5" x2="831" y2="864" class="actor-line" stroke-width="0.5px" stroke="#999"></line><rect x="756" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="831" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="831" dy="0">Alice (recipient)</tspan></text></g><defs><marker id="arrowhead" refX="5" refY="2" markerWidth="6" markerHeight="4" orient="auto"><path d="M 0,0 V 4 L6,2 Z"></path></marker></defs><defs><marker id="crosshead" markerWidth="15" markerHeight="8" orient="auto" refX="16" refY="4"><path fill="black" stroke="#000000" stroke-width="1px" d="M 9,2 V 6 L16,4 Z" style="stroke-dasharray: 0, 0;"></path><path fill="none" stroke="#000000" stroke-width="1px" d="M 0,1 L 6,7 M 6,1 L 0,7" style="stroke-dasharray: 0, 0;"></path></marker></defs><defs><marker id="sequencenumber" refX="15" refY="15" markerWidth="60" markerHeight="40" orient="auto"><circle cx="15" cy="15" r="6"></circle></marker></defs><g><rect x="756" y="75" fill="#EDF2AE" stroke="#666" width="150" height="68" rx="0" ry="0" class="note"></rect><text x="831" y="80" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="831">creating queue</tspan></text><text x="831" y="96" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="831">("public" key RK</tspan></text><text x="831" y="112" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="831">for msg retrieval)</tspan></text></g><text x="658" y="158" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 16px; font-weight: 400;">1. create queue ("NEW")</text><line x1="831" y1="189" x2="484" y2="189" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><text x="658" y="204" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 16px; font-weight: 400;">respond with queue RID and SID ("IDS")</text><line x1="484" y1="235" x2="831" y2="235" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="756" y="245" fill="#EDF2AE" stroke="#666" width="150" height="84" rx="0" ry="0" class="note"></rect><text x="831" y="250" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="831">out-of-band msg</tspan></text><text x="831" y="266" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="831">(sender's queue SID</tspan></text><text x="831" y="282" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="831">and "public" key EK</tspan></text><text x="831" y="298" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="831">to encrypt msgs)</tspan></text></g><text x="453" y="344" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 16px; font-weight: 400;">2. send out-of-band message</text><line x1="831" y1="375" x2="75" y2="375" class="messageLine1" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="stroke-dasharray: 3, 3; fill: none;"></line><g><rect x="0" y="385" fill="#EDF2AE" stroke="#666" width="150" height="116" rx="0" ry="0" class="note"></rect><text x="75" y="390" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="75">confirm queue</tspan></text><text x="75" y="406" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="75">("public" key SK for</tspan></text><text x="75" y="422" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="75">sending messages</tspan></text><text x="75" y="438" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="75">and any optional</tspan></text><text x="75" y="454" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="75">info encrypted with</tspan></text><text x="75" y="470" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="75">"public" key EK)</tspan></text></g><text x="280" y="516" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 16px; font-weight: 400;">3. confirm queue ("SEND" command not signed)</text><line x1="75" y1="547" x2="484" y2="547" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><text x="658" y="562" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 16px; font-weight: 400;">4. deliver Bob's message</text><line x1="484" y1="593" x2="831" y2="593" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="756" y="603" fill="#EDF2AE" stroke="#666" width="150" height="52" rx="0" ry="0" class="note"></rect><text x="831" y="608" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="831">decrypt message</tspan></text><text x="831" y="624" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="831">("private" key EK)</tspan></text></g><text x="658" y="670" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 16px; font-weight: 400;">5. secure queue ("KEY", RK-signed)</text><line x1="831" y1="701" x2="484" y2="701" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"></line><g><rect x="409" y="711" fill="#EDF2AE" stroke="#666" width="150" height="68" rx="0" ry="0" class="note"></rect><text x="484" y="716" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="484">6. simplex</tspan></text><text x="484" y="732" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="484">queue RID</tspan></text><text x="484" y="748" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-family: &quot;trebuchet ms&quot;, verdana, arial; font-size: 14px; font-weight: 400;"><tspan x="484">is ready to use!</tspan></text></g><g><rect x="0" y="799" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="75" y="831.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="75" dy="0">Bob (sender)</tspan></text></g><g><rect x="409" y="799" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="484" y="831.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="484" dy="0">server (queue RID)</tspan></text></g><g><rect x="756" y="799" fill="#eaeaea" stroke="#666" width="150" height="65" rx="3" ry="3" class="actor"></rect><text x="831" y="831.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 14px; font-weight: 400; font-family: Open-Sans, sans-serif;"><tspan x="831" dy="0">Alice (recipient)</tspan></text></g></svg>
\ No newline at end of file
+<?xml version="1.0" encoding="UTF-8"?>
+<?xml-stylesheet href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.2/css/all.min.css" type="text/css"?>
+<svg aria-roledescription="sequence" role="graphics-document document" viewBox="-52 -10 1001.5 1010" style="max-width: 100%;" xmlns="http://www.w3.org/2000/svg" width="100%" id="graph-div" height="100%" xmlns:xlink="http://www.w3.org/1999/xlink"><g><rect class="actor actor-bottom" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="924" x="745"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="956.5" x="820"><tspan dy="0" x="820">Alice (recipient)</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="S" height="65" width="150" stroke="#666" fill="#eaeaea" y="924" x="402"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="956.5" x="477"><tspan dy="0" x="477">server (queue RID)</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="924" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="956.5" x="75"><tspan dy="0" x="75">Bob (sender)</tspan></text></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="924" x2="820" y1="5" x1="820" id="actor488"></line><g id="root-488"><rect class="actor actor-top" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="745"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="820"><tspan dy="0" x="820">Alice (recipient)</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="924" x2="477" y1="5" x1="477" id="actor487"></line><g id="root-487"><rect class="actor actor-top" ry="3" rx="3" name="S" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="402"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="477"><tspan dy="0" x="477">server (queue RID)</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="924" x2="75" y1="5" x1="75" id="actor486"></line><g id="root-486"><rect class="actor actor-top" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="0"></rect><text style="text-anchor: middle; font-size: 16px; font-weight: 400;" class="actor" alignment-baseline="central" dominant-baseline="central" y="32.5" x="75"><tspan dy="0" x="75">Bob (sender)</tspan></text></g></g><style>#graph-div{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#graph-div .error-icon{fill:#552222;}#graph-div .error-text{fill:#552222;stroke:#552222;}#graph-div .edge-thickness-normal{stroke-width:2px;}#graph-div .edge-thickness-thick{stroke-width:3.5px;}#graph-div .edge-pattern-solid{stroke-dasharray:0;}#graph-div .edge-pattern-dashed{stroke-dasharray:3;}#graph-div .edge-pattern-dotted{stroke-dasharray:2;}#graph-div .marker{fill:#333333;stroke:#333333;}#graph-div .marker.cross{stroke:#333333;}#graph-div svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#graph-div .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div text.actor&gt;tspan{fill:black;stroke:none;}#graph-div .actor-line{stroke:grey;}#graph-div .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#graph-div .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#graph-div #arrowhead path{fill:#333;stroke:#333;}#graph-div .sequenceNumber{fill:white;}#graph-div #sequencenumber{fill:#333;}#graph-div #crosshead path{fill:#333;stroke:#333;}#graph-div .messageText{fill:#333;stroke:none;}#graph-div .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .labelText,#graph-div .labelText&gt;tspan{fill:black;stroke:none;}#graph-div .loopText,#graph-div .loopText&gt;tspan{fill:black;stroke:none;}#graph-div .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#graph-div .note{stroke:#aaaa33;fill:#fff5ad;}#graph-div .noteText,#graph-div .noteText&gt;tspan{fill:black;stroke:none;}#graph-div .activation0{fill:#f4f4f4;stroke:#666;}#graph-div .activation1{fill:#f4f4f4;stroke:#666;}#graph-div .activation2{fill:#f4f4f4;stroke:#666;}#graph-div .actorPopupMenu{position:absolute;}#graph-div .actorPopupMenuPanel{position:absolute;fill:#ECECFF;box-shadow:0px 8px 16px 0px rgba(0,0,0,0.2);filter:drop-shadow(3px 5px 2px rgb(0 0 0 / 0.4));}#graph-div .actor-man line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .actor-man circle,#graph-div line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;stroke-width:2px;}#graph-div :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g></g><defs><symbol height="24" width="24" id="computer"><path d="M2 2v13h20v-13h-20zm18 11h-16v-9h16v9zm-10.228 6l.466-1h3.524l.467 1h-4.457zm14.228 3h-24l2-6h2.104l-1.33 4h18.45l-1.297-4h2.073l2 6zm-5-10h-14v-7h14v7z" transform="scale(.5)"></path></symbol></defs><defs><symbol clip-rule="evenodd" fill-rule="evenodd" id="database"><path d="M12.258.001l.256.004.255.005.253.008.251.01.249.012.247.015.246.016.242.019.241.02.239.023.236.024.233.027.231.028.229.031.225.032.223.034.22.036.217.038.214.04.211.041.208.043.205.045.201.046.198.048.194.05.191.051.187.053.183.054.18.056.175.057.172.059.168.06.163.061.16.063.155.064.15.066.074.033.073.033.071.034.07.034.069.035.068.035.067.035.066.035.064.036.064.036.062.036.06.036.06.037.058.037.058.037.055.038.055.038.053.038.052.038.051.039.05.039.048.039.047.039.045.04.044.04.043.04.041.04.04.041.039.041.037.041.036.041.034.041.033.042.032.042.03.042.029.042.027.042.026.043.024.043.023.043.021.043.02.043.018.044.017.043.015.044.013.044.012.044.011.045.009.044.007.045.006.045.004.045.002.045.001.045v17l-.001.045-.002.045-.004.045-.006.045-.007.045-.009.044-.011.045-.012.044-.013.044-.015.044-.017.043-.018.044-.02.043-.021.043-.023.043-.024.043-.026.043-.027.042-.029.042-.03.042-.032.042-.033.042-.034.041-.036.041-.037.041-.039.041-.04.041-.041.04-.043.04-.044.04-.045.04-.047.039-.048.039-.05.039-.051.039-.052.038-.053.038-.055.038-.055.038-.058.037-.058.037-.06.037-.06.036-.062.036-.064.036-.064.036-.066.035-.067.035-.068.035-.069.035-.07.034-.071.034-.073.033-.074.033-.15.066-.155.064-.16.063-.163.061-.168.06-.172.059-.175.057-.18.056-.183.054-.187.053-.191.051-.194.05-.198.048-.201.046-.205.045-.208.043-.211.041-.214.04-.217.038-.22.036-.223.034-.225.032-.229.031-.231.028-.233.027-.236.024-.239.023-.241.02-.242.019-.246.016-.247.015-.249.012-.251.01-.253.008-.255.005-.256.004-.258.001-.258-.001-.256-.004-.255-.005-.253-.008-.251-.01-.249-.012-.247-.015-.245-.016-.243-.019-.241-.02-.238-.023-.236-.024-.234-.027-.231-.028-.228-.031-.226-.032-.223-.034-.22-.036-.217-.038-.214-.04-.211-.041-.208-.043-.204-.045-.201-.046-.198-.048-.195-.05-.19-.051-.187-.053-.184-.054-.179-.056-.176-.057-.172-.059-.167-.06-.164-.061-.159-.063-.155-.064-.151-.066-.074-.033-.072-.033-.072-.034-.07-.034-.069-.035-.068-.035-.067-.035-.066-.035-.064-.036-.063-.036-.062-.036-.061-.036-.06-.037-.058-.037-.057-.037-.056-.038-.055-.038-.053-.038-.052-.038-.051-.039-.049-.039-.049-.039-.046-.039-.046-.04-.044-.04-.043-.04-.041-.04-.04-.041-.039-.041-.037-.041-.036-.041-.034-.041-.033-.042-.032-.042-.03-.042-.029-.042-.027-.042-.026-.043-.024-.043-.023-.043-.021-.043-.02-.043-.018-.044-.017-.043-.015-.044-.013-.044-.012-.044-.011-.045-.009-.044-.007-.045-.006-.045-.004-.045-.002-.045-.001-.045v-17l.001-.045.002-.045.004-.045.006-.045.007-.045.009-.044.011-.045.012-.044.013-.044.015-.044.017-.043.018-.044.02-.043.021-.043.023-.043.024-.043.026-.043.027-.042.029-.042.03-.042.032-.042.033-.042.034-.041.036-.041.037-.041.039-.041.04-.041.041-.04.043-.04.044-.04.046-.04.046-.039.049-.039.049-.039.051-.039.052-.038.053-.038.055-.038.056-.038.057-.037.058-.037.06-.037.061-.036.062-.036.063-.036.064-.036.066-.035.067-.035.068-.035.069-.035.07-.034.072-.034.072-.033.074-.033.151-.066.155-.064.159-.063.164-.061.167-.06.172-.059.176-.057.179-.056.184-.054.187-.053.19-.051.195-.05.198-.048.201-.046.204-.045.208-.043.211-.041.214-.04.217-.038.22-.036.223-.034.226-.032.228-.031.231-.028.234-.027.236-.024.238-.023.241-.02.243-.019.245-.016.247-.015.249-.012.251-.01.253-.008.255-.005.256-.004.258-.001.258.001zm-9.258 20.499v.01l.001.021.003.021.004.022.005.021.006.022.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.023.018.024.019.024.021.024.022.025.023.024.024.025.052.049.056.05.061.051.066.051.07.051.075.051.079.052.084.052.088.052.092.052.097.052.102.051.105.052.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.048.144.049.147.047.152.047.155.047.16.045.163.045.167.043.171.043.176.041.178.041.183.039.187.039.19.037.194.035.197.035.202.033.204.031.209.03.212.029.216.027.219.025.222.024.226.021.23.02.233.018.236.016.24.015.243.012.246.01.249.008.253.005.256.004.259.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.021.224-.024.22-.026.216-.027.212-.028.21-.031.205-.031.202-.034.198-.034.194-.036.191-.037.187-.039.183-.04.179-.04.175-.042.172-.043.168-.044.163-.045.16-.046.155-.046.152-.047.148-.048.143-.049.139-.049.136-.05.131-.05.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.053.083-.051.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.05.023-.024.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.023.01-.022.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.127l-.077.055-.08.053-.083.054-.085.053-.087.052-.09.052-.093.051-.095.05-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.045-.118.044-.12.043-.122.042-.124.042-.126.041-.128.04-.13.04-.132.038-.134.038-.135.037-.138.037-.139.035-.142.035-.143.034-.144.033-.147.032-.148.031-.15.03-.151.03-.153.029-.154.027-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.01-.179.008-.179.008-.181.006-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.006-.179-.008-.179-.008-.178-.01-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.027-.153-.029-.151-.03-.15-.03-.148-.031-.146-.032-.145-.033-.143-.034-.141-.035-.14-.035-.137-.037-.136-.037-.134-.038-.132-.038-.13-.04-.128-.04-.126-.041-.124-.042-.122-.042-.12-.044-.117-.043-.116-.045-.113-.045-.112-.046-.109-.047-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.05-.093-.052-.09-.051-.087-.052-.085-.053-.083-.054-.08-.054-.077-.054v4.127zm0-5.654v.011l.001.021.003.021.004.021.005.022.006.022.007.022.009.022.01.022.011.023.012.023.013.023.015.024.016.023.017.024.018.024.019.024.021.024.022.024.023.025.024.024.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.052.11.051.114.051.119.052.123.05.127.051.131.05.135.049.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.044.171.042.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.022.23.02.233.018.236.016.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.012.241-.015.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.048.139-.05.136-.049.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.051.051-.049.023-.025.023-.024.021-.025.02-.024.019-.024.018-.024.017-.024.015-.023.014-.023.013-.024.012-.022.01-.023.01-.023.008-.022.006-.022.006-.022.004-.021.004-.022.001-.021.001-.021v-4.139l-.077.054-.08.054-.083.054-.085.052-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.044-.118.044-.12.044-.122.042-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.035-.143.033-.144.033-.147.033-.148.031-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.009-.179.009-.179.007-.181.007-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.007-.179-.007-.179-.009-.178-.009-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.031-.146-.033-.145-.033-.143-.033-.141-.035-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.04-.126-.041-.124-.042-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.051-.093-.051-.09-.051-.087-.053-.085-.052-.083-.054-.08-.054-.077-.054v4.139zm0-5.666v.011l.001.02.003.022.004.021.005.022.006.021.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.024.018.023.019.024.021.025.022.024.023.024.024.025.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.051.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.043.171.043.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.021.23.02.233.018.236.017.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.013.241-.014.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.049.139-.049.136-.049.131-.051.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.049.023-.025.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.022.01-.023.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.153l-.077.054-.08.054-.083.053-.085.053-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.048-.105.048-.106.048-.109.046-.111.046-.114.046-.115.044-.118.044-.12.043-.122.043-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.034-.143.034-.144.033-.147.032-.148.032-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.024-.161.024-.162.023-.163.023-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.01-.178.01-.179.009-.179.007-.181.006-.182.006-.182.004-.184.003-.184.001-.185.001-.185-.001-.184-.001-.184-.003-.182-.004-.182-.006-.181-.006-.179-.007-.179-.009-.178-.01-.176-.01-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.023-.162-.023-.161-.024-.159-.024-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.032-.146-.032-.145-.033-.143-.034-.141-.034-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.041-.126-.041-.124-.041-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.048-.105-.048-.102-.048-.1-.05-.097-.049-.095-.051-.093-.051-.09-.052-.087-.052-.085-.053-.083-.053-.08-.054-.077-.054v4.153zm8.74-8.179l-.257.004-.254.005-.25.008-.247.011-.244.012-.241.014-.237.016-.233.018-.231.021-.226.022-.224.023-.22.026-.216.027-.212.028-.21.031-.205.032-.202.033-.198.034-.194.036-.191.038-.187.038-.183.04-.179.041-.175.042-.172.043-.168.043-.163.045-.16.046-.155.046-.152.048-.148.048-.143.048-.139.049-.136.05-.131.05-.126.051-.123.051-.118.051-.114.052-.11.052-.106.052-.101.052-.096.052-.092.052-.088.052-.083.052-.079.052-.074.051-.07.052-.065.051-.06.05-.056.05-.051.05-.023.025-.023.024-.021.024-.02.025-.019.024-.018.024-.017.023-.015.024-.014.023-.013.023-.012.023-.01.023-.01.022-.008.022-.006.023-.006.021-.004.022-.004.021-.001.021-.001.021.001.021.001.021.004.021.004.022.006.021.006.023.008.022.01.022.01.023.012.023.013.023.014.023.015.024.017.023.018.024.019.024.02.025.021.024.023.024.023.025.051.05.056.05.06.05.065.051.07.052.074.051.079.052.083.052.088.052.092.052.096.052.101.052.106.052.11.052.114.052.118.051.123.051.126.051.131.05.136.05.139.049.143.048.148.048.152.048.155.046.16.046.163.045.168.043.172.043.175.042.179.041.183.04.187.038.191.038.194.036.198.034.202.033.205.032.21.031.212.028.216.027.22.026.224.023.226.022.231.021.233.018.237.016.241.014.244.012.247.011.25.008.254.005.257.004.26.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.022.224-.023.22-.026.216-.027.212-.028.21-.031.205-.032.202-.033.198-.034.194-.036.191-.038.187-.038.183-.04.179-.041.175-.042.172-.043.168-.043.163-.045.16-.046.155-.046.152-.048.148-.048.143-.048.139-.049.136-.05.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.05.051-.05.023-.025.023-.024.021-.024.02-.025.019-.024.018-.024.017-.023.015-.024.014-.023.013-.023.012-.023.01-.023.01-.022.008-.022.006-.023.006-.021.004-.022.004-.021.001-.021.001-.021-.001-.021-.001-.021-.004-.021-.004-.022-.006-.021-.006-.023-.008-.022-.01-.022-.01-.023-.012-.023-.013-.023-.014-.023-.015-.024-.017-.023-.018-.024-.019-.024-.02-.025-.021-.024-.023-.024-.023-.025-.051-.05-.056-.05-.06-.05-.065-.051-.07-.052-.074-.051-.079-.052-.083-.052-.088-.052-.092-.052-.096-.052-.101-.052-.106-.052-.11-.052-.114-.052-.118-.051-.123-.051-.126-.051-.131-.05-.136-.05-.139-.049-.143-.048-.148-.048-.152-.048-.155-.046-.16-.046-.163-.045-.168-.043-.172-.043-.175-.042-.179-.041-.183-.04-.187-.038-.191-.038-.194-.036-.198-.034-.202-.033-.205-.032-.21-.031-.212-.028-.216-.027-.22-.026-.224-.023-.226-.022-.231-.021-.233-.018-.237-.016-.241-.014-.244-.012-.247-.011-.25-.008-.254-.005-.257-.004-.26-.001-.26.001z" transform="scale(.5)"></path></symbol></defs><defs><symbol height="24" width="24" id="clock"><path d="M12 2c5.514 0 10 4.486 10 10s-4.486 10-10 10-10-4.486-10-10 4.486-10 10-10zm0-2c-6.627 0-12 5.373-12 12s5.373 12 12 12 12-5.373 12-12-5.373-12-12-12zm5.848 12.459c.202.038.202.333.001.372-1.907.361-6.045 1.111-6.547 1.111-.719 0-1.301-.582-1.301-1.301 0-.512.77-5.447 1.125-7.445.034-.192.312-.181.343.014l.985 6.238 5.394 1.011z" transform="scale(.5)"></path></symbol></defs><defs><marker orient="auto" markerHeight="12" markerWidth="12" markerUnits="userSpaceOnUse" refY="5" refX="7.9" id="arrowhead"><path d="M 0 0 L 10 5 L 0 10 z"></path></marker></defs><defs><marker refY="4.5" refX="4" orient="auto" markerHeight="8" markerWidth="15" id="crosshead"><path style="stroke-dasharray: 0, 0;" d="M 1,2 L 6,7 M 6,2 L 1,7" stroke-width="1pt" stroke="#000000" fill="none"></path></marker></defs><defs><marker orient="auto" markerHeight="28" markerWidth="20" refY="7" refX="15.5" id="filled-head"><path d="M 18,7 L9,13 L14,7 L9,1 Z"></path></marker></defs><defs><marker orient="auto" markerHeight="40" markerWidth="60" refY="15" refX="15" id="sequencenumber"><circle r="6" cy="15" cx="15"></circle></marker></defs><g><rect class="note" ry="0" rx="0" height="76" width="150" stroke="#666" fill="#EDF2AE" y="75" x="745"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="80" x="820"><tspan x="820">creating queue</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="99" x="820"><tspan x="820">("public" key RK</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="117" x="820"><tspan x="820">for msg retrieval)</tspan></text></g><g><rect class="note" ry="0" rx="0" height="94" width="159" stroke="#666" fill="#EDF2AE" y="257" x="740.5"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="262" x="820"><tspan x="820">out-of-band msg</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="281" x="820"><tspan x="820">(sender's queue SID</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="299" x="820"><tspan x="820">and "public" key EK</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="318" x="820"><tspan x="820">to encrypt msgs)</tspan></text></g><g><rect class="note" ry="0" rx="0" height="150" width="154" stroke="#666" fill="#EDF2AE" y="409" x="-2"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="414" x="75"><tspan x="75">confirm queue</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="433" x="75"><tspan x="75">("public" key SK for</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="451" x="75"><tspan x="75">sending messages,</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="470" x="75"><tspan x="75">public key for</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="488" x="75"><tspan x="75">e2e encryption</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="507" x="75"><tspan x="75">and any optional</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="526" x="75"><tspan x="75">encrypted info)</tspan></text></g><g><rect class="note" ry="0" rx="0" height="57" width="150" stroke="#666" fill="#EDF2AE" y="665" x="745"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="670" x="820"><tspan x="820">decrypt message</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="689" x="820"><tspan x="820">("private" key EK)</tspan></text></g><g><rect class="note" ry="0" rx="0" height="76" width="150" stroke="#666" fill="#EDF2AE" y="828" x="402"></rect><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="833" x="477"><tspan x="477">6. simplex</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="852" x="477"><tspan x="477">queue RID</tspan></text><text style="font-size: 16px; font-weight: 400;" dy="1em" class="noteText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="870" x="477"><tspan x="477">is ready to use!</tspan></text></g><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="166" x="650">1. create queue ("NEW")</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="199" x2="481" y1="199" x1="819"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="214" x="647">respond with queue RID and SID ("IDS")</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="247" x2="816" y1="247" x1="478"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="366" x="449">2. send out-of-band message</text><line style="stroke-dasharray: 3, 3; fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine1" y2="399" x2="79" y1="399" x1="819"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="574" x="275">3. confirm queue ("SEND" command not signed)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="607" x2="473" y1="607" x1="76"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="622" x="647">4. deliver Bob's message (MSG)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="655" x2="816" y1="655" x1="478"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="737" x="650">acknowledge message (ACK)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="770" x2="481" y1="770" x1="819"></line><text style="font-size: 16px; font-weight: 400;" dy="1em" class="messageText" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="785" x="650">5. secure queue ("KEY", RK-signed)</text><line style="fill: none;" marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine0" y2="818" x2="481" y1="818" x1="819"></line></svg>
\ No newline at end of file
diff --git a/protocol/diagrams/xftp/xftp-receiving-file.mmd b/protocol/diagrams/xftp/xftp-receiving-file.mmd
new file mode 100644
index 000000000..d1944368b
--- /dev/null
+++ b/protocol/diagrams/xftp/xftp-receiving-file.mmd
@@ -0,0 +1,18 @@
+sequenceDiagram
+  participant B as Bob (recipient)
+  participant S as XFTP server(s)
+
+  note over B: having received file description<br>from sender
+
+  loop for each chunk
+    B ->> S: 1a. download chunk ("FGET")
+    S ->> B: send chunk body ("FILE")
+
+    opt
+      B ->> S: 1b. acknowledge chunk reception ("FACK")
+      note over S: delete recipient ID
+      S ->> B: respond with ok ("OK")
+    end
+  end
+
+  note over B: 2. combine chunks into a file<br>3. decrypt file using key from file description<br>4. extract file name and unpad the file<br>5. validate file digest with the file description
diff --git a/protocol/diagrams/xftp/xftp-receiving-file.svg b/protocol/diagrams/xftp/xftp-receiving-file.svg
new file mode 100644
index 000000000..aceeb653d
--- /dev/null
+++ b/protocol/diagrams/xftp/xftp-receiving-file.svg
@@ -0,0 +1,3 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<?xml-stylesheet href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.2/css/all.min.css" type="text/css"?>
+<svg aria-roledescription="sequence" role="graphics-document document" viewBox="-148 -10 755 680" style="max-width: 100%;" xmlns="http://www.w3.org/2000/svg" width="100%" id="graph-div" height="100%" xmlns:xlink="http://www.w3.org/1999/xlink"><g><rect class="actor actor-bottom" ry="3" rx="3" name="S" height="65" width="150" stroke="#666" fill="#eaeaea" y="594" x="385"></rect><text class="actor" alignment-baseline="central" dominant-baseline="central" style="text-anchor: middle; font-size: 16px; font-weight: 400;" y="626.5" x="460"><tspan dy="0" x="460">XFTP server(s)</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="594" x="0"></rect><text class="actor" alignment-baseline="central" dominant-baseline="central" style="text-anchor: middle; font-size: 16px; font-weight: 400;" y="626.5" x="75"><tspan dy="0" x="75">Bob (recipient)</tspan></text></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="594" x2="460" y1="5" x1="460" id="actor858"></line><g id="root-858"><rect class="actor actor-top" ry="3" rx="3" name="S" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="385"></rect><text class="actor" alignment-baseline="central" dominant-baseline="central" style="text-anchor: middle; font-size: 16px; font-weight: 400;" y="32.5" x="460"><tspan dy="0" x="460">XFTP server(s)</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="594" x2="75" y1="5" x1="75" id="actor857"></line><g id="root-857"><rect class="actor actor-top" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="0"></rect><text class="actor" alignment-baseline="central" dominant-baseline="central" style="text-anchor: middle; font-size: 16px; font-weight: 400;" y="32.5" x="75"><tspan dy="0" x="75">Bob (recipient)</tspan></text></g></g><style>#graph-div{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#graph-div .error-icon{fill:#552222;}#graph-div .error-text{fill:#552222;stroke:#552222;}#graph-div .edge-thickness-normal{stroke-width:2px;}#graph-div .edge-thickness-thick{stroke-width:3.5px;}#graph-div .edge-pattern-solid{stroke-dasharray:0;}#graph-div .edge-pattern-dashed{stroke-dasharray:3;}#graph-div .edge-pattern-dotted{stroke-dasharray:2;}#graph-div .marker{fill:#333333;stroke:#333333;}#graph-div .marker.cross{stroke:#333333;}#graph-div svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#graph-div .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div text.actor&gt;tspan{fill:black;stroke:none;}#graph-div .actor-line{stroke:grey;}#graph-div .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#graph-div .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#graph-div #arrowhead path{fill:#333;stroke:#333;}#graph-div .sequenceNumber{fill:white;}#graph-div #sequencenumber{fill:#333;}#graph-div #crosshead path{fill:#333;stroke:#333;}#graph-div .messageText{fill:#333;stroke:none;}#graph-div .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .labelText,#graph-div .labelText&gt;tspan{fill:black;stroke:none;}#graph-div .loopText,#graph-div .loopText&gt;tspan{fill:black;stroke:none;}#graph-div .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#graph-div .note{stroke:#aaaa33;fill:#fff5ad;}#graph-div .noteText,#graph-div .noteText&gt;tspan{fill:black;stroke:none;}#graph-div .activation0{fill:#f4f4f4;stroke:#666;}#graph-div .activation1{fill:#f4f4f4;stroke:#666;}#graph-div .activation2{fill:#f4f4f4;stroke:#666;}#graph-div .actorPopupMenu{position:absolute;}#graph-div .actorPopupMenuPanel{position:absolute;fill:#ECECFF;box-shadow:0px 8px 16px 0px rgba(0,0,0,0.2);filter:drop-shadow(3px 5px 2px rgb(0 0 0 / 0.4));}#graph-div .actor-man line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .actor-man circle,#graph-div line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;stroke-width:2px;}#graph-div :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g></g><defs><symbol height="24" width="24" id="computer"><path d="M2 2v13h20v-13h-20zm18 11h-16v-9h16v9zm-10.228 6l.466-1h3.524l.467 1h-4.457zm14.228 3h-24l2-6h2.104l-1.33 4h18.45l-1.297-4h2.073l2 6zm-5-10h-14v-7h14v7z" transform="scale(.5)"></path></symbol></defs><defs><symbol clip-rule="evenodd" fill-rule="evenodd" id="database"><path d="M12.258.001l.256.004.255.005.253.008.251.01.249.012.247.015.246.016.242.019.241.02.239.023.236.024.233.027.231.028.229.031.225.032.223.034.22.036.217.038.214.04.211.041.208.043.205.045.201.046.198.048.194.05.191.051.187.053.183.054.18.056.175.057.172.059.168.06.163.061.16.063.155.064.15.066.074.033.073.033.071.034.07.034.069.035.068.035.067.035.066.035.064.036.064.036.062.036.06.036.06.037.058.037.058.037.055.038.055.038.053.038.052.038.051.039.05.039.048.039.047.039.045.04.044.04.043.04.041.04.04.041.039.041.037.041.036.041.034.041.033.042.032.042.03.042.029.042.027.042.026.043.024.043.023.043.021.043.02.043.018.044.017.043.015.044.013.044.012.044.011.045.009.044.007.045.006.045.004.045.002.045.001.045v17l-.001.045-.002.045-.004.045-.006.045-.007.045-.009.044-.011.045-.012.044-.013.044-.015.044-.017.043-.018.044-.02.043-.021.043-.023.043-.024.043-.026.043-.027.042-.029.042-.03.042-.032.042-.033.042-.034.041-.036.041-.037.041-.039.041-.04.041-.041.04-.043.04-.044.04-.045.04-.047.039-.048.039-.05.039-.051.039-.052.038-.053.038-.055.038-.055.038-.058.037-.058.037-.06.037-.06.036-.062.036-.064.036-.064.036-.066.035-.067.035-.068.035-.069.035-.07.034-.071.034-.073.033-.074.033-.15.066-.155.064-.16.063-.163.061-.168.06-.172.059-.175.057-.18.056-.183.054-.187.053-.191.051-.194.05-.198.048-.201.046-.205.045-.208.043-.211.041-.214.04-.217.038-.22.036-.223.034-.225.032-.229.031-.231.028-.233.027-.236.024-.239.023-.241.02-.242.019-.246.016-.247.015-.249.012-.251.01-.253.008-.255.005-.256.004-.258.001-.258-.001-.256-.004-.255-.005-.253-.008-.251-.01-.249-.012-.247-.015-.245-.016-.243-.019-.241-.02-.238-.023-.236-.024-.234-.027-.231-.028-.228-.031-.226-.032-.223-.034-.22-.036-.217-.038-.214-.04-.211-.041-.208-.043-.204-.045-.201-.046-.198-.048-.195-.05-.19-.051-.187-.053-.184-.054-.179-.056-.176-.057-.172-.059-.167-.06-.164-.061-.159-.063-.155-.064-.151-.066-.074-.033-.072-.033-.072-.034-.07-.034-.069-.035-.068-.035-.067-.035-.066-.035-.064-.036-.063-.036-.062-.036-.061-.036-.06-.037-.058-.037-.057-.037-.056-.038-.055-.038-.053-.038-.052-.038-.051-.039-.049-.039-.049-.039-.046-.039-.046-.04-.044-.04-.043-.04-.041-.04-.04-.041-.039-.041-.037-.041-.036-.041-.034-.041-.033-.042-.032-.042-.03-.042-.029-.042-.027-.042-.026-.043-.024-.043-.023-.043-.021-.043-.02-.043-.018-.044-.017-.043-.015-.044-.013-.044-.012-.044-.011-.045-.009-.044-.007-.045-.006-.045-.004-.045-.002-.045-.001-.045v-17l.001-.045.002-.045.004-.045.006-.045.007-.045.009-.044.011-.045.012-.044.013-.044.015-.044.017-.043.018-.044.02-.043.021-.043.023-.043.024-.043.026-.043.027-.042.029-.042.03-.042.032-.042.033-.042.034-.041.036-.041.037-.041.039-.041.04-.041.041-.04.043-.04.044-.04.046-.04.046-.039.049-.039.049-.039.051-.039.052-.038.053-.038.055-.038.056-.038.057-.037.058-.037.06-.037.061-.036.062-.036.063-.036.064-.036.066-.035.067-.035.068-.035.069-.035.07-.034.072-.034.072-.033.074-.033.151-.066.155-.064.159-.063.164-.061.167-.06.172-.059.176-.057.179-.056.184-.054.187-.053.19-.051.195-.05.198-.048.201-.046.204-.045.208-.043.211-.041.214-.04.217-.038.22-.036.223-.034.226-.032.228-.031.231-.028.234-.027.236-.024.238-.023.241-.02.243-.019.245-.016.247-.015.249-.012.251-.01.253-.008.255-.005.256-.004.258-.001.258.001zm-9.258 20.499v.01l.001.021.003.021.004.022.005.021.006.022.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.023.018.024.019.024.021.024.022.025.023.024.024.025.052.049.056.05.061.051.066.051.07.051.075.051.079.052.084.052.088.052.092.052.097.052.102.051.105.052.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.048.144.049.147.047.152.047.155.047.16.045.163.045.167.043.171.043.176.041.178.041.183.039.187.039.19.037.194.035.197.035.202.033.204.031.209.03.212.029.216.027.219.025.222.024.226.021.23.02.233.018.236.016.24.015.243.012.246.01.249.008.253.005.256.004.259.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.021.224-.024.22-.026.216-.027.212-.028.21-.031.205-.031.202-.034.198-.034.194-.036.191-.037.187-.039.183-.04.179-.04.175-.042.172-.043.168-.044.163-.045.16-.046.155-.046.152-.047.148-.048.143-.049.139-.049.136-.05.131-.05.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.053.083-.051.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.05.023-.024.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.023.01-.022.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.127l-.077.055-.08.053-.083.054-.085.053-.087.052-.09.052-.093.051-.095.05-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.045-.118.044-.12.043-.122.042-.124.042-.126.041-.128.04-.13.04-.132.038-.134.038-.135.037-.138.037-.139.035-.142.035-.143.034-.144.033-.147.032-.148.031-.15.03-.151.03-.153.029-.154.027-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.01-.179.008-.179.008-.181.006-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.006-.179-.008-.179-.008-.178-.01-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.027-.153-.029-.151-.03-.15-.03-.148-.031-.146-.032-.145-.033-.143-.034-.141-.035-.14-.035-.137-.037-.136-.037-.134-.038-.132-.038-.13-.04-.128-.04-.126-.041-.124-.042-.122-.042-.12-.044-.117-.043-.116-.045-.113-.045-.112-.046-.109-.047-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.05-.093-.052-.09-.051-.087-.052-.085-.053-.083-.054-.08-.054-.077-.054v4.127zm0-5.654v.011l.001.021.003.021.004.021.005.022.006.022.007.022.009.022.01.022.011.023.012.023.013.023.015.024.016.023.017.024.018.024.019.024.021.024.022.024.023.025.024.024.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.052.11.051.114.051.119.052.123.05.127.051.131.05.135.049.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.044.171.042.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.022.23.02.233.018.236.016.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.012.241-.015.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.048.139-.05.136-.049.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.051.051-.049.023-.025.023-.024.021-.025.02-.024.019-.024.018-.024.017-.024.015-.023.014-.023.013-.024.012-.022.01-.023.01-.023.008-.022.006-.022.006-.022.004-.021.004-.022.001-.021.001-.021v-4.139l-.077.054-.08.054-.083.054-.085.052-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.044-.118.044-.12.044-.122.042-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.035-.143.033-.144.033-.147.033-.148.031-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.009-.179.009-.179.007-.181.007-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.007-.179-.007-.179-.009-.178-.009-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.031-.146-.033-.145-.033-.143-.033-.141-.035-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.04-.126-.041-.124-.042-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.051-.093-.051-.09-.051-.087-.053-.085-.052-.083-.054-.08-.054-.077-.054v4.139zm0-5.666v.011l.001.02.003.022.004.021.005.022.006.021.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.024.018.023.019.024.021.025.022.024.023.024.024.025.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.051.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.043.171.043.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.021.23.02.233.018.236.017.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.013.241-.014.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.049.139-.049.136-.049.131-.051.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.049.023-.025.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.022.01-.023.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.153l-.077.054-.08.054-.083.053-.085.053-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.048-.105.048-.106.048-.109.046-.111.046-.114.046-.115.044-.118.044-.12.043-.122.043-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.034-.143.034-.144.033-.147.032-.148.032-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.024-.161.024-.162.023-.163.023-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.01-.178.01-.179.009-.179.007-.181.006-.182.006-.182.004-.184.003-.184.001-.185.001-.185-.001-.184-.001-.184-.003-.182-.004-.182-.006-.181-.006-.179-.007-.179-.009-.178-.01-.176-.01-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.023-.162-.023-.161-.024-.159-.024-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.032-.146-.032-.145-.033-.143-.034-.141-.034-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.041-.126-.041-.124-.041-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.048-.105-.048-.102-.048-.1-.05-.097-.049-.095-.051-.093-.051-.09-.052-.087-.052-.085-.053-.083-.053-.08-.054-.077-.054v4.153zm8.74-8.179l-.257.004-.254.005-.25.008-.247.011-.244.012-.241.014-.237.016-.233.018-.231.021-.226.022-.224.023-.22.026-.216.027-.212.028-.21.031-.205.032-.202.033-.198.034-.194.036-.191.038-.187.038-.183.04-.179.041-.175.042-.172.043-.168.043-.163.045-.16.046-.155.046-.152.048-.148.048-.143.048-.139.049-.136.05-.131.05-.126.051-.123.051-.118.051-.114.052-.11.052-.106.052-.101.052-.096.052-.092.052-.088.052-.083.052-.079.052-.074.051-.07.052-.065.051-.06.05-.056.05-.051.05-.023.025-.023.024-.021.024-.02.025-.019.024-.018.024-.017.023-.015.024-.014.023-.013.023-.012.023-.01.023-.01.022-.008.022-.006.023-.006.021-.004.022-.004.021-.001.021-.001.021.001.021.001.021.004.021.004.022.006.021.006.023.008.022.01.022.01.023.012.023.013.023.014.023.015.024.017.023.018.024.019.024.02.025.021.024.023.024.023.025.051.05.056.05.06.05.065.051.07.052.074.051.079.052.083.052.088.052.092.052.096.052.101.052.106.052.11.052.114.052.118.051.123.051.126.051.131.05.136.05.139.049.143.048.148.048.152.048.155.046.16.046.163.045.168.043.172.043.175.042.179.041.183.04.187.038.191.038.194.036.198.034.202.033.205.032.21.031.212.028.216.027.22.026.224.023.226.022.231.021.233.018.237.016.241.014.244.012.247.011.25.008.254.005.257.004.26.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.022.224-.023.22-.026.216-.027.212-.028.21-.031.205-.032.202-.033.198-.034.194-.036.191-.038.187-.038.183-.04.179-.041.175-.042.172-.043.168-.043.163-.045.16-.046.155-.046.152-.048.148-.048.143-.048.139-.049.136-.05.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.05.051-.05.023-.025.023-.024.021-.024.02-.025.019-.024.018-.024.017-.023.015-.024.014-.023.013-.023.012-.023.01-.023.01-.022.008-.022.006-.023.006-.021.004-.022.004-.021.001-.021.001-.021-.001-.021-.001-.021-.004-.021-.004-.022-.006-.021-.006-.023-.008-.022-.01-.022-.01-.023-.012-.023-.013-.023-.014-.023-.015-.024-.017-.023-.018-.024-.019-.024-.02-.025-.021-.024-.023-.024-.023-.025-.051-.05-.056-.05-.06-.05-.065-.051-.07-.052-.074-.051-.079-.052-.083-.052-.088-.052-.092-.052-.096-.052-.101-.052-.106-.052-.11-.052-.114-.052-.118-.051-.123-.051-.126-.051-.131-.05-.136-.05-.139-.049-.143-.048-.148-.048-.152-.048-.155-.046-.16-.046-.163-.045-.168-.043-.172-.043-.175-.042-.179-.041-.183-.04-.187-.038-.191-.038-.194-.036-.198-.034-.202-.033-.205-.032-.21-.031-.212-.028-.216-.027-.22-.026-.224-.023-.226-.022-.231-.021-.233-.018-.237-.016-.241-.014-.244-.012-.247-.011-.25-.008-.254-.005-.257-.004-.26-.001-.26.001z" transform="scale(.5)"></path></symbol></defs><defs><symbol height="24" width="24" id="clock"><path d="M12 2c5.514 0 10 4.486 10 10s-4.486 10-10 10-10-4.486-10-10 4.486-10 10-10zm0-2c-6.627 0-12 5.373-12 12s5.373 12 12 12 12-5.373 12-12-5.373-12-12-12zm5.848 12.459c.202.038.202.333.001.372-1.907.361-6.045 1.111-6.547 1.111-.719 0-1.301-.582-1.301-1.301 0-.512.77-5.447 1.125-7.445.034-.192.312-.181.343.014l.985 6.238 5.394 1.011z" transform="scale(.5)"></path></symbol></defs><defs><marker orient="auto" markerHeight="12" markerWidth="12" markerUnits="userSpaceOnUse" refY="5" refX="7.9" id="arrowhead"><path d="M 0 0 L 10 5 L 0 10 z"></path></marker></defs><defs><marker refY="4.5" refX="4" orient="auto" markerHeight="8" markerWidth="15" id="crosshead"><path d="M 1,2 L 6,7 M 6,2 L 1,7" stroke-width="1pt" style="stroke-dasharray: 0px, 0px;" stroke="#000000" fill="none"></path></marker></defs><defs><marker orient="auto" markerHeight="28" markerWidth="20" refY="7" refX="15.5" id="filled-head"><path d="M 18,7 L9,13 L14,7 L9,1 Z"></path></marker></defs><defs><marker orient="auto" markerHeight="40" markerWidth="60" refY="15" refX="15" id="sequencenumber"><circle r="6" cy="15" cx="15"></circle></marker></defs><g><rect class="note" ry="0" rx="0" height="59" width="248" stroke="#666" fill="#EDF2AE" y="75" x="-49"></rect><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="80" x="75"><tspan x="75">having received file description</tspan></text><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="100" x="75"><tspan x="75">from sender</tspan></text></g><g><rect class="note" ry="0" rx="0" height="40" width="154" stroke="#666" fill="#EDF2AE" y="358" x="383"></rect><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="363" x="460"><tspan x="460">delete recipient ID</tspan></text></g><g><line class="loopLine" y2="285" x2="547" y1="285" x1="64"></line><line class="loopLine" y2="456" x2="547" y1="285" x1="547"></line><line class="loopLine" y2="456" x2="547" y1="456" x1="64"></line><line class="loopLine" y2="456" x2="64" y1="285" x1="64"></line><polygon class="labelBox" points="64,285 114,285 114,298 105.6,305 64,305"></polygon><text class="labelText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="298" x="89">opt</text><text class="loopText" style="font-size: 16px; font-weight: 400;" text-anchor="middle" y="303" x="330.5"><tspan x="330.5">​</tspan></text></g><g><line class="loopLine" y2="144" x2="557" y1="144" x1="54"></line><line class="loopLine" y2="466" x2="557" y1="144" x1="557"></line><line class="loopLine" y2="466" x2="557" y1="466" x1="54"></line><line class="loopLine" y2="466" x2="54" y1="144" x1="54"></line><polygon class="labelBox" points="54,144 104,144 104,157 95.6,164 54,164"></polygon><text class="labelText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="157" x="79">loop</text><text class="loopText" style="font-size: 16px; font-weight: 400;" text-anchor="middle" y="162" x="330.5"><tspan x="330.5">[for each chunk]</tspan></text></g><g><rect class="note" ry="0" rx="0" height="98" width="346" stroke="#666" fill="#EDF2AE" y="476" x="-98"></rect><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="481" x="75"><tspan x="75">2. combine chunks into a file</tspan></text><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="501" x="75"><tspan x="75">3. decrypt file using key from file description</tspan></text><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="520" x="75"><tspan x="75">4. extract file name and unpad the file</tspan></text><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="540" x="75"><tspan x="75">5. validate file digest with the file description</tspan></text></g><text dy="1em" class="messageText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="194" x="266">1a. download chunk ("FGET")</text><line marker-end="url(#arrowhead)" style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="227" x2="456" y1="227" x1="76"></line><text dy="1em" class="messageText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="242" x="269">send chunk body ("FILE")</text><line marker-end="url(#arrowhead)" style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="275" x2="79" y1="275" x1="459"></line><text dy="1em" class="messageText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="315" x="266">1b. acknowledge chunk reception ("FACK")</text><line marker-end="url(#arrowhead)" style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="348" x2="456" y1="348" x1="76"></line><text dy="1em" class="messageText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="413" x="269">respond with ok ("OK")</text><line marker-end="url(#arrowhead)" style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="446" x2="79" y1="446" x1="459"></line></svg>
\ No newline at end of file
diff --git a/protocol/diagrams/xftp/xftp-sending-file.mmd b/protocol/diagrams/xftp/xftp-sending-file.mmd
new file mode 100644
index 000000000..8e0b58498
--- /dev/null
+++ b/protocol/diagrams/xftp/xftp-sending-file.mmd
@@ -0,0 +1,23 @@
+sequenceDiagram
+  participant A as Alice (sender)
+  participant S as XFTP server(s)
+  participant B as recipient(s)
+
+  note over A: 1. prepare file:<br>encrypt,<br>split into chunks,<br>generate recipient<br>keys, etc.
+
+  loop for each chunk
+    A ->> S: 2a. register chunk ("FNEW")
+    S ->> A: respond with sender's and recipients' chunk IDs ("SIDS")
+
+    opt
+      A ->> S: 2b. request additional recipient IDs ("FADD")
+      S ->> A: respond with added recipients' chunk IDs ("RIDS")
+    end
+
+    A ->> S: 2c. upload chunk to chosen server ("FPUT")
+    S ->> A: respond with ok ("OK")
+  end
+
+  note over A: 3. prepare file description(s)
+
+  A -->> B: 4. send file description(s) out-of-band
diff --git a/protocol/diagrams/xftp/xftp-sending-file.svg b/protocol/diagrams/xftp/xftp-sending-file.svg
new file mode 100644
index 000000000..c3df658f5
--- /dev/null
+++ b/protocol/diagrams/xftp/xftp-sending-file.svg
@@ -0,0 +1,3 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<?xml-stylesheet href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.2/css/all.min.css" type="text/css"?>
+<svg aria-roledescription="sequence" role="graphics-document document" viewBox="-89 -10 976 775" style="max-width: 100%;" xmlns="http://www.w3.org/2000/svg" width="100%" id="graph-div" height="100%" xmlns:xlink="http://www.w3.org/1999/xlink"><g><rect class="actor actor-bottom" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="689" x="687"></rect><text class="actor" alignment-baseline="central" dominant-baseline="central" style="text-anchor: middle; font-size: 16px; font-weight: 400;" y="721.5" x="762"><tspan dy="0" x="762">recipient(s)</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="S" height="65" width="150" stroke="#666" fill="#eaeaea" y="689" x="487"></rect><text class="actor" alignment-baseline="central" dominant-baseline="central" style="text-anchor: middle; font-size: 16px; font-weight: 400;" y="721.5" x="562"><tspan dy="0" x="562">XFTP server(s)</tspan></text></g><g><rect class="actor actor-bottom" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="689" x="0"></rect><text class="actor" alignment-baseline="central" dominant-baseline="central" style="text-anchor: middle; font-size: 16px; font-weight: 400;" y="721.5" x="75"><tspan dy="0" x="75">Alice (sender)</tspan></text></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="689" x2="762" y1="5" x1="762" id="actor17"></line><g id="root-17"><rect class="actor actor-top" ry="3" rx="3" name="B" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="687"></rect><text class="actor" alignment-baseline="central" dominant-baseline="central" style="text-anchor: middle; font-size: 16px; font-weight: 400;" y="32.5" x="762"><tspan dy="0" x="762">recipient(s)</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="689" x2="562" y1="5" x1="562" id="actor16"></line><g id="root-16"><rect class="actor actor-top" ry="3" rx="3" name="S" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="487"></rect><text class="actor" alignment-baseline="central" dominant-baseline="central" style="text-anchor: middle; font-size: 16px; font-weight: 400;" y="32.5" x="562"><tspan dy="0" x="562">XFTP server(s)</tspan></text></g></g><g><line stroke="#999" stroke-width="0.5px" class="200" y2="689" x2="75" y1="5" x1="75" id="actor15"></line><g id="root-15"><rect class="actor actor-top" ry="3" rx="3" name="A" height="65" width="150" stroke="#666" fill="#eaeaea" y="0" x="0"></rect><text class="actor" alignment-baseline="central" dominant-baseline="central" style="text-anchor: middle; font-size: 16px; font-weight: 400;" y="32.5" x="75"><tspan dy="0" x="75">Alice (sender)</tspan></text></g></g><style>#graph-div{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#graph-div .error-icon{fill:#552222;}#graph-div .error-text{fill:#552222;stroke:#552222;}#graph-div .edge-thickness-normal{stroke-width:2px;}#graph-div .edge-thickness-thick{stroke-width:3.5px;}#graph-div .edge-pattern-solid{stroke-dasharray:0;}#graph-div .edge-pattern-dashed{stroke-dasharray:3;}#graph-div .edge-pattern-dotted{stroke-dasharray:2;}#graph-div .marker{fill:#333333;stroke:#333333;}#graph-div .marker.cross{stroke:#333333;}#graph-div svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#graph-div .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div text.actor&gt;tspan{fill:black;stroke:none;}#graph-div .actor-line{stroke:grey;}#graph-div .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#graph-div .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#graph-div #arrowhead path{fill:#333;stroke:#333;}#graph-div .sequenceNumber{fill:white;}#graph-div #sequencenumber{fill:#333;}#graph-div #crosshead path{fill:#333;stroke:#333;}#graph-div .messageText{fill:#333;stroke:none;}#graph-div .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .labelText,#graph-div .labelText&gt;tspan{fill:black;stroke:none;}#graph-div .loopText,#graph-div .loopText&gt;tspan{fill:black;stroke:none;}#graph-div .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#graph-div .note{stroke:#aaaa33;fill:#fff5ad;}#graph-div .noteText,#graph-div .noteText&gt;tspan{fill:black;stroke:none;}#graph-div .activation0{fill:#f4f4f4;stroke:#666;}#graph-div .activation1{fill:#f4f4f4;stroke:#666;}#graph-div .activation2{fill:#f4f4f4;stroke:#666;}#graph-div .actorPopupMenu{position:absolute;}#graph-div .actorPopupMenuPanel{position:absolute;fill:#ECECFF;box-shadow:0px 8px 16px 0px rgba(0,0,0,0.2);filter:drop-shadow(3px 5px 2px rgb(0 0 0 / 0.4));}#graph-div .actor-man line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#graph-div .actor-man circle,#graph-div line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;stroke-width:2px;}#graph-div :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g></g><defs><symbol height="24" width="24" id="computer"><path d="M2 2v13h20v-13h-20zm18 11h-16v-9h16v9zm-10.228 6l.466-1h3.524l.467 1h-4.457zm14.228 3h-24l2-6h2.104l-1.33 4h18.45l-1.297-4h2.073l2 6zm-5-10h-14v-7h14v7z" transform="scale(.5)"></path></symbol></defs><defs><symbol clip-rule="evenodd" fill-rule="evenodd" id="database"><path d="M12.258.001l.256.004.255.005.253.008.251.01.249.012.247.015.246.016.242.019.241.02.239.023.236.024.233.027.231.028.229.031.225.032.223.034.22.036.217.038.214.04.211.041.208.043.205.045.201.046.198.048.194.05.191.051.187.053.183.054.18.056.175.057.172.059.168.06.163.061.16.063.155.064.15.066.074.033.073.033.071.034.07.034.069.035.068.035.067.035.066.035.064.036.064.036.062.036.06.036.06.037.058.037.058.037.055.038.055.038.053.038.052.038.051.039.05.039.048.039.047.039.045.04.044.04.043.04.041.04.04.041.039.041.037.041.036.041.034.041.033.042.032.042.03.042.029.042.027.042.026.043.024.043.023.043.021.043.02.043.018.044.017.043.015.044.013.044.012.044.011.045.009.044.007.045.006.045.004.045.002.045.001.045v17l-.001.045-.002.045-.004.045-.006.045-.007.045-.009.044-.011.045-.012.044-.013.044-.015.044-.017.043-.018.044-.02.043-.021.043-.023.043-.024.043-.026.043-.027.042-.029.042-.03.042-.032.042-.033.042-.034.041-.036.041-.037.041-.039.041-.04.041-.041.04-.043.04-.044.04-.045.04-.047.039-.048.039-.05.039-.051.039-.052.038-.053.038-.055.038-.055.038-.058.037-.058.037-.06.037-.06.036-.062.036-.064.036-.064.036-.066.035-.067.035-.068.035-.069.035-.07.034-.071.034-.073.033-.074.033-.15.066-.155.064-.16.063-.163.061-.168.06-.172.059-.175.057-.18.056-.183.054-.187.053-.191.051-.194.05-.198.048-.201.046-.205.045-.208.043-.211.041-.214.04-.217.038-.22.036-.223.034-.225.032-.229.031-.231.028-.233.027-.236.024-.239.023-.241.02-.242.019-.246.016-.247.015-.249.012-.251.01-.253.008-.255.005-.256.004-.258.001-.258-.001-.256-.004-.255-.005-.253-.008-.251-.01-.249-.012-.247-.015-.245-.016-.243-.019-.241-.02-.238-.023-.236-.024-.234-.027-.231-.028-.228-.031-.226-.032-.223-.034-.22-.036-.217-.038-.214-.04-.211-.041-.208-.043-.204-.045-.201-.046-.198-.048-.195-.05-.19-.051-.187-.053-.184-.054-.179-.056-.176-.057-.172-.059-.167-.06-.164-.061-.159-.063-.155-.064-.151-.066-.074-.033-.072-.033-.072-.034-.07-.034-.069-.035-.068-.035-.067-.035-.066-.035-.064-.036-.063-.036-.062-.036-.061-.036-.06-.037-.058-.037-.057-.037-.056-.038-.055-.038-.053-.038-.052-.038-.051-.039-.049-.039-.049-.039-.046-.039-.046-.04-.044-.04-.043-.04-.041-.04-.04-.041-.039-.041-.037-.041-.036-.041-.034-.041-.033-.042-.032-.042-.03-.042-.029-.042-.027-.042-.026-.043-.024-.043-.023-.043-.021-.043-.02-.043-.018-.044-.017-.043-.015-.044-.013-.044-.012-.044-.011-.045-.009-.044-.007-.045-.006-.045-.004-.045-.002-.045-.001-.045v-17l.001-.045.002-.045.004-.045.006-.045.007-.045.009-.044.011-.045.012-.044.013-.044.015-.044.017-.043.018-.044.02-.043.021-.043.023-.043.024-.043.026-.043.027-.042.029-.042.03-.042.032-.042.033-.042.034-.041.036-.041.037-.041.039-.041.04-.041.041-.04.043-.04.044-.04.046-.04.046-.039.049-.039.049-.039.051-.039.052-.038.053-.038.055-.038.056-.038.057-.037.058-.037.06-.037.061-.036.062-.036.063-.036.064-.036.066-.035.067-.035.068-.035.069-.035.07-.034.072-.034.072-.033.074-.033.151-.066.155-.064.159-.063.164-.061.167-.06.172-.059.176-.057.179-.056.184-.054.187-.053.19-.051.195-.05.198-.048.201-.046.204-.045.208-.043.211-.041.214-.04.217-.038.22-.036.223-.034.226-.032.228-.031.231-.028.234-.027.236-.024.238-.023.241-.02.243-.019.245-.016.247-.015.249-.012.251-.01.253-.008.255-.005.256-.004.258-.001.258.001zm-9.258 20.499v.01l.001.021.003.021.004.022.005.021.006.022.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.023.018.024.019.024.021.024.022.025.023.024.024.025.052.049.056.05.061.051.066.051.07.051.075.051.079.052.084.052.088.052.092.052.097.052.102.051.105.052.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.048.144.049.147.047.152.047.155.047.16.045.163.045.167.043.171.043.176.041.178.041.183.039.187.039.19.037.194.035.197.035.202.033.204.031.209.03.212.029.216.027.219.025.222.024.226.021.23.02.233.018.236.016.24.015.243.012.246.01.249.008.253.005.256.004.259.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.021.224-.024.22-.026.216-.027.212-.028.21-.031.205-.031.202-.034.198-.034.194-.036.191-.037.187-.039.183-.04.179-.04.175-.042.172-.043.168-.044.163-.045.16-.046.155-.046.152-.047.148-.048.143-.049.139-.049.136-.05.131-.05.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.053.083-.051.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.05.023-.024.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.023.01-.022.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.127l-.077.055-.08.053-.083.054-.085.053-.087.052-.09.052-.093.051-.095.05-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.045-.118.044-.12.043-.122.042-.124.042-.126.041-.128.04-.13.04-.132.038-.134.038-.135.037-.138.037-.139.035-.142.035-.143.034-.144.033-.147.032-.148.031-.15.03-.151.03-.153.029-.154.027-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.01-.179.008-.179.008-.181.006-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.006-.179-.008-.179-.008-.178-.01-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.027-.153-.029-.151-.03-.15-.03-.148-.031-.146-.032-.145-.033-.143-.034-.141-.035-.14-.035-.137-.037-.136-.037-.134-.038-.132-.038-.13-.04-.128-.04-.126-.041-.124-.042-.122-.042-.12-.044-.117-.043-.116-.045-.113-.045-.112-.046-.109-.047-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.05-.093-.052-.09-.051-.087-.052-.085-.053-.083-.054-.08-.054-.077-.054v4.127zm0-5.654v.011l.001.021.003.021.004.021.005.022.006.022.007.022.009.022.01.022.011.023.012.023.013.023.015.024.016.023.017.024.018.024.019.024.021.024.022.024.023.025.024.024.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.052.11.051.114.051.119.052.123.05.127.051.131.05.135.049.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.044.171.042.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.022.23.02.233.018.236.016.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.012.241-.015.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.048.139-.05.136-.049.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.051.051-.049.023-.025.023-.024.021-.025.02-.024.019-.024.018-.024.017-.024.015-.023.014-.023.013-.024.012-.022.01-.023.01-.023.008-.022.006-.022.006-.022.004-.021.004-.022.001-.021.001-.021v-4.139l-.077.054-.08.054-.083.054-.085.052-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.044-.118.044-.12.044-.122.042-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.035-.143.033-.144.033-.147.033-.148.031-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.009-.179.009-.179.007-.181.007-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.007-.179-.007-.179-.009-.178-.009-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.031-.146-.033-.145-.033-.143-.033-.141-.035-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.04-.126-.041-.124-.042-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.051-.093-.051-.09-.051-.087-.053-.085-.052-.083-.054-.08-.054-.077-.054v4.139zm0-5.666v.011l.001.02.003.022.004.021.005.022.006.021.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.024.018.023.019.024.021.025.022.024.023.024.024.025.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.051.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.043.171.043.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.021.23.02.233.018.236.017.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.013.241-.014.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.049.139-.049.136-.049.131-.051.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.049.023-.025.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.022.01-.023.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.153l-.077.054-.08.054-.083.053-.085.053-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.048-.105.048-.106.048-.109.046-.111.046-.114.046-.115.044-.118.044-.12.043-.122.043-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.034-.143.034-.144.033-.147.032-.148.032-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.024-.161.024-.162.023-.163.023-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.01-.178.01-.179.009-.179.007-.181.006-.182.006-.182.004-.184.003-.184.001-.185.001-.185-.001-.184-.001-.184-.003-.182-.004-.182-.006-.181-.006-.179-.007-.179-.009-.178-.01-.176-.01-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.023-.162-.023-.161-.024-.159-.024-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.032-.146-.032-.145-.033-.143-.034-.141-.034-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.041-.126-.041-.124-.041-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.048-.105-.048-.102-.048-.1-.05-.097-.049-.095-.051-.093-.051-.09-.052-.087-.052-.085-.053-.083-.053-.08-.054-.077-.054v4.153zm8.74-8.179l-.257.004-.254.005-.25.008-.247.011-.244.012-.241.014-.237.016-.233.018-.231.021-.226.022-.224.023-.22.026-.216.027-.212.028-.21.031-.205.032-.202.033-.198.034-.194.036-.191.038-.187.038-.183.04-.179.041-.175.042-.172.043-.168.043-.163.045-.16.046-.155.046-.152.048-.148.048-.143.048-.139.049-.136.05-.131.05-.126.051-.123.051-.118.051-.114.052-.11.052-.106.052-.101.052-.096.052-.092.052-.088.052-.083.052-.079.052-.074.051-.07.052-.065.051-.06.05-.056.05-.051.05-.023.025-.023.024-.021.024-.02.025-.019.024-.018.024-.017.023-.015.024-.014.023-.013.023-.012.023-.01.023-.01.022-.008.022-.006.023-.006.021-.004.022-.004.021-.001.021-.001.021.001.021.001.021.004.021.004.022.006.021.006.023.008.022.01.022.01.023.012.023.013.023.014.023.015.024.017.023.018.024.019.024.02.025.021.024.023.024.023.025.051.05.056.05.06.05.065.051.07.052.074.051.079.052.083.052.088.052.092.052.096.052.101.052.106.052.11.052.114.052.118.051.123.051.126.051.131.05.136.05.139.049.143.048.148.048.152.048.155.046.16.046.163.045.168.043.172.043.175.042.179.041.183.04.187.038.191.038.194.036.198.034.202.033.205.032.21.031.212.028.216.027.22.026.224.023.226.022.231.021.233.018.237.016.241.014.244.012.247.011.25.008.254.005.257.004.26.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.022.224-.023.22-.026.216-.027.212-.028.21-.031.205-.032.202-.033.198-.034.194-.036.191-.038.187-.038.183-.04.179-.041.175-.042.172-.043.168-.043.163-.045.16-.046.155-.046.152-.048.148-.048.143-.048.139-.049.136-.05.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.05.051-.05.023-.025.023-.024.021-.024.02-.025.019-.024.018-.024.017-.023.015-.024.014-.023.013-.023.012-.023.01-.023.01-.022.008-.022.006-.023.006-.021.004-.022.004-.021.001-.021.001-.021-.001-.021-.001-.021-.004-.021-.004-.022-.006-.021-.006-.023-.008-.022-.01-.022-.01-.023-.012-.023-.013-.023-.014-.023-.015-.024-.017-.023-.018-.024-.019-.024-.02-.025-.021-.024-.023-.024-.023-.025-.051-.05-.056-.05-.06-.05-.065-.051-.07-.052-.074-.051-.079-.052-.083-.052-.088-.052-.092-.052-.096-.052-.101-.052-.106-.052-.11-.052-.114-.052-.118-.051-.123-.051-.126-.051-.131-.05-.136-.05-.139-.049-.143-.048-.148-.048-.152-.048-.155-.046-.16-.046-.163-.045-.168-.043-.172-.043-.175-.042-.179-.041-.183-.04-.187-.038-.191-.038-.194-.036-.198-.034-.202-.033-.205-.032-.21-.031-.212-.028-.216-.027-.22-.026-.224-.023-.226-.022-.231-.021-.233-.018-.237-.016-.241-.014-.244-.012-.247-.011-.25-.008-.254-.005-.257-.004-.26-.001-.26.001z" transform="scale(.5)"></path></symbol></defs><defs><symbol height="24" width="24" id="clock"><path d="M12 2c5.514 0 10 4.486 10 10s-4.486 10-10 10-10-4.486-10-10 4.486-10 10-10zm0-2c-6.627 0-12 5.373-12 12s5.373 12 12 12 12-5.373 12-12-5.373-12-12-12zm5.848 12.459c.202.038.202.333.001.372-1.907.361-6.045 1.111-6.547 1.111-.719 0-1.301-.582-1.301-1.301 0-.512.77-5.447 1.125-7.445.034-.192.312-.181.343.014l.985 6.238 5.394 1.011z" transform="scale(.5)"></path></symbol></defs><defs><marker orient="auto" markerHeight="12" markerWidth="12" markerUnits="userSpaceOnUse" refY="5" refX="7.9" id="arrowhead"><path d="M 0 0 L 10 5 L 0 10 z"></path></marker></defs><defs><marker refY="4.5" refX="4" orient="auto" markerHeight="8" markerWidth="15" id="crosshead"><path d="M 1,2 L 6,7 M 6,2 L 1,7" stroke-width="1pt" style="stroke-dasharray: 0px, 0px;" stroke="#000000" fill="none"></path></marker></defs><defs><marker orient="auto" markerHeight="28" markerWidth="20" refY="7" refX="15.5" id="filled-head"><path d="M 18,7 L9,13 L14,7 L9,1 Z"></path></marker></defs><defs><marker orient="auto" markerHeight="40" markerWidth="60" refY="15" refX="15" id="sequencenumber"><circle r="6" cy="15" cx="15"></circle></marker></defs><g><rect class="note" ry="0" rx="0" height="118" width="154" stroke="#666" fill="#EDF2AE" y="75" x="-2"></rect><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="80" x="75"><tspan x="75">1. prepare file:</tspan></text><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="100" x="75"><tspan x="75">encrypt,</tspan></text><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="119" x="75"><tspan x="75">split into chunks,</tspan></text><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="139" x="75"><tspan x="75">generate recipient</tspan></text><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="158" x="75"><tspan x="75">keys, etc.</tspan></text></g><g><line class="loopLine" y2="344" x2="573" y1="344" x1="64"></line><line class="loopLine" y2="465" x2="573" y1="344" x1="573"></line><line class="loopLine" y2="465" x2="573" y1="465" x1="64"></line><line class="loopLine" y2="465" x2="64" y1="344" x1="64"></line><polygon class="labelBox" points="64,344 114,344 114,357 105.6,364 64,364"></polygon><text class="labelText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="357" x="89">opt</text><text class="loopText" style="font-size: 16px; font-weight: 400;" text-anchor="middle" y="362" x="343.5"><tspan x="343.5">​</tspan></text></g><g><line class="loopLine" y2="203" x2="583" y1="203" x1="54"></line><line class="loopLine" y2="571" x2="583" y1="203" x1="583"></line><line class="loopLine" y2="571" x2="583" y1="571" x1="54"></line><line class="loopLine" y2="571" x2="54" y1="203" x1="54"></line><polygon class="labelBox" points="54,203 104,203 104,216 95.6,223 54,223"></polygon><text class="labelText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="216" x="79">loop</text><text class="loopText" style="font-size: 16px; font-weight: 400;" text-anchor="middle" y="221" x="343.5"><tspan x="343.5">[for each chunk]</tspan></text></g><g><rect class="note" ry="0" rx="0" height="40" width="228" stroke="#666" fill="#EDF2AE" y="581" x="-39"></rect><text dy="1em" class="noteText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="586" x="75"><tspan x="75">3. prepare file description(s)</tspan></text></g><text dy="1em" class="messageText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="253" x="317">2a. register chunk ("FNEW")</text><line marker-end="url(#arrowhead)" style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="286" x2="558" y1="286" x1="76"></line><text dy="1em" class="messageText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="301" x="320">respond with sender's and recipients' chunk IDs ("SIDS")</text><line marker-end="url(#arrowhead)" style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="334" x2="79" y1="334" x1="561"></line><text dy="1em" class="messageText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="374" x="317">2b. request additional recipient IDs ("FADD")</text><line marker-end="url(#arrowhead)" style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="407" x2="558" y1="407" x1="76"></line><text dy="1em" class="messageText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="422" x="320">respond with added recipients' chunk IDs ("RIDS")</text><line marker-end="url(#arrowhead)" style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="455" x2="79" y1="455" x1="561"></line><text dy="1em" class="messageText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="480" x="317">2c. upload chunk to chosen server ("FPUT")</text><line marker-end="url(#arrowhead)" style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="513" x2="558" y1="513" x1="76"></line><text dy="1em" class="messageText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="528" x="320">respond with ok ("OK")</text><line marker-end="url(#arrowhead)" style="fill: none;" stroke="none" stroke-width="2" class="messageLine0" y2="561" x2="79" y1="561" x1="561"></line><text dy="1em" class="messageText" style="font-size: 16px; font-weight: 400;" alignment-baseline="middle" dominant-baseline="middle" text-anchor="middle" y="636" x="417">4. send file description(s) out-of-band</text><line marker-end="url(#arrowhead)" stroke="none" stroke-width="2" class="messageLine1" style="stroke-dasharray: 3px, 3px; fill: none;" y2="669" x2="758" y1="669" x1="76"></line></svg>
\ No newline at end of file
diff --git a/protocol/diagrams/xrcp/session.mmd b/protocol/diagrams/xrcp/session.mmd
new file mode 100644
index 000000000..2e98fbb1b
--- /dev/null
+++ b/protocol/diagrams/xrcp/session.mmd
@@ -0,0 +1,44 @@
+sequenceDiagram
+  participant CI as Controller UI
+  participant CC as Controller Core
+  participant HC as Host Core
+  participant HI as Host UI
+
+note over CI, HI: 1. Session invitation
+CI->>CC: "Link a mobile"
+CC-->>CI: Session invitation URI
+note over CC: Listen for TCP connection
+activate CC
+HI->>HC: Session invitation URI
+
+note over CI, HI: 2. Establishing TLS connection
+HC-->>CC: TCP connect
+note over CC, HC: TLS handshake
+par
+    note over CC: validate client X509 credentials
+    CC->>CI: session code from tlsUnique
+    CI-->>CC: user confirmation
+and
+    note over HC: validate server X509 credentials
+    HC->>HI: session code from tlsUnique
+    HI-->>HC: user confirmation
+end
+
+note over CI, HI: 3. Session verification and protocol negotiation
+HC->>CC: host HELLO
+note over CC: validate version, CA fingerprint
+alt
+    CC-->>HC: controller ERROR
+else
+    CC-->>HC: controller HELLO
+    note over CC, HC: update stored keys
+end
+deactivate CC
+
+note over CI, HI: 4. Session operation
+loop
+    CI->>CC: command
+    CC->>HC: XRCP command
+    HC-->>CC: XRCP response
+    CC-->>CI: response
+end
diff --git a/protocol/diagrams/xrcp/session.svg b/protocol/diagrams/xrcp/session.svg
new file mode 100644
index 000000000..136b56fc6
--- /dev/null
+++ b/protocol/diagrams/xrcp/session.svg
@@ -0,0 +1 @@
+<svg id="mermaid-svg" width="100%" xmlns="http://www.w3.org/2000/svg" style="max-width: 954px;" viewBox="-50 -10 954 1484" role="graphics-document document" aria-roledescription="sequence" xmlns:xlink="http://www.w3.org/1999/xlink"><style xmlns="http://www.w3.org/1999/xhtml">@import url("https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.2/css/all.min.css");</style><g><rect x="704" y="1398" fill="#eaeaea" stroke="#666" width="150" height="65" name="HI" rx="3" ry="3" class="actor actor-bottom"/><text x="779" y="1430.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 16px; font-weight: 400;"><tspan x="779" dy="0">Host UI</tspan></text></g><g><rect x="452" y="1398" fill="#eaeaea" stroke="#666" width="150" height="65" name="HC" rx="3" ry="3" class="actor actor-bottom"/><text x="527" y="1430.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 16px; font-weight: 400;"><tspan x="527" dy="0">Host Core</tspan></text></g><g><rect x="252" y="1398" fill="#eaeaea" stroke="#666" width="150" height="65" name="CC" rx="3" ry="3" class="actor actor-bottom"/><text x="327" y="1430.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 16px; font-weight: 400;"><tspan x="327" dy="0">Controller Core</tspan></text></g><g><rect x="0" y="1398" fill="#eaeaea" stroke="#666" width="150" height="65" name="CI" rx="3" ry="3" class="actor actor-bottom"/><text x="75" y="1430.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 16px; font-weight: 400;"><tspan x="75" dy="0">Controller UI</tspan></text></g><g><line id="actor3" x1="779" y1="5" x2="779" y2="1398" class="200" stroke-width="0.5px" stroke="#999"/><g id="root-3"><rect x="704" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" name="HI" rx="3" ry="3" class="actor actor-top"/><text x="779" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 16px; font-weight: 400;"><tspan x="779" dy="0">Host UI</tspan></text></g></g><g><line id="actor2" x1="527" y1="5" x2="527" y2="1398" class="200" stroke-width="0.5px" stroke="#999"/><g id="root-2"><rect x="452" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" name="HC" rx="3" ry="3" class="actor actor-top"/><text x="527" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 16px; font-weight: 400;"><tspan x="527" dy="0">Host Core</tspan></text></g></g><g><line id="actor1" x1="327" y1="5" x2="327" y2="1398" class="200" stroke-width="0.5px" stroke="#999"/><g id="root-1"><rect x="252" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" name="CC" rx="3" ry="3" class="actor actor-top"/><text x="327" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 16px; font-weight: 400;"><tspan x="327" dy="0">Controller Core</tspan></text></g></g><g><line id="actor0" x1="75" y1="5" x2="75" y2="1398" class="200" stroke-width="0.5px" stroke="#999"/><g id="root-0"><rect x="0" y="0" fill="#eaeaea" stroke="#666" width="150" height="65" name="CI" rx="3" ry="3" class="actor actor-top"/><text x="75" y="32.5" dominant-baseline="central" alignment-baseline="central" class="actor" style="text-anchor: middle; font-size: 16px; font-weight: 400;"><tspan x="75" dy="0">Controller UI</tspan></text></g></g><style>#mermaid-svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;fill:#333;}#mermaid-svg .error-icon{fill:#552222;}#mermaid-svg .error-text{fill:#552222;stroke:#552222;}#mermaid-svg .edge-thickness-normal{stroke-width:2px;}#mermaid-svg .edge-thickness-thick{stroke-width:3.5px;}#mermaid-svg .edge-pattern-solid{stroke-dasharray:0;}#mermaid-svg .edge-pattern-dashed{stroke-dasharray:3;}#mermaid-svg .edge-pattern-dotted{stroke-dasharray:2;}#mermaid-svg .marker{fill:#333333;stroke:#333333;}#mermaid-svg .marker.cross{stroke:#333333;}#mermaid-svg svg{font-family:"trebuchet ms",verdana,arial,sans-serif;font-size:16px;}#mermaid-svg .actor{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#mermaid-svg text.actor&gt;tspan{fill:black;stroke:none;}#mermaid-svg .actor-line{stroke:grey;}#mermaid-svg .messageLine0{stroke-width:1.5;stroke-dasharray:none;stroke:#333;}#mermaid-svg .messageLine1{stroke-width:1.5;stroke-dasharray:2,2;stroke:#333;}#mermaid-svg #arrowhead path{fill:#333;stroke:#333;}#mermaid-svg .sequenceNumber{fill:white;}#mermaid-svg #sequencenumber{fill:#333;}#mermaid-svg #crosshead path{fill:#333;stroke:#333;}#mermaid-svg .messageText{fill:#333;stroke:none;}#mermaid-svg .labelBox{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#mermaid-svg .labelText,#mermaid-svg .labelText&gt;tspan{fill:black;stroke:none;}#mermaid-svg .loopText,#mermaid-svg .loopText&gt;tspan{fill:black;stroke:none;}#mermaid-svg .loopLine{stroke-width:2px;stroke-dasharray:2,2;stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);}#mermaid-svg .note{stroke:#aaaa33;fill:#fff5ad;}#mermaid-svg .noteText,#mermaid-svg .noteText&gt;tspan{fill:black;stroke:none;}#mermaid-svg .activation0{fill:#f4f4f4;stroke:#666;}#mermaid-svg .activation1{fill:#f4f4f4;stroke:#666;}#mermaid-svg .activation2{fill:#f4f4f4;stroke:#666;}#mermaid-svg .actorPopupMenu{position:absolute;}#mermaid-svg .actorPopupMenuPanel{position:absolute;fill:#ECECFF;box-shadow:0px 8px 16px 0px rgba(0,0,0,0.2);filter:drop-shadow(3px 5px 2px rgb(0 0 0 / 0.4));}#mermaid-svg .actor-man line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;}#mermaid-svg .actor-man circle,#mermaid-svg line{stroke:hsl(259.6261682243, 59.7765363128%, 87.9019607843%);fill:#ECECFF;stroke-width:2px;}#mermaid-svg :root{--mermaid-font-family:"trebuchet ms",verdana,arial,sans-serif;}</style><g/><defs><symbol id="computer" width="24" height="24"><path transform="scale(.5)" d="M2 2v13h20v-13h-20zm18 11h-16v-9h16v9zm-10.228 6l.466-1h3.524l.467 1h-4.457zm14.228 3h-24l2-6h2.104l-1.33 4h18.45l-1.297-4h2.073l2 6zm-5-10h-14v-7h14v7z"/></symbol></defs><defs><symbol id="database" fill-rule="evenodd" clip-rule="evenodd"><path transform="scale(.5)" d="M12.258.001l.256.004.255.005.253.008.251.01.249.012.247.015.246.016.242.019.241.02.239.023.236.024.233.027.231.028.229.031.225.032.223.034.22.036.217.038.214.04.211.041.208.043.205.045.201.046.198.048.194.05.191.051.187.053.183.054.18.056.175.057.172.059.168.06.163.061.16.063.155.064.15.066.074.033.073.033.071.034.07.034.069.035.068.035.067.035.066.035.064.036.064.036.062.036.06.036.06.037.058.037.058.037.055.038.055.038.053.038.052.038.051.039.05.039.048.039.047.039.045.04.044.04.043.04.041.04.04.041.039.041.037.041.036.041.034.041.033.042.032.042.03.042.029.042.027.042.026.043.024.043.023.043.021.043.02.043.018.044.017.043.015.044.013.044.012.044.011.045.009.044.007.045.006.045.004.045.002.045.001.045v17l-.001.045-.002.045-.004.045-.006.045-.007.045-.009.044-.011.045-.012.044-.013.044-.015.044-.017.043-.018.044-.02.043-.021.043-.023.043-.024.043-.026.043-.027.042-.029.042-.03.042-.032.042-.033.042-.034.041-.036.041-.037.041-.039.041-.04.041-.041.04-.043.04-.044.04-.045.04-.047.039-.048.039-.05.039-.051.039-.052.038-.053.038-.055.038-.055.038-.058.037-.058.037-.06.037-.06.036-.062.036-.064.036-.064.036-.066.035-.067.035-.068.035-.069.035-.07.034-.071.034-.073.033-.074.033-.15.066-.155.064-.16.063-.163.061-.168.06-.172.059-.175.057-.18.056-.183.054-.187.053-.191.051-.194.05-.198.048-.201.046-.205.045-.208.043-.211.041-.214.04-.217.038-.22.036-.223.034-.225.032-.229.031-.231.028-.233.027-.236.024-.239.023-.241.02-.242.019-.246.016-.247.015-.249.012-.251.01-.253.008-.255.005-.256.004-.258.001-.258-.001-.256-.004-.255-.005-.253-.008-.251-.01-.249-.012-.247-.015-.245-.016-.243-.019-.241-.02-.238-.023-.236-.024-.234-.027-.231-.028-.228-.031-.226-.032-.223-.034-.22-.036-.217-.038-.214-.04-.211-.041-.208-.043-.204-.045-.201-.046-.198-.048-.195-.05-.19-.051-.187-.053-.184-.054-.179-.056-.176-.057-.172-.059-.167-.06-.164-.061-.159-.063-.155-.064-.151-.066-.074-.033-.072-.033-.072-.034-.07-.034-.069-.035-.068-.035-.067-.035-.066-.035-.064-.036-.063-.036-.062-.036-.061-.036-.06-.037-.058-.037-.057-.037-.056-.038-.055-.038-.053-.038-.052-.038-.051-.039-.049-.039-.049-.039-.046-.039-.046-.04-.044-.04-.043-.04-.041-.04-.04-.041-.039-.041-.037-.041-.036-.041-.034-.041-.033-.042-.032-.042-.03-.042-.029-.042-.027-.042-.026-.043-.024-.043-.023-.043-.021-.043-.02-.043-.018-.044-.017-.043-.015-.044-.013-.044-.012-.044-.011-.045-.009-.044-.007-.045-.006-.045-.004-.045-.002-.045-.001-.045v-17l.001-.045.002-.045.004-.045.006-.045.007-.045.009-.044.011-.045.012-.044.013-.044.015-.044.017-.043.018-.044.02-.043.021-.043.023-.043.024-.043.026-.043.027-.042.029-.042.03-.042.032-.042.033-.042.034-.041.036-.041.037-.041.039-.041.04-.041.041-.04.043-.04.044-.04.046-.04.046-.039.049-.039.049-.039.051-.039.052-.038.053-.038.055-.038.056-.038.057-.037.058-.037.06-.037.061-.036.062-.036.063-.036.064-.036.066-.035.067-.035.068-.035.069-.035.07-.034.072-.034.072-.033.074-.033.151-.066.155-.064.159-.063.164-.061.167-.06.172-.059.176-.057.179-.056.184-.054.187-.053.19-.051.195-.05.198-.048.201-.046.204-.045.208-.043.211-.041.214-.04.217-.038.22-.036.223-.034.226-.032.228-.031.231-.028.234-.027.236-.024.238-.023.241-.02.243-.019.245-.016.247-.015.249-.012.251-.01.253-.008.255-.005.256-.004.258-.001.258.001zm-9.258 20.499v.01l.001.021.003.021.004.022.005.021.006.022.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.023.018.024.019.024.021.024.022.025.023.024.024.025.052.049.056.05.061.051.066.051.07.051.075.051.079.052.084.052.088.052.092.052.097.052.102.051.105.052.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.048.144.049.147.047.152.047.155.047.16.045.163.045.167.043.171.043.176.041.178.041.183.039.187.039.19.037.194.035.197.035.202.033.204.031.209.03.212.029.216.027.219.025.222.024.226.021.23.02.233.018.236.016.24.015.243.012.246.01.249.008.253.005.256.004.259.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.021.224-.024.22-.026.216-.027.212-.028.21-.031.205-.031.202-.034.198-.034.194-.036.191-.037.187-.039.183-.04.179-.04.175-.042.172-.043.168-.044.163-.045.16-.046.155-.046.152-.047.148-.048.143-.049.139-.049.136-.05.131-.05.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.053.083-.051.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.05.023-.024.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.023.01-.022.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.127l-.077.055-.08.053-.083.054-.085.053-.087.052-.09.052-.093.051-.095.05-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.045-.118.044-.12.043-.122.042-.124.042-.126.041-.128.04-.13.04-.132.038-.134.038-.135.037-.138.037-.139.035-.142.035-.143.034-.144.033-.147.032-.148.031-.15.03-.151.03-.153.029-.154.027-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.01-.179.008-.179.008-.181.006-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.006-.179-.008-.179-.008-.178-.01-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.027-.153-.029-.151-.03-.15-.03-.148-.031-.146-.032-.145-.033-.143-.034-.141-.035-.14-.035-.137-.037-.136-.037-.134-.038-.132-.038-.13-.04-.128-.04-.126-.041-.124-.042-.122-.042-.12-.044-.117-.043-.116-.045-.113-.045-.112-.046-.109-.047-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.05-.093-.052-.09-.051-.087-.052-.085-.053-.083-.054-.08-.054-.077-.054v4.127zm0-5.654v.011l.001.021.003.021.004.021.005.022.006.022.007.022.009.022.01.022.011.023.012.023.013.023.015.024.016.023.017.024.018.024.019.024.021.024.022.024.023.025.024.024.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.052.11.051.114.051.119.052.123.05.127.051.131.05.135.049.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.044.171.042.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.022.23.02.233.018.236.016.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.012.241-.015.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.048.139-.05.136-.049.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.051.051-.049.023-.025.023-.024.021-.025.02-.024.019-.024.018-.024.017-.024.015-.023.014-.023.013-.024.012-.022.01-.023.01-.023.008-.022.006-.022.006-.022.004-.021.004-.022.001-.021.001-.021v-4.139l-.077.054-.08.054-.083.054-.085.052-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.049-.105.048-.106.047-.109.047-.111.046-.114.045-.115.044-.118.044-.12.044-.122.042-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.035-.143.033-.144.033-.147.033-.148.031-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.025-.161.024-.162.023-.163.022-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.011-.178.009-.179.009-.179.007-.181.007-.182.005-.182.004-.184.003-.184.002h-.37l-.184-.002-.184-.003-.182-.004-.182-.005-.181-.007-.179-.007-.179-.009-.178-.009-.176-.011-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.022-.162-.023-.161-.024-.159-.025-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.031-.146-.033-.145-.033-.143-.033-.141-.035-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.04-.126-.041-.124-.042-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.047-.105-.048-.102-.049-.1-.049-.097-.05-.095-.051-.093-.051-.09-.051-.087-.053-.085-.052-.083-.054-.08-.054-.077-.054v4.139zm0-5.666v.011l.001.02.003.022.004.021.005.022.006.021.007.022.009.023.01.022.011.023.012.023.013.023.015.023.016.024.017.024.018.023.019.024.021.025.022.024.023.024.024.025.052.05.056.05.061.05.066.051.07.051.075.052.079.051.084.052.088.052.092.052.097.052.102.052.105.051.11.052.114.051.119.051.123.051.127.05.131.05.135.05.139.049.144.048.147.048.152.047.155.046.16.045.163.045.167.043.171.043.176.042.178.04.183.04.187.038.19.037.194.036.197.034.202.033.204.032.209.03.212.028.216.027.219.025.222.024.226.021.23.02.233.018.236.017.24.014.243.012.246.01.249.008.253.006.256.003.259.001.26-.001.257-.003.254-.006.25-.008.247-.01.244-.013.241-.014.237-.016.233-.018.231-.02.226-.022.224-.024.22-.025.216-.027.212-.029.21-.03.205-.032.202-.033.198-.035.194-.036.191-.037.187-.039.183-.039.179-.041.175-.042.172-.043.168-.044.163-.045.16-.045.155-.047.152-.047.148-.048.143-.049.139-.049.136-.049.131-.051.126-.05.123-.051.118-.052.114-.051.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.052.07-.051.065-.051.06-.051.056-.05.051-.049.023-.025.023-.025.021-.024.02-.024.019-.024.018-.024.017-.024.015-.023.014-.024.013-.023.012-.023.01-.022.01-.023.008-.022.006-.022.006-.022.004-.022.004-.021.001-.021.001-.021v-4.153l-.077.054-.08.054-.083.053-.085.053-.087.053-.09.051-.093.051-.095.051-.097.05-.1.049-.102.048-.105.048-.106.048-.109.046-.111.046-.114.046-.115.044-.118.044-.12.043-.122.043-.124.042-.126.041-.128.04-.13.039-.132.039-.134.038-.135.037-.138.036-.139.036-.142.034-.143.034-.144.033-.147.032-.148.032-.15.03-.151.03-.153.028-.154.028-.156.027-.158.026-.159.024-.161.024-.162.023-.163.023-.165.021-.166.02-.167.019-.169.018-.169.017-.171.016-.173.015-.173.014-.175.013-.175.012-.177.01-.178.01-.179.009-.179.007-.181.006-.182.006-.182.004-.184.003-.184.001-.185.001-.185-.001-.184-.001-.184-.003-.182-.004-.182-.006-.181-.006-.179-.007-.179-.009-.178-.01-.176-.01-.176-.012-.175-.013-.173-.014-.172-.015-.171-.016-.17-.017-.169-.018-.167-.019-.166-.02-.165-.021-.163-.023-.162-.023-.161-.024-.159-.024-.157-.026-.156-.027-.155-.028-.153-.028-.151-.03-.15-.03-.148-.032-.146-.032-.145-.033-.143-.034-.141-.034-.14-.036-.137-.036-.136-.037-.134-.038-.132-.039-.13-.039-.128-.041-.126-.041-.124-.041-.122-.043-.12-.043-.117-.044-.116-.044-.113-.046-.112-.046-.109-.046-.106-.048-.105-.048-.102-.048-.1-.05-.097-.049-.095-.051-.093-.051-.09-.052-.087-.052-.085-.053-.083-.053-.08-.054-.077-.054v4.153zm8.74-8.179l-.257.004-.254.005-.25.008-.247.011-.244.012-.241.014-.237.016-.233.018-.231.021-.226.022-.224.023-.22.026-.216.027-.212.028-.21.031-.205.032-.202.033-.198.034-.194.036-.191.038-.187.038-.183.04-.179.041-.175.042-.172.043-.168.043-.163.045-.16.046-.155.046-.152.048-.148.048-.143.048-.139.049-.136.05-.131.05-.126.051-.123.051-.118.051-.114.052-.11.052-.106.052-.101.052-.096.052-.092.052-.088.052-.083.052-.079.052-.074.051-.07.052-.065.051-.06.05-.056.05-.051.05-.023.025-.023.024-.021.024-.02.025-.019.024-.018.024-.017.023-.015.024-.014.023-.013.023-.012.023-.01.023-.01.022-.008.022-.006.023-.006.021-.004.022-.004.021-.001.021-.001.021.001.021.001.021.004.021.004.022.006.021.006.023.008.022.01.022.01.023.012.023.013.023.014.023.015.024.017.023.018.024.019.024.02.025.021.024.023.024.023.025.051.05.056.05.06.05.065.051.07.052.074.051.079.052.083.052.088.052.092.052.096.052.101.052.106.052.11.052.114.052.118.051.123.051.126.051.131.05.136.05.139.049.143.048.148.048.152.048.155.046.16.046.163.045.168.043.172.043.175.042.179.041.183.04.187.038.191.038.194.036.198.034.202.033.205.032.21.031.212.028.216.027.22.026.224.023.226.022.231.021.233.018.237.016.241.014.244.012.247.011.25.008.254.005.257.004.26.001.26-.001.257-.004.254-.005.25-.008.247-.011.244-.012.241-.014.237-.016.233-.018.231-.021.226-.022.224-.023.22-.026.216-.027.212-.028.21-.031.205-.032.202-.033.198-.034.194-.036.191-.038.187-.038.183-.04.179-.041.175-.042.172-.043.168-.043.163-.045.16-.046.155-.046.152-.048.148-.048.143-.048.139-.049.136-.05.131-.05.126-.051.123-.051.118-.051.114-.052.11-.052.106-.052.101-.052.096-.052.092-.052.088-.052.083-.052.079-.052.074-.051.07-.052.065-.051.06-.05.056-.05.051-.05.023-.025.023-.024.021-.024.02-.025.019-.024.018-.024.017-.023.015-.024.014-.023.013-.023.012-.023.01-.023.01-.022.008-.022.006-.023.006-.021.004-.022.004-.021.001-.021.001-.021-.001-.021-.001-.021-.004-.021-.004-.022-.006-.021-.006-.023-.008-.022-.01-.022-.01-.023-.012-.023-.013-.023-.014-.023-.015-.024-.017-.023-.018-.024-.019-.024-.02-.025-.021-.024-.023-.024-.023-.025-.051-.05-.056-.05-.06-.05-.065-.051-.07-.052-.074-.051-.079-.052-.083-.052-.088-.052-.092-.052-.096-.052-.101-.052-.106-.052-.11-.052-.114-.052-.118-.051-.123-.051-.126-.051-.131-.05-.136-.05-.139-.049-.143-.048-.148-.048-.152-.048-.155-.046-.16-.046-.163-.045-.168-.043-.172-.043-.175-.042-.179-.041-.183-.04-.187-.038-.191-.038-.194-.036-.198-.034-.202-.033-.205-.032-.21-.031-.212-.028-.216-.027-.22-.026-.224-.023-.226-.022-.231-.021-.233-.018-.237-.016-.241-.014-.244-.012-.247-.011-.25-.008-.254-.005-.257-.004-.26-.001-.26.001z"/></symbol></defs><defs><symbol id="clock" width="24" height="24"><path transform="scale(.5)" d="M12 2c5.514 0 10 4.486 10 10s-4.486 10-10 10-10-4.486-10-10 4.486-10 10-10zm0-2c-6.627 0-12 5.373-12 12s5.373 12 12 12 12-5.373 12-12-5.373-12-12-12zm5.848 12.459c.202.038.202.333.001.372-1.907.361-6.045 1.111-6.547 1.111-.719 0-1.301-.582-1.301-1.301 0-.512.77-5.447 1.125-7.445.034-.192.312-.181.343.014l.985 6.238 5.394 1.011z"/></symbol></defs><defs><marker id="arrowhead" refX="7.9" refY="5" markerUnits="userSpaceOnUse" markerWidth="12" markerHeight="12" orient="auto"><path d="M 0 0 L 10 5 L 0 10 z"/></marker></defs><defs><marker id="crosshead" markerWidth="15" markerHeight="8" orient="auto" refX="4" refY="4.5"><path fill="none" stroke="#000000" stroke-width="1pt" d="M 1,2 L 6,7 M 6,2 L 1,7" style="stroke-dasharray: 0, 0;"/></marker></defs><defs><marker id="filled-head" refX="15.5" refY="7" markerWidth="20" markerHeight="28" orient="auto"><path d="M 18,7 L9,13 L14,7 L9,1 Z"/></marker></defs><defs><marker id="sequencenumber" refX="15" refY="15" markerWidth="60" markerHeight="40" orient="auto"><circle cx="15" cy="15" r="6"/></marker></defs><g><rect x="50" y="75" fill="#EDF2AE" stroke="#666" width="754" height="39" rx="0" ry="0" class="note"/><text x="427" y="80" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-size: 16px; font-weight: 400;"><tspan x="427">1. Session invitation</tspan></text></g><g><rect x="232.5" y="212" fill="#EDF2AE" stroke="#666" width="189" height="39" rx="0" ry="0" class="note"/><text x="327" y="217" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-size: 16px; font-weight: 400;"><tspan x="327">Listen for TCP connection</tspan></text></g><g><rect x="322" y="251" fill="#EDF2AE" stroke="#666" width="10" height="863" rx="0" ry="0" class="activation0"/></g><g><rect x="50" y="305" fill="#EDF2AE" stroke="#666" width="754" height="39" rx="0" ry="0" class="note"/><text x="427" y="310" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-size: 16px; font-weight: 400;"><tspan x="427">2. Establishing TLS connection</tspan></text></g><g><rect x="302" y="398" fill="#EDF2AE" stroke="#666" width="250" height="39" rx="0" ry="0" class="note"/><text x="427" y="403" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-size: 16px; font-weight: 400;"><tspan x="427">TLS handshake</tspan></text></g><g><rect x="215.5" y="472" fill="#EDF2AE" stroke="#666" width="223" height="39" rx="0" ry="0" class="note"/><text x="327" y="477" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-size: 16px; font-weight: 400;"><tspan x="327">validate client X509 credentials</tspan></text></g><g><rect x="413.5" y="636" fill="#EDF2AE" stroke="#666" width="227" height="39" rx="0" ry="0" class="note"/><text x="527" y="641" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-size: 16px; font-weight: 400;"><tspan x="527">validate server X509 credentials</tspan></text></g><g><line x1="64" y1="447" x2="790" y2="447" class="loopLine"/><line x1="790" y1="447" x2="790" y2="775" class="loopLine"/><line x1="64" y1="775" x2="790" y2="775" class="loopLine"/><line x1="64" y1="447" x2="64" y2="775" class="loopLine"/><line x1="64" y1="616" x2="790" y2="616" class="loopLine" style="stroke-dasharray: 3, 3;"/><polygon points="64,447 114,447 114,460 105.6,467 64,467" class="labelBox"/><text x="89" y="460" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="labelText" style="font-size: 16px; font-weight: 400;">par</text><text x="452" y="465" text-anchor="middle" class="loopText" style="font-size: 16px; font-weight: 400;"><tspan x="452">​</tspan></text></g><g><rect x="50" y="785" fill="#EDF2AE" stroke="#666" width="754" height="39" rx="0" ry="0" class="note"/><text x="427" y="790" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-size: 16px; font-weight: 400;"><tspan x="427">3. Session verification and protocol negotiation</tspan></text></g><g><rect x="215" y="878" fill="#EDF2AE" stroke="#666" width="224" height="39" rx="0" ry="0" class="note"/><text x="327" y="883" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-size: 16px; font-weight: 400;"><tspan x="327">validate version, CA fingerprint</tspan></text></g><g><rect x="302" y="1065" fill="#EDF2AE" stroke="#666" width="250" height="39" rx="0" ry="0" class="note"/><text x="427" y="1070" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-size: 16px; font-weight: 400;"><tspan x="427">update stored keys</tspan></text></g><g><line x1="292" y1="927" x2="562" y2="927" class="loopLine"/><line x1="562" y1="927" x2="562" y2="1114" class="loopLine"/><line x1="292" y1="1114" x2="562" y2="1114" class="loopLine"/><line x1="292" y1="927" x2="292" y2="1114" class="loopLine"/><line x1="292" y1="1001" x2="562" y2="1001" class="loopLine" style="stroke-dasharray: 3, 3;"/><polygon points="292,927 342,927 342,940 333.6,947 292,947" class="labelBox"/><text x="317" y="940" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="labelText" style="font-size: 16px; font-weight: 400;">alt</text><text x="452" y="945" text-anchor="middle" class="loopText" style="font-size: 16px; font-weight: 400;"><tspan x="452">​</tspan></text></g><g><rect x="50" y="1124" fill="#EDF2AE" stroke="#666" width="754" height="39" rx="0" ry="0" class="note"/><text x="427" y="1129" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="noteText" dy="1em" style="font-size: 16px; font-weight: 400;"><tspan x="427">4. Session operation</tspan></text></g><g><line x1="64" y1="1173" x2="538" y2="1173" class="loopLine"/><line x1="538" y1="1173" x2="538" y2="1378" class="loopLine"/><line x1="64" y1="1378" x2="538" y2="1378" class="loopLine"/><line x1="64" y1="1173" x2="64" y2="1378" class="loopLine"/><polygon points="64,1173 114,1173 114,1186 105.6,1193 64,1193" class="labelBox"/><text x="89" y="1186" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="labelText" style="font-size: 16px; font-weight: 400;">loop</text><text x="326" y="1191" text-anchor="middle" class="loopText" style="font-size: 16px; font-weight: 400;"><tspan x="326">​</tspan></text></g><text x="200" y="129" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">"Link a mobile"</text><line x1="76" y1="158" x2="323" y2="158" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"/><text x="203" y="173" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">Session invitation URI</text><line x1="326" y1="202" x2="79" y2="202" class="messageLine1" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="stroke-dasharray: 3, 3; fill: none;"/><text x="655" y="266" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">Session invitation URI</text><line x1="778" y1="295" x2="531" y2="295" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"/><text x="431" y="359" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">TCP connect</text><line x1="526" y1="388" x2="335" y2="388" class="messageLine1" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="stroke-dasharray: 3, 3; fill: none;"/><text x="201" y="526" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">session code from tlsUnique</text><line x1="322" y1="557" x2="79" y2="557" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"/><text x="198" y="572" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">user confirmation</text><line x1="76" y1="601" x2="319" y2="601" class="messageLine1" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="stroke-dasharray: 3, 3; fill: none;"/><text x="652" y="690" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">session code from tlsUnique</text><line x1="528" y1="721" x2="775" y2="721" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"/><text x="655" y="736" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">user confirmation</text><line x1="778" y1="765" x2="531" y2="765" class="messageLine1" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="stroke-dasharray: 3, 3; fill: none;"/><text x="431" y="839" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">host HELLO</text><line x1="526" y1="868" x2="335" y2="868" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"/><text x="428" y="957" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">controller ERROR</text><line x1="332" y1="986" x2="523" y2="986" class="messageLine1" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="stroke-dasharray: 3, 3; fill: none;"/><text x="428" y="1026" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">controller HELLO</text><line x1="332" y1="1055" x2="523" y2="1055" class="messageLine1" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="stroke-dasharray: 3, 3; fill: none;"/><text x="200" y="1203" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">command</text><line x1="76" y1="1232" x2="323" y2="1232" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"/><text x="426" y="1247" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">XRCP command</text><line x1="328" y1="1276" x2="523" y2="1276" class="messageLine0" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="fill: none;"/><text x="429" y="1291" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">XRCP response</text><line x1="526" y1="1322" x2="331" y2="1322" class="messageLine1" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="stroke-dasharray: 3, 3; fill: none;"/><text x="203" y="1337" text-anchor="middle" dominant-baseline="middle" alignment-baseline="middle" class="messageText" dy="1em" style="font-size: 16px; font-weight: 400;">response</text><line x1="326" y1="1368" x2="79" y2="1368" class="messageLine1" stroke-width="2" stroke="none" marker-end="url(#arrowhead)" style="stroke-dasharray: 3, 3; fill: none;"/></svg>
\ No newline at end of file
diff --git a/protocol/overview-tjr.md b/protocol/overview-tjr.md
index 7f1e72768..d30f55235 100644
--- a/protocol/overview-tjr.md
+++ b/protocol/overview-tjr.md
@@ -1,4 +1,4 @@
-Revision 1, 2022-01-01
+Revision 2, 2024-06-22
 
 Evgeny Poberezkin
 
@@ -13,19 +13,23 @@ Evgeny Poberezkin
 - [Technical Details](#technical-details)
   - [Trust in Servers](#trust-in-servers)
   - [Client -> Server Communication](#client---server-communication)
+  - [2-hop Onion Message Routing](#2-hop-onion-message-routing)
   - [SimpleX Messaging Protocol](#simplex-messaging-protocol)
   - [SimpleX Agents](#simplex-agents)
   - [Encryption Primitives Used](#encryption-primitives-used)
 - [Threat model](#threat-model)
 - [Acknowledgements](#acknowledgements)
 
+
 ## Introduction
 
 #### What is SimpleX
 
 SimpleX as a whole is a platform upon which applications can be built. [SimpleX Chat](https://github.com/simplex-chat/simplex-chat) is one such application that also serves as an example and reference application.
 
- - [SimpleX Messaging Protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md) (SMP) is a protocol to send messages in one direction to a recipient, relying on a server in-between. The messages are delivered via uni-directional queues created by recipients.
+ - [SimpleX Messaging Protocol](./simplex-messaging.md) (SMP) is a protocol to send messages in one direction to a recipient, relying on a server in-between. The messages are delivered via uni-directional queues created by recipients.
+ 
+ - SMP protocol allows to send message via a SMP server playing proxy role using 2-hop onion routing (referred to as "private routing" in messaging clients) to protect transport information of the sender (IP address and session) from the server chosen (and possibly controlled) by the recipient.
 
  - SMP runs over a transport protocol (shown below as TLS) that provides integrity, server authentication, confidentiality, and transport channel binding.
 
@@ -35,7 +39,9 @@ SimpleX as a whole is a platform upon which applications can be built. [SimpleX
 
  - SimpleX Client libraries speak SMP to SimpleX Servers and provide a low-level API not generally intended to be used by applications.
 
- - SimpleX Agents interface with SimpleX Clients to provide a more high-level API intended to be used by applications. Typically they are embedded as libraries, but are designed so they can also be abstracted into local services.
+ - SimpleX Agents interface with SimpleX Clients to provide a more high-level API intended to be used by applications. Typically they are embedded as libraries, but can also be abstracted into local services.
+
+ - SimpleX Agents communicate with other agents inside e2e encrypted envelopes provided by SMP protocol - the syntax and semantics of the messages exchanged by the agent are defined by [SMP agent protocol](./agent-protocol.md)
 
 
 *Diagram showing the SimpleX Chat app, with logical layers of the chat application interfacing with a SimpleX Agent library, which in turn interfaces with a SimpleX Client library. The Client library in turn speaks the Messaging Protocol to a SimpleX Server.*
@@ -72,10 +78,11 @@ SimpleX as a whole is a platform upon which applications can be built. [SimpleX
 
    - Low latency: the delay introduced by the network should not be higher than 100ms-1s in addition to the underlying TCP network latency.
 
-2. Provide better communication security and privacy than the alternative instant messaging solutions.  In particular SimpleX provides better privacy of metadata (who talks to whom and when) and better security against active network attackers and malicious servers.
+2. Provide better communication security and privacy than the alternative instant messaging solutions. In particular SimpleX provides better privacy of metadata (who talks to whom and when) and better security against active network attackers and malicious servers.
 
 3. Balance user experience with privacy requirements, prioritizing experience of mobile device users.
 
+
 #### In Comparison
 
 SimpleX network has a design similar to P2P networks, but unlike most P2P networks it consists of clients and servers without depending on any centralized component.
@@ -91,53 +98,73 @@ In comparison to more traditional messaging applications (e.g. WhatsApp, Signal,
 
 - users can change servers with minimal disruption - even after an in-use server disappears, simply by changing the configuration on which servers the new queues are created.
 
+
 ## Technical Details
 
 #### Trust in Servers
 
 Clients communicate directly with servers (but not with other clients) using SimpleX Messaging Protocol (SMP) running over some transport protocol that provides integrity, server authentication, confidentiality, and transport channel binding. By default, we assume this transport protocol is TLS.
 
-Users use multiple servers, and choose where to receive their messages. Accordingly, they send messages to their communication partners' chosen servers.
+Users use multiple servers, and choose where to receive their messages. Accordingly, they send messages to their communication partners' chosen servers either directly, if this is a known/trusted server, or via another SMP server providing proxy functionality to protect IP address and session of the sender.
 
-Although end-to-end encryption is always present, users place a degree of trust in servers. This trust decision is very similar to a user's choice of email provider; however the trust placed in a SimpleX server is significantly less. Notably, there is no re-used identifier or credential between queues on the same (or different) servers. While a user *may* re-use a connection to fetch from multiple queues, or connect to a server from the same IP address, both are choices a user may opt into to break the promise of un-correlatable queues.
+Although end-to-end encryption is always present, users place a degree of trust in servers they connect to. This trust decision is very similar to a user's choice of email provider; however the trust placed in a SimpleX server is significantly less. Notably, there is no re-used identifier or credential between queues on the same (or different) servers. While a user *may* re-use a transport connection to fetch messages from multiple queues, or connect to a server from the same IP address, both are choices a user may opt into to break the promise of un-correlatable queues.
 
 Users may trust a server because:
 
-- They deploy and control the servers themselves from the available open-source code. This has the trade-offs of strong trust in the server but limited metadata obfuscation to a passive network observer. Techniques such as noise traffic, traffic mixing (incurring latency), and using an onion routing transport protocol can mitigate that latter.
+- They deploy and control the servers themselves from the available open-source code. This has the trade-offs of strong trust in the server but limited metadata obfuscation to a passive network observer. Techniques such as noise traffic, traffic mixing (incurring latency), and using an onion routing transport protocol can mitigate that.
 
 - They use servers from a trusted commercial provider. The more clients the provider has, the less metadata about the communication times is leaked to the network observers.
 
-- Users trust their contacts and the servers they chose.
+By default, servers do not retain access logs, and permanently delete messages and queues when requested. Messages persist only in memory until they cross a threshold of time, typically on the order of days.[0] There is still a risk that a server maliciously records all queues and messages (even though encrypted) sent via the same transport connection to gain a partial knowledge of the user’s communications graph and other meta-data.
 
-By default, servers do not retain access logs, and permanently delete messages and queues when requested.  Messages persist only in memory until they cross a threshold of time, typically on the order of days.[0] There is still a risk that a server maliciously records all queues and messages (even though encrypted) sent via the same transport connection to gain a partial knowledge of the user’s communications graph and other meta-data.
+SimpleX supports measures (managed transparently to the user at the agent level) to mitigate the trust placed in servers.  These include rotating the queues in use between users, noise traffic, supporting overlay networks such as Tor, and isolating traffic to different queues to different transport connections (and Tor circuits, if Tor is used).
 
-SimpleX supports measures (managed transparently to the user at the agent level) to mitigate the trust placed in servers.  These include rotating the queues in use between users, noise traffic, and supporting overlay networks such as Tor.
-
-[0] While configurable by servers, a minimum value is enforced by the default software. SimpleX Agents provide redundant routing over queues to mitigate against message loss.
+[0] While configurable by servers, a minimum value is enforced by the default software. SimpleX Agents can provide redundant routing over queues to mitigate against message loss.
 
 
 #### Client -> Server Communication
 
 Utilizing TLS grants the SimpleX Messaging Protocol (SMP) server authentication and metadata protection to a passive network observer. But SMP does not rely on the transport protocol for message confidentiality or client authentication. The SMP protocol itself provides end-to-end confidentiality, authentication, and integrity of messages between communicating parties.
 
-Servers have long-lived, self-signed, offline certificates whose hash is pre-shared with clients over secure channels - either provided with the client library or provided in the secure introduction between clients.  The offline certificate signs an online certificate used in the transport protocol handshake. [0]
+Servers have long-lived, self-signed, offline certificates whose hash is pre-shared with clients over secure channels - either provided with the client library or provided in the secure introduction between clients, as part of the server address.  The offline certificate signs an online certificate used in the transport protocol handshake. [0]
 
 If the transport protocol's confidentiality is broken, incoming and outgoing messages to the server cannot be correlated by message contents. Additionally, because of encryption at the SMP layer, impersonating the server is not sufficient to pass (and therefore correlate) a message from a sender to recipient - the only attack possible is to drop the messages. Only by additionally *compromising* the server can one pass and correlate messages.
 
 It's important to note that the SMP protocol does not do server authentication. Instead we rely upon the fact that an attacker who tricks the transport protocol into authenticating the server incorrectly cannot do anything with the SMP messages except drop them.
 
-After the connection is established, the client sends blocks of a fixed size 16Kb, and the server replies with the blocks of the same size to reduce metadata observable to a network adversary. The protocol has been designed to make traffic correlation attacks difficult, adapting ideas from Tor, remailers, and more general onion and mix networks. It does not try to replace Tor though - SimpleX servers can be deployed as onion services and SimpleX clients can communicate with servers over Tor to further improve participants privacy.
+After the connection is established, the client sends blocks of a fixed size 16KB, and the server replies with the blocks of the same size to reduce metadata observable to a network adversary. The protocol has been designed to make traffic correlation attacks difficult, adapting ideas from Tor, remailers, and more general onion and mix networks. It does not try to replace Tor though - SimpleX servers can be deployed as onion services and SimpleX clients can communicate with servers over Tor to further improve participants privacy.
 
-By using fixed-size blocks, oversized for the expected content, the vast majority of traffic is uniform in nature. When enough traffic is transiting a server simultaneously, the server acts as a (very) low-latency mix node.  We can't rely on this behavior to make a security claim, but we have engineered to take advantage of it when we can. As mentioned, this holds true even if the transport connection is compromised.
+By using fixed-size blocks, oversized for the expected content, the vast majority of traffic is uniform in nature. When enough traffic is transiting a server simultaneously, the server acts as a low-latency mix node. We can't rely on this behavior to make a security claim, but we have engineered to take advantage of it when we can. As mentioned, this holds true even if the transport connection is compromised.
 
-The protocol does not protect against attacks targeted at particular users with known identities - e.g., if the attacker wants to prove that two known users are communicating, they can achieve it. At the same time, it substantially complicates large-scale traffic correlation, making determining the real user identities much less effective.
+The protocol does not protect against attacks targeted at particular users with known identities - e.g., if the attacker wants to prove that two known users are communicating, they can achieve it by observing their local traffic. At the same time, it substantially complicates large-scale traffic correlation, making determining the real user identities much less effective.
 
 [0] Future versions of SMP may add support for revocation lists of certificates, presently this risk is mitigated by the SMP protocol itself.
 
 
+#### 2-hop Onion Message Routing
+
+As SimpleX Messaging Protocol servers providing messaging queues are chosen by the recipients, in case senders connect to these servers directly the server owners (who potentially can be the recipients themselves) can learn senders' IP addresses (if Tor is not used) and which other queues on the same server are accessed by the user in the same transport connection (even if Tor is used).
+
+While the clients support isolating the messages sent to different queues into different transport connections (and Tor circuits), this is not practical, as it consumes additional traffic and system resources.
+
+To mitigate this problem SimpleX Messaging Protocol servers support 2-hop onion message routing when the SMP server chosen by the sender forwards the messages to the servers chosen by the recipients, thus protecting both the senders IP addresses and sessions, even if connection isolation and Tor are not used.
+
+The design of 2-hop onion message routing prevents these potential attacks:
+
+- MITM by proxy (SMP server that forwards the messages).
+
+- Identification by the proxy which and how many queues the sender sends messages to (as messages are additionally e2e encrypted between the sender and the destination SMP server).
+
+- Correlation of messages sent to different queues via the same user session (as random correlation IDs and keys are used for each message).
+
+See more details about 2-hop onion message routing design in [SimpleX Messaging Protocol](./simplex-messaging.md#proxying-sender-commands)
+
+Also see [Threat model](#threat-model)
+
+
 #### SimpleX Messaging Protocol
 
-SMP is initialized with an in-person or out-of-band introduction message, where Alice provides Bob with details of a server (including IP, port, and hash of the long-lived offline certificate), a queue ID, and Alice's public key for her receiving queue. These introductions are similar to the PANDA key-exchange, in that if observed, the adversary can race to establish the communication channel instead of the intended participant. [0]
+SMP is initialized with an in-person or out-of-band introduction message, where Alice provides Bob with details of a server (including IP address or host name, port, and hash of the long-lived offline certificate), a queue ID, and Alice's public keys to agree e2e encryption. These introductions are similar to the PANDA key-exchange, in that if observed, the adversary can race to establish the communication channel instead of the intended participant. [0]
 
 Because queues are uni-directional, Bob provides an identically-formatted introduction message to Alice over Alice's now-established receiving queue.
 
@@ -145,6 +172,7 @@ When setting up a queue, the server will create separate sender and recipient qu
 
 [0] Users can additionally create public 'contact queues' that are only used to receive connection requests.  
 
+
 #### SimpleX Agents
 
 SimpleX agents provide higher-level operations compared to SimpleX Clients, who are primarily concerned with creating queues and communicating with servers using SMP.  Agent operations include:
@@ -157,9 +185,10 @@ SimpleX agents provide higher-level operations compared to SimpleX Clients, who
 
 - Noise traffic
 
+
 #### Encryption Primitives Used
 
-- Ed448 to sign/verify commands to SMP servers (Ed25519 is also supported via client/server configuration).
+- Ed25519 or Curve25519 to authorize/verify commands to SMP servers (authorization algorithm is set via client/server configuration).
 - Curve25519 for DH exchange to agree:
   - the shared secret between server and recipient (to encrypt message bodies - it avoids shared cipher-text in sender and recipient traffic)
   - the shared secret between sender and recipient (to encrypt messages end-to-end in each queue - it avoids shared cipher-text in redundant queues).
@@ -170,42 +199,44 @@ SimpleX agents provide higher-level operations compared to SimpleX Clients, who
   - AES-GCM AEAD cipher,
   - SHA512-based HKDF for key derivation.
 
+
 ## Threat Model
 
 #### Global Assumptions
 
- - A user protects their local database and key material
- - The user's application is authentic, and no local malware is running
- - The cryptographic primitives in use are not broken
+ - A user protects their local database and key material.
+ - The user's application is authentic, and no local malware is running.
+ - The cryptographic primitives in use are not broken.
  - A user's choice of servers is not directly tied to their identity or otherwise represents distinguishing information about the user.
+ - The user's client uses 2-hop onion message routing.
 
 #### A passive adversary able to monitor the traffic of one user
 
 *can:*
 
- - identify that and when a user is using SimpleX
+ - identify that and when a user is using SimpleX.
 
- - block SimpleX traffic
-
- - determine which servers the user communicates with
+ - determine which servers the user receives the messages from.
 
  - observe how much traffic is being sent, and make guesses as to its purpose.
 
 *cannot:*
 
- - see who sends messages to the user and who the user sends the messages to
+ - see who sends messages to the user and who the user sends the messages to.
+
+ - determine the servers used by users' contacts.
 
 #### A passive adversary able to monitor a set of senders and recipients
 
  *can:*
 
- - identify who and when is using SimpleX
+ - identify who and when is using SimpleX.
 
- - learn which SimpleX Messaging Protocol servers are used as receive queues for which users
+ - learn which SimpleX Messaging Protocol servers are used as receive queues for which users.
 
- - learn when messages are sent and received
+ - learn when messages are sent and received.
 
- - perform traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers
+ - perform traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers.
 
  - observe how much traffic is being sent, and make guesses as to its purpose
 
@@ -217,43 +248,83 @@ SimpleX agents provide higher-level operations compared to SimpleX Clients, who
 
 *can:*
 
-- learn when a queue recipient or sender is online
+- learn when a queue recipient is online
 
-- know how many messages are sent via the queue (although some may be noise)
+- know how many messages are sent via the queue (although some may be noise or not content messages).
 
-- perform queue correlation (matching multiple queues to a single user) via either a re-used transport connection, user's IP Address, or connection timing regularities
+- learn which messages would trigger notifications even if a user does not use [push notifications](./push-notifications.md).
 
-- learn a user's IP address, track them through other IP addresses they use to access the same queue, and infer information (e.g. employer) based on the IP addresses, as long as Tor is not used.
+- perform the correlation of the queue used to receive messages (matching multiple queues to a single user) via either a re-used transport connection, user's IP Address, or connection timing regularities.
 
-- drop all future messages inserted into a queue, detectable only over other, redundant queues
+- learn a recipient's IP address, track them through other IP addresses they use to access the same queue, and infer information (e.g. employer) based on the IP addresses, as long as Tor is not used.
+
+- drop all future messages inserted into a queue, detectable only over other, redundant queues.
 
 - lie about the state of a queue to the recipient and/or to the sender  (e.g. suspended or deleted when it is not).
 
-- spam a user with invalid messages
+- spam a user with invalid messages.
 
 *cannot:*
 
-- undetectably add, duplicate, or corrupt individual messages
+- undetectably add, duplicate, or corrupt individual messages.
 
-- undetectably drop individual messages, so long as a subsequent message is delivered
+- undetectably drop individual messages, so long as a subsequent message is delivered.
 
-- learn the contents of messages
+- learn the contents or type of messages.
 
-- distinguish noise messages from regular messages except via timing regularities
+- distinguish noise messages from regular messages except via timing regularities.
 
-- compromise the user's end-to-end encryption with an active attack
+- compromise the users' end-to-end encryption with an active attack.
+
+- learn a sender's IP address, track them through other IP addresses they use to access the same queue, and infer information (e.g. employer) based on the IP addresses, even if Tor is not used (provided messages are sent via proxy SMP server).
+
+- perform senders' queue correlation (matching multiple queues to a single sender) via either a re-used transport connection, user's IP Address, or connection timing regularities, unless it has additional information from the proxy SMP server (provided messages are sent via proxy SMP server).
+
+#### SimpleX Messaging Protocol server that proxies the messages to another SMP server
+
+*can:*
+
+- learn a sender's IP address, as long as Tor is not used.
+
+- learn when a sender with a given IP address is online.
+
+- know how many messages are sent from a given IP address and to a given destination SMP server.
+
+- drop all messages from a given IP address or to a given destination server.
+
+- unless destination SMP server detects repeated public DH keys of senders, replay messages to a destination server within a single session, causing either duplicate message delivery (which will be detected and ignored by the receiving clients), or, when receiving client is not connected to SMP server, exhausting capacity of destination queues used within the session.
+
+*cannot:*
+
+- perform queue correlation (matching multiple queues to a single user), unless it has additional information from the destination SMP server.
+
+- undetectably add, duplicate, or corrupt individual messages.
+
+- undetectably drop individual messages, so long as a subsequent message is delivered.
+
+- learn the contents or type of messages.
+
+- learn which messages would trigger notifications.
+
+- learn the destination queues of messages.
+
+- distinguish noise messages from regular messages except via timing regularities.
+
+- compromise the user's end-to-end encryption with another user via an active attack.
+
+- compromise the user's end-to-end encryption with the destination SMP servers via an active attack.
 
 #### An attacker who obtained Alice's (decrypted) chat database
 
 *can:*
 
-- see the history of all messages exchanged by Alice with her communication partners
+- see the history of all messages exchanged by Alice with her communication partners.
 
-- see shared profiles of contacts and groups
+- see shared profiles of contacts and groups.
 
-- surreptitiously receive new messages sent to Alice via existing queues; until communication queues are rotated or the Double-Ratchet advances forward
+- surreptitiously receive new messages sent to Alice via existing queues; until communication queues are rotated or the Double-Ratchet advances forward.
 
-- prevent Alice from receiving all new messages sent to her - either surreptitiously by emptying the queues regularly or overtly by deleting them
+- prevent Alice from receiving all new messages sent to her - either surreptitiously by emptying the queues regularly or overtly by deleting them.
 
 - send messages from the user to their contacts; recipients will detect it as soon as the user sends the next message, because the previous message hash won’t match (and potentially won’t be able to decrypt them in case they don’t keep the previous ratchet keys).
 
@@ -269,41 +340,41 @@ SimpleX agents provide higher-level operations compared to SimpleX Clients, who
 
 *can:*
 
-- spam the user with messages
+- spam the user with messages.
 
-- forever retain messages from the user
+- forever retain messages from the user.
 
 *cannot:*
 
-- cryptographically prove to a third-party that a message came from a user (assuming the user’s device is not seized)
+- cryptographically prove to a third-party that a message came from a user (assuming the user’s device is not seized).
 
-- prove that two contacts they have is the same user
+- prove that two contacts they have is the same user.
 
-- cannot collaborate with another of the user's contacts to confirm they are communicating with the same user
+- cannot collaborate with another of the user's contacts to confirm they are communicating with the same user.
 
 #### An attacker who observes Alice showing an introduction message to Bob
 
 *can:*
 
- - Impersonate Bob to Alice
+ - Impersonate Bob to Alice.
 
 *cannot:*
 
- - Impersonate Alice to Bob
+ - Impersonate Alice to Bob.
 
 #### An attacker with Internet access
 
 *can:*
 
-- Denial of Service SimpleX messaging servers
+- Denial of Service SimpleX messaging servers.
 
-- spam a user's public “contact queue” with connection requests
+- spam a user's public “contact queue” with connection requests.
 
 *cannot:*
 
-- send messages to a user who they are not connected with
+- send messages to a user who they are not connected with.
 
-- enumerate queues on a SimpleX server
+- enumerate queues on a SimpleX server.
 
 
 ## Acknowledgements
diff --git a/protocol/pqdr.md b/protocol/pqdr.md
new file mode 100644
index 000000000..27f7082c8
--- /dev/null
+++ b/protocol/pqdr.md
@@ -0,0 +1,222 @@
+Version 1, 2024-06-22
+
+# Post-quantum resistant augmented double ratchet algorithm (PQDR)
+
+## Table of contents
+
+- [Overview](#overview)
+- [Comparison with the other approaches](#comparison-with-the-other-approaches)
+  - [PQXDH for post-quantum key agreement](#pqxdh-for-post-quantum-key-agreement) (Signal)
+  - [Hybrid Signal protocol for post-quantum encryption](#hybrid-signal-protocol-for-post-quantum-encryption) (Tutanota)
+- [Augmented double ratchet algorithm](#augmented-double-ratchet-algorithm)
+- [Double ratchet with encrypted headers augmented with double PQ KEM](#double-ratchet-with-encrypted-headers-augmented-with-double-pq-kem)
+  - [Initialization](#initialization)
+  - [Encrypting messages](#encrypting-messages)
+  - [Decrypting messages](#decrypting-messages)
+- [Implementation considerations](#implementation-considerations)
+- [Chosen KEM algorithm](#chosen-kem-algorithm)
+- [Summary](#summary)
+
+## Overview
+
+It is a reasonable assumption that "record-now-decrypt-later" attacks are ongoing, so the users want to use cryptographic schemes for end-to-end encryption that are augmented with some post-quantum algorithm that is believed to be resistant to quantum computers.
+
+SimpleX Chat uses [double-ratchet with header encryption](https://signal.org/docs/specifications/doubleratchet/#double-ratchet-with-header-encryption) to provide end-to-end encryption to messages and files. This document describes augmented algorithm with post-quantum key encapsulation mechanism (KEM) making it resistant to quantum computers.
+
+Double-ratchet algorithm is a state of the art solution for end to end encryption offering a set of qualities that is not present in any other algorithm:
+
+- perfect forward secrecy, i.e. compromise of session or long term keys does not lead to the ability to decrypt any of the past messages.
+- deniability (also known as repudiation), i.e. the fact that the recipient of the message while having the proof of message authenticity, cannot prove to a third party that the sender actually sent this message.
+- break-in recovery (also know as post-compromise security or future secrecy), i.e. the ability of the end-to-end encryption security to recover from the compromise of the long term keys. This is achieved by generating a new random key pair whenever a new DH key is received (DH ratchet step).
+
+It is desirable to preserve all these qualities when augmenting the algorithm with a post-quantum algorithm, and having these qualities resistant to both conventional and quantum computers.
+
+## Comparison with the other approaches
+
+### PQXDH for post-quantum key agreement
+
+[The solution](https://signal.org/docs/specifications/pqxdh/) recently [introduced by Signal](https://signal.org/blog/pqxdh/) augments the initial key agreement ([X3DH](https://signal.org/docs/specifications/x3dh/)) that is made prior to double ratchet algorithm. This is believed to provide protection from "record-now-decrypt-later" attack, but if the attacker at any point obtains long term keys from any of the devices, the break-in recovery will not be post-quantum resistant, and the attacker with quantum computer will be able to decrypt all the subsequent messages.
+
+### Hybrid Signal protocol for post-quantum encryption
+
+[The solution](https://eprint.iacr.org/2021/875.pdf) [proposed by Tutanota](https://tutanota.com/blog/posts/pqmail-update/) aims to preserve the break-in recovery property of double ratchet, but in doing so it:
+- replaces rather than augments DH key agreement with post-quantum KEM mechanism, making it potentially vulnerable to conventional computers.
+- adds signature to the DH ratchet step, to compensate for not keeping DH key agreement, but losing the deniability property for some of the messages.
+
+## Augmented double ratchet algorithm
+
+The double ratchet algorithm is augmented with post-quantum KEM mechanism, preserving all properties of the double ratchet algorithm.
+
+It is possible, because although double ratchet uses DH (which is a non-interactive key exchanges), it uses it "interactively", when the new DH keys are generated by both parties in turns. Parties of double-ratchet encrypted communication can run two post-quantum key encapsulation mechanisms in parallel with both DH and KEM key agreements in each DH ratchet step, making break-in recovery of double ratchet algorithm post-quantum resistant, without losing deniability or resistance to conventional computers.
+
+Specifically, [double ratchet with encrypted headers](https://signal.org/docs/specifications/doubleratchet/#double-ratchet-with-header-encryption) is augmented with some post-quantum key encapsulation mechanism (KEM) as described below. A possible algorithm for PQ KEM is [NTRU-prime](https://ntruprime.cr.yp.to), that is currently adopted in SSH and has available implementations. It is important though that the proposed scheme can be used with any PQ KEM algorithm.
+
+The downside of the scheme is its substantial size overhead, as the encapsulation key and encapsulated shared secret are added to the header of each message. For the algorithm described below NTRU-prime adds ~2-4kb to each message (depending on the key size and the chosen variant). See [this table](https://ntruprime.cr.yp.to/security.html) for key and ciphertext sizes and the assessment of the security level for various key sizes.
+
+It is possible to reduce size overhead by using only one KEM agreement and making only one of two ratchet steps providing post-quantum resistant break-in recovery.
+
+## Double ratchet with encrypted headers augmented with double PQ KEM
+
+Algorithm below assumes that in addition to shared secret from the initial key agreement, there will be an encapsulation key available from the party that published its keys (Bob).
+
+### Initialization
+
+The double ratchet initialization is defined in pseudo-code. This pseudo-code is identical to Signal algorithm specification except for that parts that add post-quantum key agreement.
+
+```
+// Alice obtained Bob's keys and initializes ratchet first
+def RatchetInitAlicePQ2HE(state, SK, bob_dh_public_key, shared_hka, shared_nhkb, bob_pq_kem_encapsulation_key):
+    state.DHRs = GENERATE_DH()
+    state.DHRr = bob_dh_public_key
+    // below added for post-quantum KEM
+    state.PQRs = GENERATE_PQKEM()
+    state.PQRr = bob_pq_kem_encapsulation_key
+    state.PQRss = random // shared secret for KEM
+    state.PQRct = PQKEM-ENC(state.PQRr, state.PQRss) // encapsulated additional shared secret
+    // above added for KEM
+    // the next line augments DH key agreement with PQ shared secret
+    state.RK, state.CKs, state.NHKs = KDF_RK_HE(SK, DH(state.DHRs, state.DHRr) || state.PQRss) 
+    state.CKr = None
+    state.Ns = 0
+    state.Nr = 0
+    state.PN = 0
+    state.MKSKIPPED = {}
+    state.HKs = shared_hka
+    state.HKr = None
+    state.NHKr = shared_nhkb
+
+// Bob initializes ratchet second, having received Alice's connection request
+def RatchetInitBobPQ2HE(state, SK, bob_dh_key_pair, shared_hka, shared_nhkb, bob_pq_kem_key_pair):
+    state.DHRs = bob_dh_key_pair
+    state.DHRr = None
+    // below added for KEM
+    state.PQRs = bob_pq_kem_key_pair
+    state.PQRr = None
+    state.PQRss = None
+    state.PQRct = None
+    // above added for KEM
+    state.RK = SK 
+    state.CKs = None
+    state.CKr = None
+    state.Ns = 0
+    state.Nr = 0
+    state.PN = 0
+    state.MKSKIPPED = {}
+    state.HKs = None
+    state.NHKs = shared_nhkb
+    state.HKr = None
+    state.NHKr = shared_hka
+```
+
+`GENERATE_PQKEM` generates decapsulation/encapsulation key pair.
+
+`PQKEM-ENC` is key encapsulation algorithm.
+
+Other than commented lines, the above adds parameters `bob_pq_kem_encapsulation_key` and `bob_pq_kem_key_pair` to the ratchet initialization. Otherwise it is identical to the original double ratchet initialization.
+
+### Encrypting messages
+
+```
+def RatchetEncryptPQ2HE(state, plaintext, AD):
+    state.CKs, mk = KDF_CK(state.CKs)
+    // encapsulation key from PQRs and encapsulated shared secret is added to header
+    header = HEADER_PQ2(
+      dh = state.DHRs.public,
+      kem = state.PQRs.public, // added for KEM #2
+      ct = state.PQRct // added for KEM #1
+      pn = state.PN,
+      n = state.Ns,
+    )
+    enc_header = HENCRYPT(state.HKs, header)
+    state.Ns += 1
+    return enc_header, ENCRYPT(mk, plaintext, CONCAT(AD, enc_header))
+```
+
+Other than adding encapsulation key and encapsulated shared secret into the header, the above is identical to the original double ratchet message encryption step.
+
+### Decrypting messages
+
+```
+def RatchetDecryptPQ2HE(state, enc_header, ciphertext, AD):
+    plaintext = TrySkippedMessageKeysHE(state, enc_header, ciphertext, AD)
+    if plaintext != None:
+        return plaintext
+    header, dh_ratchet = DecryptHeader(state, enc_header) // DecryptHeader is the same as in double ratchet specification
+    if dh_ratchet:
+        SkipMessageKeysHE(state, header.pn) // SkipMessageKeysHE is the same as in double ratchet specification
+        DHRatchetPQ2HE(state, header)
+    SkipMessageKeysHE(state, header.n)
+    state.CKr, mk = KDF_CK(state.CKr)
+    state.Nr += 1
+    return DECRYPT(mk, ciphertext, CONCAT(AD, enc_header))
+
+// DecryptHeader is the same as in double ratchet specification
+def DecryptHeader(state, enc_header):
+    header = HDECRYPT(state.HKr, enc_header)
+    if header != None:
+        return header, False
+    header = HDECRYPT(state.NHKr, enc_header)
+    if header != None:
+        return header, True
+    raise Error()
+
+def DHRatchetPQ2HE(state, header):
+    state.PN = state.Ns
+    state.Ns = 0
+    state.Nr = 0
+    state.HKs = state.NHKs
+    state.HKr = state.NHKr
+    state.DHRr = header.dh
+    // save new encapsulation key from header
+    state.PQRr = header.kem
+    // decapsulate shared secret from header - KEM #2
+    ss = PQKEM-DEC(state.PQRs.private, header.ct)
+    // use decapsulated shared secret with receiving ratchet
+    state.RK, state.CKr, state.NHKr = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr) || ss)
+    state.DHRs = GENERATE_DH()
+    // below is added for KEM
+    state.PQRs = GENERATE_PQKEM() // generate new PQ key pair
+    state.PQRss = random // shared secret for KEM
+    state.PQRct = PQKEM-ENC(state.PQRr, state.PQRss) // encapsulated additional shared secret KEM #1
+    // above is added for KEM
+    // use new shared secret with sending ratchet
+    state.RK, state.CKs, state.NHKs = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr) || state.PQRss)
+```
+
+`PQKEM-DEC` is key decapsulation algorithm.
+
+`DHRatchetPQ2HE` augments both DH agreements with decapsulated shared secret from the received header and with the new shared secret, respectively. The new shared secret together with the new encapsulation key are saved in the state and will be added to the header in the next sent message.
+
+Other than augmenting DH key agreements with the shared secrets from KEM, the above is identical to the original double ratchet DH ratchet step.
+
+It is worth noting that while DH agreements work as ping-pong, when the new received DH key is used for both DH agreements (and only the sent DH key is updated for the second DH key agreement), PQ KEM agreements in the proposed scheme work as a "parallel ping-pong", with two balls in play all the time (two KEM agreements run in parallel).
+
+## Implementation considerations for SimpleX Messaging Protocol
+
+As SimpleX Messaging Protocol pads messages to a fixed size, using 16kb transport blocks, the size increase introduced by this scheme can be compensated for by using ZSTD encryption of JSON bodies and image previews encoded as base64. While there may be some rare cases of random texts that would fail to compress, in all real scenarios it would not cause the message size reduction.
+
+Sharing the initial keys in case of SimpleX Chat it is equivalent to sharing the invitation link. As encapsulation key is large, it may be inconvenient to share it in the link in some contexts, e.g. when QR codes are used.
+
+It is possible to postpone sharing the encapsulation key until the first message from Alice (confirmation message in SMP protocol), the party sending connection request. The upside here is that the invitation link size would not increase. The downside is that the user profile shared in this confirmation will not be encrypted with PQ-resistant algorithm.
+
+Another consideration is pairwise ratchets in groups. Key generation in sntrup761 is quite slow - on slow devices it can be as slow as 10-20 keys per second, so using this primitive in groups larger than 10-20 members would result in slow performance.
+
+For backward compatibility the implementation must support adding PQ-resistant key agreement to the existing connections.
+
+It is also beneficial to support removing PQ-resistant key agreement from the connections that have them, e.g. as the group size grows.
+
+### Chosen KEM algorithm
+
+The implementation uses Streamlined NTRU-Prime 761 (sntrup761) that was also used for OpenSSH for a long time.
+
+It was chosen over ML-KEM (Kyber) standardized by NIST for several reasons:
+
+- sntrup761 was used in OpenSSH for a long period of time.
+- ML-KEM standardization process raised [concerns](https://groups.google.com/a/list.nist.gov/g/pqc-forum/c/WFRDl8DqYQ4) [amongst](https://blog.cr.yp.to/20231003-countcorrectly.html) the experts.
+- ML-KEM (if modified) is likely to have conflicts with the existing patents, unlike sntrup761.
+
+It was chosen over non-interactive CTIDH due to its slower implementation, and lack of optimized code for aarch64 CPUs used in mobile devices.
+
+## Summary
+
+If chosen PQ KEM proves secure against quantum computer attacks, then the proposed augmented double ratchet will also be secure against quantum computer attack, including break-in recovery property, while keeping deniability and forward secrecy, because the [same proof](https://eprint.iacr.org/2016/1013.pdf) as for double ratchet algorithm would hold here, provided chosen KEM is secure.
diff --git a/protocol/push-notifications.md b/protocol/push-notifications.md
new file mode 100644
index 000000000..6d5e1dea0
--- /dev/null
+++ b/protocol/push-notifications.md
@@ -0,0 +1,398 @@
+Version 2, 2024-06-22
+
+# Overview of push notifications for SimpleX Messaging Servers
+
+## Table of contents
+
+- [Introduction](#introduction)
+- [Participating servers](#participating-servers)
+- [Register device token to receive push notifications](#register-device-token-to-receive-push-notifications)
+- [Subscribe to connection notifications](#subscribe-to-connection-notifications)
+- [SimpleX Notification Server protocol](#simplex-notification-server-protocol)
+  - [Register new notification token](#register-new-notification-token)
+  - [Verify notification token](#verify-notification-token)
+  - [Check notification token status](#check-notification-token-status)
+  - [Replace notification token](#replace-notification-token)
+  - [Delete notification token](#delete-notification-token)
+  - [Subscribe to periodic notifications](#subscribe-to-periodic-notifications)
+  - [Create SMP message notification subscription](#create-smp-message-notification-subscription)
+  - [Check notification subscription status](#check-notification-subscription-status)
+  - [Delete notification subscription](#delete-notification-subscription)
+  - [Error responses](#error-responses)
+- [Threat model](#threat-model)
+
+## Introduction
+
+SimpleX Messaging servers already operate as push servers and deliver the messages to subscribed clients as soon as they are sent to the servers.
+
+The reason for push notifications is to support instant message notifications on iOS that does not allow background services.
+
+## Participating servers
+
+The diagram below shows which servers participate in message notification delivery.
+
+While push provider (e.g., APN) can learn how many notifications are delivered to the user, it cannot access message content, even encrypted, or any message metadata - the notifications are e2e encrypted between SimpleX Notification Server and the user's device.
+
+```
+  User's iOS device                Internet                           Servers
+---------------------   .   ------------------------   .   -----------------------------
+                        .                              .
+                        .                              .       can be self-hosted now
++--------------+        .                              .         +----------------+
+| SimpleX Chat |       -------------- TLS ---------------        | SimpleX        |
+|    client    |------> SimpleX Messaging Protocol (SMP) ------> | Messaging      |
++--------------+       ----------------------------------        | Server         |
+     ^    |             .                              .         +----------------+
+     |    |             .                              .          . . .  |   . . .
+     |    |             .                              .               | V |
+     |    |             .                              .               |SMP| TLS
+     |    |             .                              .               | | |               SimpleX
+     |    |             .                              .          . . .  V   . . .      NTF Server
+     |    |             .                              .       +----------------------------------+
+     |    |             .                              .       | +---------------+                |
+     |    |            -------------- TLS ---------------      | | SimpleX       | can be         | 
+     |    |----------->   Notification Server Protocol  -----> | | Notifications | self-hosted    |
+     |                 ----------------------------------      | | Subscriber    | in the future  |
+     |                  .                              .       | +---------------+                |
+     |                  .                              .       |         |                        |
+     |                  .                              .       |         V                        |
+     |                  .                              .       | +---------------+                |
+     |                  .                              .       | | SimpleX       |                |
+     |                  .                              .       | | Push          |                |
+     |                  .                              .       | | Server        |                |
+     |                  .                              .       | +---------------+                |
+     |                  .                              .       +----------------------------------+
+     |                  .                              .          . . .  |   . . .
+     |                  .                              .               | V |
+     |                  .                              .               |SMP| TLS
+     |                  .                              .               | | |
+     |                  .                              .          . . .  V   . . .
+     |                 -------------- TLS ---------------       +-----------------+
+     |-----------------       Notification delivery     <-------| Apple PN server |
+                       ----------------------------------       +-----------------+
+                        .                              .
+```
+
+## Register device token to receive push notifications
+
+This diagram shows the process of registering a device to receive PUSH notifications via Apple Push Notification (APN) servers.
+
+![Register device notification token](./diagrams/notifications/register-token.svg)
+
+## Subscribe to connection notifications
+
+This diagram shows the process of subscription to notifications, notification delivery and device token update.
+
+![Subscribe to notifications](./diagrams/notifications/subscription.svg)
+
+## SimpleX Notification Server protocol
+
+To manage notification subscriptions to SMP servers, SimpleX Notification Server provides an RPC protocol with a similar design to SimpleX Messaging Protocol server.
+
+This protocol sends requests and responses in a fixed size blocks of 512 bytes over TLS, uses the same [syntax of protocol transmissions](./simplex-messaging.md#smp-transmission-and-transport-block-structure) as SMP protocol, and has the same transport [handshake syntax](./simplex-messaging.md#transport-handshake) (except the server certificate is not included in the handshake).
+
+Protocol commands have this syntax:
+
+```
+ntfServerTransmission = 
+ntfServerCmd = newTokenCmd / verifyTokenCmd / checkTokenCmd /
+               replaceTokenCmd / deleteTokenCmd / cronCmd /
+               newSubCmd / checkSubCmd / deleteSubCmd
+```
+### Register new notification token
+
+This command should be used after the client app obtains a token from push notifications provider to register the token with the server.
+
+Having received this command the server will deliver a test notification via the push provider to validate that the client has this token.
+
+The command syntax:
+
+```abnf
+newTokenCmd = %s"TNEW" SP newToken
+newToken = %s"T" deviceToken authPubKey clientDhPubKey
+deviceToken = pushProvider tokenString
+pushProvider = apnsDev / apnsProd / apnsNull
+apnsDev = "AD" ; APNS token for development environment
+apnsProd = "AP" ; APNS token for production environment
+apnsNull = "AN" ; token that does not trigger any notification delivery - used for server testing
+tokenString = shortString
+authPubKey = length x509encoded ; Ed25519 key used to verify clients commands
+clientDhPubKey = length x509encoded ; X25519 key to agree e2e encryption between the server and client
+shortString = length *OCTET
+length = 1*1 OCTET
+```
+
+The server response syntax:
+
+```abnf
+tokenIdResp = %s"IDTKN" SP entityId serverDhPubKey
+entityId = shortString
+serverDhPubKey = length x509encoded ; X25519 key to agree e2e encryption between the server and client
+```
+
+### Verify notification token
+
+This command is used to verify the token after the device receives the test notification from the push provider.
+
+The command syntax:
+
+```abnf
+verifyTokenCmd = %s"TVFY" SP regCode
+regCode = shortString
+```
+
+The response to this command is `okResp` or `errorResp`
+
+```abnf
+okResp = %s"OK"
+```
+
+### Check notification token status
+
+This command is used to check the token status:
+
+```abnf
+checkTokenCmd = %s"TCHK"
+```
+
+The response to this command:
+
+```abnf
+tokenStatusResp = %s"TKN" SP tokenStatus
+tokenStatus = %s"NEW" / %s"REGISTERED" / %s"INVALID" / %s"CONFIRMED" / %s"ACTIVE" / %s"EXPIRED"
+```
+
+### Replace notification token
+
+This command should be used when push provider issues a new notification token.
+
+It happens when:
+- the app data is migrated to another device.
+- the app is re-installed on the same device.
+- can happen periodically, at push provider discretion.
+
+This command allows to replace the token without re-registering and re-subscribing all notification subscriptions.
+
+Using this command triggers the same verification flow as registering a new token.
+
+The command syntax:
+
+```abnf
+replaceTokenCmd = %s"TRPL" SP deviceToken
+```
+
+The response to this command is `okResp` or `errorResp`.
+
+### Delete notification token
+
+The command syntax:
+
+```abnf
+deleteTokenCmd = %s"TDEL"
+```
+
+The response to this command is `okResp` or `errorResp`.
+
+After this command all message notification subscriptions will be removed and no more notifications will be sent.
+
+### Subscribe to periodic notifications
+
+This command enables or disables periodic notifications sent to the client device irrespective of message notifications.
+
+This is useful for two reasons:
+- it provides better privacy from notification server, as while the server learns the device token, it doesn't learn anything else about user communications.
+- it allows to receive messages when notifications were dropped by push provider, e.g. while the device was offline, or lost by notification server, e.g. while it was restarting.
+
+The command syntax:
+
+```abnf
+cronCmd = %s"TCRN" SP interval
+interval = 2*2 OCTET ; Word16, minutes
+```
+
+The interval for periodic notifications is set in minutes, with the minimum of 20 minutes. The client should pass `0` to disable periodic notifications.
+
+### Create SMP message notification subscription
+
+This command makes notification server subscribe to message notifications from SMP server and to deliver them to push provider:
+
+```abnf
+newSubCmd = %s"SNEW" newSub
+newSub = %s "S" tokenId smpServer notifierId notifierKey
+tokenId = shortString ; returned in response to `TNEW` command
+smpServer = smpServer = hosts port fingerprint
+hosts = length 1*host
+host = shortString
+port = shortString
+fingerprint = shortString
+notifierId = shortString ; returned by SMP server in response to `NKEY` SMP command
+notifierKey = length x509encoded ; private key used to authorize requests to subscribe to message notifications
+```
+
+The response syntax:
+
+```abnf
+subIdResp = %s"IDSUB" SP entityId
+```
+
+### Check notification subscription status
+
+This command syntax:
+
+```abnf
+checkSubCmd = %s"SCHK"
+```
+
+The response:
+
+```abnf
+subStatusResp = %s"SUB" SP subStatus
+subStatus = %s"NEW" / %s"PENDING" / ; e.g., after SMP server disconnect/timeout while ntf server is retrying to connect
+            %s"ACTIVE" / %s"INACTIVE" / %s"END" / ; if another server subscribed to notifications
+            %s"AUTH" / subErrStatus
+subErrStatus = %s"ERR" SP shortString
+```
+
+### Delete notification subscription
+
+The command syntax:
+
+```abnf
+deleteSubCmd = %s"SDEL"
+```
+
+The response to this command is `okResp` or `errorResp`.
+
+After this command no more message notifications will be sent from this queue.
+
+### Error responses
+
+All commands can return error response:
+
+```abnf
+errorResp = %s"ERR" SP errorType
+```
+
+Where `errorType` has the same syntax as in [SimpleX Messaging Protocol](./simplex-messaging.md#error-responses)
+
+## Threat Model
+
+This threat model compliments SimpleX Messaging Protocol [threat model](./overview-tjr.md#threat-model)
+
+#### A passive adversary able to monitor the traffic of one user
+
+*can:*
+
+ - identify that and a user is using SimpleX push notifications.
+
+*cannot:*
+
+ - determine which servers a user subscribed to the notifications from.
+
+#### A passive adversary able to monitor a set of senders and recipients
+
+ *can:*
+
+ - perform more efficient traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers.
+
+#### SimpleX Messaging Protocol server
+
+*can:*
+
+- learn which messages trigger push notifications.
+
+- learn IP address of SimpleX notification servers used by the user.
+
+- drop message notifications.
+
+- spam a user with invalid notifications.
+
+*cannot:*
+
+- learn user device token for push notifications.
+
+- learn which queues belong to the same users with any additional efficiency compared with not using push notifications.
+
+#### SimpleX Notification Server subscribed to message notifications
+
+*can:*
+
+- learn a user device token.
+
+- learn how many messaging queues and servers a user receives messages from.
+
+- learn how many message notifications are delivered to the user from each queue.
+
+- undetectably drop notifications.
+
+- spam a user with background notifications.
+
+*cannot:*
+
+- learn queue addresses for receiving or sending messages.
+
+- learn the contents or type of messages (not even encrypted).
+
+- learn anything about messages sent without notification flag.
+
+- spam a user with visible notifications (provided the client app can filter push notifications).
+
+- add, duplicate, or corrupt individual messages that will be shown to the user.
+
+#### SimpleX Notification Server subscribed ONLY to periodic notifications
+
+*can:*
+
+- learn a user device token.
+
+- drop periodic notifications.
+
+- spam a user with background notifications.
+
+*cannot:*
+
+- learn how many messaging queues and servers a user receives messages from.
+
+- learn how many message notifications are delivered to the user from each queue.
+
+- learn queue addresses for receiving or sending messages.
+
+- learn the contents or type of messages (not even encrypted).
+
+- learn anything about messages sent without notification flag.
+
+- spam a user with visible notifications (provided the client app can filter push notifications).
+
+- add, duplicate, or corrupt individual messages that will be shown to the user.
+
+#### A user’s contact
+
+*cannot:*
+
+- determine if a user uses push notifications or not.
+
+#### Push notification provider (e.g., APN)
+
+*can:*
+
+- learn that a user uses SimpleX app.
+
+- learn how many notifications are delivered to user's device.
+
+- drop notifications (in fact, APN coalesces notifications delivered while user's device is offline, delivering only the last one).
+
+*cannot:*
+
+- learn which SimpleX Messaging Protocol servers are used by a user (notifications are e2e encrypted).
+
+- learn which or how many messaging queues a user receives notifications from.
+
+- learn the contents or type of messages (not even encrypted, notifications only contain encrypted metadata).
+
+#### An attacker with Internet access
+
+*cannot:*
+
+- register notification token not present on attacker's device.
+
+- enumerate tokens or subscriptions on a SimpleX Notification Server.
diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md
index 48843cab3..16e4e6606 100644
--- a/protocol/simplex-messaging.md
+++ b/protocol/simplex-messaging.md
@@ -1,3 +1,5 @@
+Version 9, 2024-06-22
+
 # Simplex Messaging Protocol (SMP)
 
 ## Table of contents
@@ -9,39 +11,51 @@
 - [Simplex queue](#simplex-queue)
 - [SMP queue URI](#smp-queue-uri)
 - [SMP procedure](#smp-procedure)
+- [Fast SMP procedure](#fast-smp-procedure)
 - [SMP qualities and features](#smp-qualities-and-features)
 - [Cryptographic algorithms](#cryptographic-algorithms)
+- [Deniable client authentication scheme](#deniable-client-authentication-scheme)
 - [Simplex queue IDs](#simplex-queue-ids)
 - [Server security requirements](#server-security-requirements)
 - [Message delivery notifications](#message-delivery-notifications)
-- [SMP Transmission structure](#smp-transmission-structure)
+- [SMP Transmission and transport block structure](#smp-transmission-and-transport-block-structure)
 - [SMP commands](#smp-commands)
   - [Correlating responses with commands](#correlating-responses-with-commands)
-  - [Command authentication](#command-authentication)
+  - [Command verification](#command-verification)
   - [Keep-alive command](#keep-alive-command)
   - [Recipient commands](#recipient-commands)
     - [Create queue command](#create-queue-command)
     - [Subscribe to queue](#subscribe-to-queue)
-    - [Secure queue command](#secure-queue-command)
+    - [Secure queue by recipient](#secure-queue-by-recipient)
     - [Enable notifications command](#enable-notifications-command)
     - [Disable notifications command](#disable-notifications-command)
+    - [Get message command](#get-message-command)
     - [Acknowledge message delivery](#acknowledge-message-delivery)
     - [Suspend queue](#suspend-queue)
     - [Delete queue](#delete-queue)
+    - [Get queue state](#get-queue-state)
   - [Sender commands](#sender-commands)
+    - [Secure queue by sender](#secure-queue-by-sender)
     - [Send message](#send-message)
+  - [Proxying sender commands](#proxying-sender-commands)
+    - [Request proxied session](#request-proxied-session)
+    - [Send command via proxy](#send-command-via-proxy)
+    - [Forward command to destination server](#forward-command-to-destination-server)
   - [Notifier commands](#notifier-commands)
     - [Subscribe to queue notifications](#subscribe-to-queue-notifications)
   - [Server messages](#server-messages)
-    - [Queue IDs response](#queue-ids-response)
     - [Deliver queue message](#deliver-queue-message)
-    - [Notifier queue ID response](#notifier-queue-id-response)
     - [Deliver message notification](#deliver-message-notification)
     - [Subscription END notification](#subscription-end-notification)
     - [Error responses](#error-responses)
     - [OK response](#ok-response)
-- [Appendices](#appendices)
-  - [Appendix A. Transport connection with the SMP server](#appendix-a)
+- [Transport connection with the SMP server](#transport-connection-with-the-SMP-server)
+  - [General transport protocol considerations](#general-transport-protocol-considerations)
+  - [TLS transport encryption](#tls-transport-encryption)
+  - [Server certificate](#server-certificate)
+  - [ALPN to agree handshake version](#alpn-to-agree-handshake-version)
+  - [Transport handshake](#transport-handshake)
+  - [Additional transport privacy](#additional-transport-privacy)
 
 ## Abstract
 
@@ -51,11 +65,11 @@ It's designed with the focus on communication security and integrity, under the
 
 It is designed as a low level protocol for other application protocols to solve the problem of secure and private message transmission, making [MITM attack][1] very difficult at any part of the message transmission system.
 
-This document describes SMP protocol versions 3 and 4, the previous versions are discontinued.
+This document describes SMP protocol versions 6 and 7, the previous versions are discontinued.
 
 ## Introduction
 
-The objective of Simplex Messaging Protocol (SMP) is to facilitate the secure and private unidirectional transfer of messages from senders to recipients via persistent simplex queues managed by the message broker (server).
+The objective of Simplex Messaging Protocol (SMP) is to facilitate the secure and private unidirectional transfer of messages from senders to recipients via persistent simplex queues managed by the message brokers (servers).
 
 SMP is independent of any particular transmission system and requires only a reliable ordered data stream channel. While this document describes transport over TCP, other transports are also possible.
 
@@ -67,7 +81,7 @@ The protocol is designed with the focus on privacy and security, to some extent
 
 SMP does not use any form of participants' identities and provides [E2EE][2] without the possibility of [MITM attack][1] relying on two pre-requisites:
 
-- the users can establish a secure encrypted transport connection with the SMP server. [Appendix A](#appendix-a) describes SMP transport protocol of such connection over TCP, but any other transport connection protocol can be used.
+- the users can establish a secure encrypted transport connection with the SMP server. [Transport connection](#transport-connection-with-the-smp-server) section describes SMP transport protocol of such connection over TCP, but any other transport connection protocol can be used.
 
 - the recipient can pass a single message to the sender via a pre-existing secure and private communication channel (out-of-band message) - the information in this message is used to encrypt messages and to establish connection with SMP server.
 
@@ -77,13 +91,13 @@ The SMP model has three communication participants: the recipient, the message b
 
 SMP server manages multiple "simplex queues" - data records on the server that identify communication channels from the senders to the recipients. The same communicating party that is the sender in one queue, can be the recipient in another - without exposing this fact to the server.
 
-The queue record consists of 2 unique random IDs generated by the server, one for the recipient and another for the sender, and 2 keys to authenticate the recipient and the sender respectively, provided by the client. The users of SMP protocol must use a unique key for each queue, to avoid the possibility of aggregating and analyzing their queues in case SMP server is compromised.
+The queue record consists of 2 unique random IDs generated by the server, one for the recipient and another for the sender, and 2 keys to verify the recipient's and the sender's commands, provided by the clients. The users of SMP protocol must use a unique ephemeral keys for each queue, to prevent aggregating their queues by keys in case SMP server is compromised.
 
 Creating and using the queue requires sending commands to the SMP server from the recipient and the sender - they are described in detail in [SMP commands](#smp-commands) section.
 
 ## Out-of-band messages
 
-The out-of-band message with the queue information is sent via some trusted alternative channel from the recipient to the sender. This message is used to share one or several [queue URIs](#smp-queue-uri) that parties can use to establish the initial connection, the encryption scheme and, it can include the public key(s) for end-to-end encryption.
+The out-of-band message with the queue information is sent via some trusted alternative channel from the recipient to the sender. This message is used to share one or several [queue URIs](#smp-queue-uri) that parties can use to establish the initial connection, the encryption scheme, including the public key(s) for end-to-end encryption.
 
 The approach to out-of-band message passing and their syntax should be defined in application-level protocols.
 
@@ -91,9 +105,9 @@ The approach to out-of-band message passing and their syntax should be defined i
 
 The simplex queue is the main unit of SMP protocol. It is used by:
 
-- Sender of the queue (who received out-of-band message) to send messages to the server using sender's queue ID, signed by sender's key.
+- Sender of the queue (who received out-of-band message) to send messages to the server using sender's queue ID, authorized by sender's key.
 
-- Recipient of the queue (who created the queue and sent out-of-band message) will use it to retrieve messages from the server, signing the commands by the recipient key. Recipient decrypts the messages with the key negotiated during the creation of the queue.
+- Recipient of the queue (who created the queue and sent out-of-band message) will use it to retrieve messages from the server, authorizing the commands by the recipient key. Recipient decrypts the messages with the key negotiated during the creation of the queue.
 
 - Participant identities are not shared with the server - new unique keys and queue IDs are used for each queue.
 
@@ -101,7 +115,7 @@ This simplex queue can serve as a building block for more complex communication
 
 This approach is based on the concept of [unidirectional networks][4] that are used for applications with high level of information security.
 
-Access to each queue is controlled with unique (not shared with other queues) asymmetric key pairs, separate for the sender and the recipient. The sender and the receiver have private keys, and the server has associated public keys to authenticate participants' commands by verifying cryptographic signatures.
+Access to each queue is controlled with unique (not shared with other queues) asymmetric key pairs, separate for the sender and the recipient. The sender and the receiver have private keys, and the server has associated public keys to authenticate participants' commands by verifying cryptographic authorizations.
 
 The messages sent over the queue are end-to-end encrypted using the DH secret agreed via out-of-band message and SMP confirmation.
 
@@ -115,17 +129,21 @@ The protocol uses different IDs for sender and recipient in order to provide an
 
 ## SMP queue URI
 
-The SMP queue URIs MUST include server identity, queue hostname, an optional port, sender queue ID and the public key that the clients must use to verify responses. Server identity is used to establish secure connection protected from MITM attack with SMP server (see [Appendix A](#appendix-a) for SMP transport protocol).
+The SMP queue URIs MUST include server identity, queue hostname, an optional port, sender queue ID, and the recipient's public key to agree shared secret for e2e encryption, and an optional query string parameter `k=s` to indicate that the queue can be secured by the sender using `SKEY` command (see [Fast SMP procedure](#fast-smp-procedure) and [Secure queue by sender](#secure-queue-by-sender)). Server identity is used to establish secure connection protected from MITM attack with SMP server (see [Transport connection](#transport-connection-with-the-smp-server) for SMP transport protocol).
 
 The [ABNF][8] syntax of the queue URI is:
 
 ```abnf
-queueURI = %s"smp://" smpServer "/" queueId "#" recipientDhPublicKey
-smpServer = serverIdentity "@" srvHost [":" port]
-srvHost = <hostname> ; RFC1123, RFC5891
+queueURI = %s"smp://" smpServer "/" queueId "#/?" versionParam keyParam [sndSecureParam]
+smpServer = serverIdentity "@" srvHosts [":" port]
+srvHosts = <hostname> ["," srvHosts] ; RFC1123, RFC5891
 port = 1*DIGIT
 serverIdentity = base64url
 queueId = base64url
+versionParam = %s"v=" versionRange
+versionRange = 1*DIGIT / 1*DIGIT "-" 1*DIGIT
+keyParam = %s"&dh=" recipientDhPublicKey
+sndSecureParam = %s"&k=s"
 base64url = <base64url encoded binary> ; RFC4648, section 5
 recipientDhPublicKey = x509UrlEncoded
 ; the recipient's Curve25519 key for DH exchange to derive the secret
@@ -139,7 +157,7 @@ x509UrlEncoded = <base64url X509 key encoding>
 
 `port` is optional, the default TCP port for SMP protocol is 5223.
 
-`serverIdentity` is a required hash of the server certificate SPKI block (without line breaks, header and footer) used by the client to validate server certificate during transport handshake (see [Appendix A](#appendix-a))
+`serverIdentity` is a required hash of the server certificate SPKI block (without line breaks, header and footer) used by the client to validate server certificate during transport handshake (see [Transport connection](#transport-connection-with-the-smp-server))
 
 ## SMP procedure
 
@@ -149,17 +167,17 @@ To create and start using a simplex queue Alice and Bob follow these steps:
 
 1. Alice creates a simplex queue on the server:
 
-   1. Decides which SMP server to use (can be the same or different server that Alice uses for other queues) and opens secure encrypted transport connection to the chosen SMP server (see [Appendix A](#appendix-a)).
+   1. Decides which SMP server to use (can be the same or different server that Alice uses for other queues) and opens secure encrypted transport connection to the chosen SMP server (see [Transport connection](#transport-connection-with-the-smp-server)).
 
-   2. Generates a new random public/private key pair (encryption key - `EK`) that she did not use before for Bob to encrypt the messages.
+   2. Generates a new random public/private key pair (encryption key - `EK`) that she did not use before to agree a shared secret with Bob to encrypt the messages.
 
-   3. Generates another new random public/private key pair (recipient key - `RK`) that she did not use before for her to sign commands and to decrypt the transmissions received from the server.
+   3. Generates another new random public/private key pair (recipient key - `RK`) that she did not use before for her to authorize commands to the server.
 
    4. Generates one more random key pair (recipient DH key - `RDHK`) to negotiate symmetric key that will be used by the server to encrypt message bodies delivered to Alice (to avoid shared cipher-text inside transport connection).
 
-   5. Sends `"NEW"` command to the server to create a simplex queue (see `create` in [Create queue command](#create-queue-command)). This command contains previously generated unique "public" keys `RK` and `RDHK`. `RK` will be used to verify the following commands related to the same queue signed by its private counterpart, for example to subscribe to the messages received to this queue or to update the queue, e.g. by setting the key required to send the messages (initially Alice creates the queue that accepts unsigned messages, so anybody could send the message via this queue if they knew the queue sender's ID and server address).
+   5. Sends `"NEW"` command to the server to create a simplex queue (see `create` in [Create queue command](#create-queue-command)). This command contains previously generated unique "public" keys `RK` and `RDHK`. `RK` will be used by the server to verify the subsequent commands related to the same queue authorized by its private counterpart, for example to subscribe to the messages received to this queue or to update the queue, e.g. by setting the key required to send the messages (initially Alice creates the queue that accepts unauthorized messages, so anybody could send the message via this queue if they knew the queue sender's ID and server address).
 
-   6. The server sends `"IDS"` response with queue IDs (`queueIds`):
+   6. The server sends `IDS` response with queue IDs (`queueIds`):
 
       - Recipient ID `RID` for Alice to manage the queue and to receive the messages.
 
@@ -167,27 +185,29 @@ To create and start using a simplex queue Alice and Bob follow these steps:
 
       - Server public DH key (`SDHK`) to negotiate a shared secret for message body encryption, that Alice uses to derive a shared secret with the server `SS`.
 
-2. Alice sends an out-of-band message to Bob via the alternative channel that both Alice and Bob trust (see [protocol abstract](#simplex-messaging-protocol-abstract)). The message must include:
+2. Alice sends an out-of-band message to Bob via the alternative channel that both Alice and Bob trust (see [protocol abstract](#simplex-messaging-protocol-abstract)). The message must include [SMP queue URI](#smp-queue-uri) with:
 
-   - Unique "public" key (`EK`) that Bob must use for E2E key agreement.
+   - Unique "public" key (`EK`) that Bob must use to agree a shared secret for E2E encryption.
 
-   - SMP server hostname and information to open secure encrypted transport connection (see [Appendix A](#appendix-a)).
+   - SMP server hostname and information to open secure encrypted transport connection (see [Transport connection](#transport-connection-with-the-smp-server)).
 
    - Sender queue ID `SID` for Bob to use.
 
 3. Bob, having received the out-of-band message from Alice, connects to the queue:
 
-   1. Generates a new random public/private key pair (sender key - `SK`) that he did not use before for him to sign messages sent to Alice's server.
+   1. Generates a new random public/private key pair (sender key - `SK`) that he did not use before for him to authorize messages sent to Alice's server and another key pair for e2e encryption agreement.
 
    2. Prepares the confirmation message for Alice to secure the queue. This message includes:
 
-      - Previously generated "public" key `SK` that will be used by Alice's server to authenticate Bob's messages, once the queue is secured.
+      - Previously generated "public" key `SK` that will be used by Alice's server to verify Bob's messages, once the queue is secured.
+
+      - Public key to agree a shared secret with Alice for e2e encryption.
 
       - Optionally, any additional information (application specific, e.g. Bob's profile name and details).
 
-   3. Encrypts the confirmation body with the "public" key `EK` (that Alice provided via the out-of-band message).
+   3. Encrypts the confirmation body with the shared secret agreed using public key `EK` (that Alice provided via the out-of-band message).
 
-   4. Sends the encrypted message to the server with queue ID `SID` (see `send` in [Send message](#send-message)). This initial message to the queue must not be signed - signed messages will be rejected until Alice secures the queue (below).
+   4. Sends the encrypted message to the server with queue ID `SID` (see `send` in [Send message](#send-message)). This initial message to the queue must not be authorized - authorized messages will be rejected until Alice secures the queue (below).
 
 4. Alice receives Bob's message from the server using recipient queue ID `RID` (possibly, via the same transport connection she already has opened - see `message` in [Deliver queue message](#deliver-queue-message)):
 
@@ -195,13 +215,13 @@ To create and start using a simplex queue Alice and Bob follow these steps:
 
    2. She decrypts received message with [key agreed with sender using] "private" key `EK`.
 
-   3. Even though anybody could have sent the message to the queue with ID `SID` before it is secured (e.g. if communication is compromised), Alice would ignore all messages until the decryption succeeds (i.e. the result contains the expected message format). Optionally, in the client application, she also may identify Bob using the information provided, but it is out of scope of SMP protocol.
+   3. Anybody can send the message to the queue with ID `SID` before it is secured (e.g. if communication is compromised), so it's a "race" to secure the queue. Optionally, in the client application, Alice may identify Bob using the information provided, but it is out of scope of SMP protocol.
 
 5. Alice secures the queue `RID` with `"KEY"` command so only Bob can send messages to it (see [Secure queue command](#secure-queue-command)):
 
-   1. She sends the `KEY` command with `RID` signed with "private" key `RK` to update the queue to only accept requests signed by "private" key `SK` provided by Bob. This command contains unique "public" key `SK` previously generated by Bob.
+   1. She sends the `KEY` command with `RID` signed with "private" key `RK` to update the queue to only accept requests authorized by "private" key `SK` provided by Bob. This command contains unique "public" key `SK` previously generated by Bob.
 
-   2. From this moment the server will accept only signed commands to `SID`, so only Bob will be able to send messages to the queue `SID` (corresponding to `RID` that Alice has).
+   2. From this moment the server will accept only authorized commands to `SID`, so only Bob will be able to send messages to the queue `SID` (corresponding to `RID` that Alice has).
 
    3. Once queue is secured, Alice deletes `SID` and `SK` - even if Alice's client is compromised in the future, the attacker would not be able to send messages pretending to be Bob.
 
@@ -217,19 +237,19 @@ Bob now can securely send messages to Alice:
 
 1. Bob sends the message:
 
-   1. He encrypts the message to Alice with "public" key `EK` (provided by Alice, only known to Bob, used only for one simplex queue).
+   1. He encrypts the message to Alice with the agreed shared secret (using "public" key `EK` provided by Alice, only known to Bob, used only for one simplex queue).
 
-   2. He signs `"SEND"` command to the server queue `SID` using the "private" key `SK` (that only he knows, used only for this queue).
+   2. He authorizes `"SEND"` command to the server queue `SID` using the "private" key `SK` (that only he knows, used only for this queue).
 
-   3. He sends the command to the server (see `send` in [Send message](#send-message)), that the server will authenticate using the "public" key `SK` (that Alice earlier received from Bob and provided to the server via `"KEY"` command).
+   3. He sends the command to the server (see `send` in [Send message](#send-message)), that the server will verify using the "public" key `SK` (that Alice earlier received from Bob and provided to the server via `"KEY"` command).
 
 2. Alice receives the message(s):
 
-   1. She signs `"SUB"` command to the server to subscribe to the queue `RID` with the "private" key `RK` (see `subscribe` in [Subscribe to queue](#subscribe-to-queue)).
+   1. She authorizes `"SUB"` command to the server to subscribe to the queue `RID` with the "private" key `RK` (see `subscribe` in [Subscribe to queue](#subscribe-to-queue)).
 
-   2. The server, having authenticated Alice's command with the "public" key `RK` that she provided, delivers Bob's message(s) (see `message` in [Deliver queue message](#deliver-queue-message)).
+   2. The server, having verified Alice's command with the "public" key `RK` that she provided, delivers Bob's message(s) (see `message` in [Deliver queue message](#deliver-queue-message)).
 
-   3. She decrypts Bob's message(s) with the "private" key `EK` (that only she has).
+   3. She decrypts Bob's message(s) with the shared secret agreed using "private" key `EK`.
 
    4. She acknowledges the message reception to the server with `"ACK"` so that the server can delete the message and deliver the next messages.
 
@@ -245,15 +265,27 @@ This flow is show on sequence diagram below.
 
 Sequence diagram does not show E2E encryption - server knows nothing about encryption between the sender and the receiver.
 
-A higher level protocol application protocol should define the semantics that allow to use two simplex queues (or two sets of queues for redundancy) for the bi-directional or any other communication scenarios.
+A higher level application protocol should define the semantics that allow to use two simplex queues (or two sets of queues for redundancy) for the bi-directional or any other communication scenarios.
 
 The SMP is intentionally unidirectional - it provides no answer to how Bob will know that the transmission succeeded, and whether Alice received any messages. There may be a scenario when Alice wants to securely receive the messages from Bob, but she does not want Bob to have any proof that she received any messages - this low-level protocol can be used in this scenario, as all Bob knows as a fact is that he was able to send one unsigned message to the server that Alice provided, and now he can only send messages signed with the key `SK` that he sent to the server - it does not prove that any message was received by Alice.
 
-For practical purposes of bi-directional conversation, now that Bob can securely send encrypted messages to Alice, Bob can create the second simplex queue that will allow Alice to send messages to Bob in the same way, sending the second queue details via the first queue. If both Alice and Bob have their respective unique "public" keys (Alice's and Bob's `EK`s of two separate queues), or pass additional keys to sign the messages, the conversation can be both encrypted and signed.
+For bi-directional conversation, now that Bob can securely send encrypted messages to Alice, Bob can create the second simplex queue that will allow Alice to send messages to Bob in the same way, sending the second queue details via the first queue. If both Alice and Bob have their respective unique "public" keys (Alice's and Bob's `EK`s of two separate queues), or pass additional keys to sign the messages, the conversation can be both encrypted and signed.
 
 The established queues can also be used to change the encryption keys providing [forward secrecy][5], or to negotiate using other SMP queue(s).
 
-This protocol also can be used for off-the-record messaging, as Alice and Bob can use multiple queues between them and only information they pass to each other allows proving their identity, so if they want to share anything off-the-record they can initiate a new queue without linking it to any other information they exchanged. As a result, this protocol provides better anonymity and better protection from [MITM][1] than [OTR][6] protocol.
+This protocol also can be used for off-the-record messaging, as Alice and Bob can use multiple queues between them and only information they pass to each other allows proving their identity, so if they want to share anything off-the-record they can initiate a new queue without linking it to any other information they exchanged.
+
+## Fast SMP procedure
+
+V9 of SMP protocol added support for creating messaging queue in fewer steps, with the sender being able to send the messages without waiting for the recipient to be online to secure the key.
+
+In step 1.5 of [SMP procedure](#smp-procedure) the client must use sndSecure parameter set to `T` (true) to allow sender securing the queue.
+
+In step 2, the [SMP queue URI](#smp-queue-uri) should include parameter indicating that the sender can secure the queue.
+
+In step 3.2, prior to sending the confirmation message Bob secures the queue using `SKEY` command. Confirmation message is now sent with sender authorization and Bob can continue sending the messages without Alice being online. This also allows faster negotiation of duplex connections.
+
+![Creating queue](./diagrams/simplex-messaging/simplex-creating-fast.svg)
 
 ## SMP qualities and features
 
@@ -269,11 +301,11 @@ Simplex Messaging Protocol:
 
   - Multiple servers, that can be deployed by the system users, can be used to send and retrieve messages.
 
-  - Servers do not communicate with each other and do not "know" about other servers.
+  - Servers do not communicate with each other, except when used as proxy to forward commands to another server, and do not "know" about other servers.
 
   - Clients only communicate with servers (excluding the initial out-of-band message), so the message passing is asynchronous.
 
-  - For each queue, the message recipient defines the server through which the sender should send messages.
+  - For each queue, the message recipient defines the server through which the sender should send messages. To protect transport anonymity the sender can use their chosen server to forward commands to the server chosen by the recipient.
 
   - While multiple servers and multiple queues can be used to pass each message, it is in scope of application level protocol(s), and out of scope of this protocol.
 
@@ -285,50 +317,56 @@ Simplex Messaging Protocol:
 
   - Each queue is created and managed by the queue recipient.
 
-  - Asymmetric encryption is used to sign and verify the requests to send and receive the messages.
+  - Asymmetric encryption is used to authorize and verify the requests to send and receive the messages.
 
-  - One unique "public" key is used by the servers to authenticate requests to send the messages into the queue, and another unique "public" key - to retrieve the messages from the queue. "Unique" here means that each "public" key is used only for one queue and is not used for any other context - effectively, this key is not public and does not represent any participant identity.
+  - One ephemeral public key is used by the servers to verify requests to send the messages into the queue, and another ephemeral public key - to verify requests to retrieve the messages from the queue. These ephemeral keys are used only for one queue, and are not used for any other context - this key does not represent any participant identity.
 
-  - Both recipient and sender "public" keys are provided to the server by the queue recipient. "Public" key `RK` is provided when the queue is created, public key `SK` is provided when the queue is secured.
+  - Both recipient and sender public keys are provided to the server by the queue recipient. "Public" key `RK` is provided when the queue is created, public key `SK` is provided when the queue is secured. V9 of SMP protocol allows senders to provide their key to the server directly or via proxy, to avoid waiting until the recipient is online to secure the queue.
 
-  - The "public" keys known to the server and used to authenticate commands from the participants are unrelated to the keys used to encrypt and decrypt the messages - the latter keys are also unique per each queue but they are only known to participants, not to the servers.
+  - The "public" keys known to the server and used to verify commands from the participants are unrelated to the keys used to encrypt and decrypt the messages - the latter keys are also unique per each queue but they are only known to participants, not to the servers.
 
   - Messaging graph can be asymmetric: Bob's ability to send messages to Alice does not automatically lead to the Alice's ability to send messages to Bob.
 
 ## Cryptographic algorithms
 
-Simplex messaging clients and servers must cryptographically sign commands, responses and messages for the following operations:
+Simplex messaging clients must cryptographically authorize commands for the following operations:
 
 - With the recipient's key `RK` (server to verify):
   - create the queue (`NEW`)
   - subscribe to queue (`SUB`)
   - secure the queue (`KEY`)
   - enable queue notifications (`NKEY`)
+  - disable queue notifications (`NDEL`)
   - acknowledge received messages (`ACK`)
   - suspend the queue (`OFF`)
   - delete the queue (`DEL`)
 - With the sender's key `SK` (server to verify):
+  - secure queue (`SKEY`)
   - send messages (`SEND`)
 - With the optional notifier's key:
   - subscribe to message notifications (`NSUB`)
-- With the server's key (for recipient and sender to verify)
-  - queue IDs response (`IDS`)
-  - notifier queue ID response (`NID`)
-  - delivered messages (`MSG`)
-  - `OK` and `ERR` responses (excluding error responses not related to a queue)
 
-To sign/verify transmissions clients and servers MUST use Ed25519 or Ed448 algorithm defined in [RFC8709][15].
+To authorize/verify transmissions clients and servers MUST use either signature algorithm Ed25519 algorithm defined in [RFC8709][15] or [deniable authentication scheme](#deniable-client-authentication-scheme) based on NaCL crypto_box.
 
-To encrypt/decrypt message bodies delivered to the recipients, servers/clients MUST use x25519 or x448 algorithm defined in [RFC8709][15] to derive the shared secret (TODO encryption scheme).
+It is recommended that clients use signature algorithm for the recipient commands and deniable authentication scheme for sender commands (to have non-repudiation quality in the whole protocol stack).
 
-Clients MUST encrypt message bodies sent via SMP servers - the protocol for this end-to-end encryption should be chosen by the clients using SMP protocol.
+To encrypt/decrypt message bodies delivered to the recipients, servers/clients MUST use NaCL crypto_box.
 
-The reasons to use these algorithms:
+Clients MUST encrypt message bodies sent via SMP servers using use NaCL crypto_box.
 
-- Faster operation than RSA algorithms.
-- DH key exchange provides forward secrecy.
+## Deniable client authentication scheme
 
-Future versions of the protocol may allow different cryptographic algorithms.
+While e2e encryption algorithms used in the client applications have repudiation quality, which is the desirable default, using signature algorithm for command authorization has non-repudiation quality.
+
+SMP protocol supports repudiable authenticators to authorize client commands. These authenticators use NaCl crypto_box that proves authentication and third party unforgeability and, unlike signature, provides repudiation guarantee. See [crypto_box docs](https://nacl.cr.yp.to/box.html).
+
+When queue is created or secured, the recipient would provide a DH key (X25519) to the server (either their own or received from the sender, in case of KEY command), and the server would provide its own random X25519 key per session in the handshake header. The authenticator is computed in this way:
+
+```abnf
+transmission = authenticator authorized
+authenticator = crypto_box(sha512(authorized), secret = dh(client long term queue key, server session key), nonce = correlation ID)
+authorized = sessionIdentifier corrId queueId protocol_command ; same as the currently signed part of the transmission
+```
 
 ## Simplex queue IDs
 
@@ -351,7 +389,7 @@ Simplex messaging server implementations MUST NOT create, store or send to any o
 
 ## Message delivery notifications
 
-Supporting message delivery while the client mobile app is not running requires sending push notifications with the device token. All alternative mechanisms for background message delivery are unreliable, particularly on iOS platform. Obviously, supporting push notification delivery by simply subscribing to messages would reduce meta-data privacy as it allows to see all queues that a given device uses.
+Supporting message delivery while the client mobile app is not running requires sending push notifications with the device token. All alternative mechanisms for background message delivery are unreliable, particularly on iOS platform.
 
 To protect the privacy of the recipients, there are several commands in SMP protocol that allow enabling and subscribing to message notifications from SMP queues, using separate set of "notifier keys" and via separate queue IDs - as long as SMP server is not compromised, these notifier queue IDs cannot be correlated with recipient or sender queue IDs.
 
@@ -362,14 +400,14 @@ The clients can optionally instruct a dedicated push notification server to subs
 - `subscribeNotifications` (`"NSUB"`) - see [Subscribe to queue notifications](#subscribe-to-queue-notifications).
 - `messageNotification` (`"NMSG"`) - see [Deliver message notification](#deliver-message-notification).
 
-[`SEND` command](#send-message) includes the notification flag to instruct SMP server whether to send the notification - this flag is forwarded to the recepient inside encrypted envelope, together with the timestamp and the message body, so even if TLS is compromised this flag cannot be used for traffic correlation.
+[`SEND` command](#send-message) includes the notification flag to instruct SMP server whether to send the notification - this flag is forwarded to the recipient inside encrypted envelope, together with the timestamp and the message body, so even if TLS is compromised this flag cannot be used for traffic correlation.
 
 ## SMP Transmission and transport block structure
 
 Each transport block has a fixed size of 16384 bytes for traffic uniformity.
 
-From SMP version 4 each block can contain multiple transmissions, version 3 blocks have 1 transmission.
-Some parts of SMP transmission are padded to a fixed size; this padding is uniformly added as a word16 encoded in network byte order - see `paddedString` syntax.
+Each block can contain multiple transmissions.
+Some parts of SMP transmission are padded to a fixed size; the size of the unpadded string is prepended as a word16 encoded in network byte order - see `paddedString` syntax.
 
 In places where some part of the transmission should be padded, the syntax for `paddedNotation` is used:
 
@@ -383,26 +421,7 @@ paddedNotation = <padded(string, paddedLength)>
 ; paddedLength - required length after padding, including 2 bytes for originalLength
 ```
 
-Each transmission/block for SMP v3 between the client and the server must have this format/syntax:
-
-```abnf
-paddedTransmission = <padded(transmission), 16384>
-transmission = signature signed
-signed = sessionIdentifier corrId queueId smpCommand
-; corrId is required in client commands and server responses,
-; it is empty in server notifications.
-corrId = length *OCTET
-queueId = length *OCTET
-; empty queue ID is used with "create" command and in some server responses
-signature = length *OCTET
-; empty signature can be used with "send" before the queue is secured with secure command
-; signature is always empty with "ping" and "serverMsg"
-length = 1*1 OCTET
-```
-
-`base64` encoding should be used with padding, as defined in section 4 of [RFC 4648][9]
-
-Transport block for SMP v4 has this syntax:
+Transport block for SMP transmission between the client and the server must have this syntax:
 
 ```abnf
 paddedTransportBlock = <padded(transportBlock), 16384>
@@ -410,6 +429,24 @@ transportBlock = transmissionCount transmissions
 transmissionCount = 1*1 OCTET ; equal or greater than 1
 transmissions = transmissionLength transmission [transmissions]
 transmissionLength = 2*2 OCTET ; word16 encoded in network byte order
+
+transmission = authorization authorized
+authorized = sessionIdentifier corrId entityId smpCommand
+corrId = %x18 24*24 OCTET / %x0 ""
+  ; corrId is required in client commands and server responses,
+  ; it is empty (0-length) in server notifications.
+  ; %x18 is 24 - the random correlation ID must be 24 bytes as it is used as a nonce for NaCL crypto_box in some contexts.
+entityId = shortString ; queueId or proxySessionId
+  ; empty entityId ID is used with "create" command and in some server responses
+authorization = shortString ; signature or authenticator
+  ; empty authorization can be used with "send" before the queue is secured with secure command
+  ; authorization is always empty with "ping" and server responses
+sessionIdentifier = "" ; 
+sessionIdentifierForAuth = shortString 
+  ; sessionIdentifierForAuth MUST be included in authorized transmission body.
+  ; From v7 of SMP protocol but it is no longer used in the transmission to save space and fit more transmissions in the transport block.
+shortString = length *OCTET ; length prefixed bytearray 0-255 bytes
+length = 1*1 OCTET
 ```
 
 ## SMP commands
@@ -417,11 +454,16 @@ transmissionLength = 2*2 OCTET ; word16 encoded in network byte order
 Commands syntax below is provided using [ABNF][8] with [case-sensitive strings extension][8a].
 
 ```abnf
-smpCommand = ping / recipientCmd / send / subscribeNotifications / serverMsg
-recipientCmd = create / subscribe / secure / enableNotifications / disableNotifications /
-               acknowledge / suspend / delete
+smpCommand = ping / recipientCmd / senderCommand /
+             proxyCommand / subscribeNotifications / serverMsg
+recipientCmd = create / subscribe / rcvSecure /
+               enableNotifications / disableNotifications / getMessage
+               acknowledge / suspend / delete / getQueueInfo
+senderCommand = send / sndSecure
+proxyCommand = proxySession / proxyCommand / relayCommand
 serverMsg = queueIds / message / notifierId / messageNotification /
-            unsubscribed / ok / error
+            proxySessionKey / proxyResponse / relayResponse
+            unsubscribed / queueInfo/ ok / error
 ```
 
 The syntax of specific commands and responses is defined below.
@@ -432,9 +474,9 @@ The server should send `queueIds`, `error` and `ok` responses in the same order
 
 If the transport connection is closed before some responses are sent, these responses should be discarded.
 
-### Command authentication
+### Command verification
 
-SMP servers must authenticate all transmissions (excluding `ping` and initial `send` commands) by verifying the client signatures. Command signature should be generated by applying the algorithm specified for the queue to the `signed` block of the transmission, using the key associated with the queue ID (recipient's, sender's or notifier's, depending on which queue ID is used).
+SMP servers must verify all transmissions (excluding `ping` and initial `send` commands) by verifying the client authorizations. Command authorization should be generated by applying the algorithm specified for the queue to the `signed` block of the transmission, using the key associated with the queue ID (recipient's, sender's or notifier's, depending on which queue ID is used).
 
 ### Keep-alive command
 
@@ -452,37 +494,42 @@ Sending any of the commands in this section (other than `create`, that is sent w
 
 #### Create queue command
 
-This command is sent by the recipient to the SMP server to create a new queue. The syntax is:
+This command is sent by the recipient to the SMP server to create a new queue.
+
+Servers SHOULD support basic auth with this command, to allow only server owners and trusted users to create queues on the destiation servers.
+
+The syntax is:
 
 ```abnf
-create = %s"NEW " recipientSignaturePublicKey recipientDhPublicKey
-recipientSignaturePublicKey = length x509encoded
-; the recipient's Ed25519 or Ed448 public key to verify commands for this queue
-
+create = %s"NEW " recipientAuthPublicKey recipientDhPublicKey basicAuth subscribe sndSecure
+recipientAuthPublicKey = length x509encoded
+; the recipient's Ed25519 or X25519 public key to verify commands for this queue
 recipientDhPublicKey = length x509encoded
 ; the recipient's Curve25519 key for DH exchange to derive the secret
 ; that the server will use to encrypt delivered message bodies
 ; using [NaCl crypto_box][16] encryption scheme (curve25519xsalsa20poly1305).
+basicAuth = "0" / "1" shortString ; server password
+subscribeMode = %s"S" / %s"C" ; S - create and subscribe, C - only create
+sndSecure = %s"T" / %s"F" ; T - sender can secure the queue, from v9
 
 x509encoded = <binary X509 key encoding>
-
 length = 1*1 OCTET
 ```
 
-If the queue is created successfully, the server must send `queueIds` response with the recipient's and sender's queue IDs and public keys to sign all responses and messages and to encrypt delivered message bodies:
+If the queue is created successfully, the server must send `queueIds` response with the recipient's and sender's queue IDs and public key to encrypt delivered message bodies:
 
 ```abnf
-queueIds = %s"IDS " recipientId senderId srvDhPublicKey
+queueIds = %s"IDS " recipientId senderId srvDhPublicKey sndSecure
 serverDhPublicKey = length x509encoded
 ; the server's Curve25519 key for DH exchange to derive the secret
 ; that the server will use to encrypt delivered message bodies to the recipient
-recipientId = length *OCTET ; 16-24 bytes
-senderId = length *OCTET ; 16-24 bytes
+recipientId = shortString ; 16-24 bytes
+senderId = shortString ; 16-24 bytes
 ```
 
-Once the queue is created, the recipient gets automatically subscribed to receive the messages from that queue, until the transport connection is closed. The `subscribe` command is needed only to start receiving the messages from the existing queue when the new transport connection is opened.
+Once the queue is created, depending on `subscribeMode` parameter of `NEW` command the recipient gets automatically subscribed to receive the messages from that queue, until the transport connection is closed. To start receiving the messages from the existing queue when the new transport connection is opened the client must use `subscribe` command.
 
-`NEW` transmission MUST be signed using the private part of the `recipientSignaturePublicKey` – this verifies that the client has the private key that will be used to sign subsequent commands for this queue.
+`NEW` transmission MUST be authorized using the private part of the `recipientAuthPublicKey` – this verifies that the client has the private key that will be used to authorize subsequent commands for this queue.
 
 `IDS` response transmission MUST be sent with empty queue ID (the third part of the transmission).
 
@@ -500,19 +547,23 @@ The first message will be delivered either immediately or as soon as it is avail
 
 This transmission and its response MUST be signed.
 
-#### Secure queue command
+#### Secure queue by recipient
+
+This command is only used until v8 of SMP protocol. V9 uses [SKEY](#secure-queue-by-sender).
 
 This command is sent by the recipient to the server to add sender's key to the queue:
 
 ```abnf
-secure = %s"KEY " senderSignaturePublicKey
-senderSignaturePublicKey = length x509encoded
-; the sender's Ed25519 or Ed448 key to verify SEND commands for this queue
+rcvSecure = %s"KEY " senderAuthPublicKey
+senderAuthPublicKey = length x509encoded
+; the sender's Ed25519 or X25519 key to verify SEND commands for this queue
 ```
 
 `senderKey` is received from the sender as part of the first message - see [Send Message](#send-message) command.
 
-Once the queue is secured only signed messages can be sent to it.
+Once the queue is secured only authorized messages can be sent to it.
+
+This command MUST be used in transmission with recipient queue ID.
 
 #### Enable notifications command
 
@@ -521,7 +572,7 @@ This command is sent by the recipient to the server to add notifier's key to the
 ```abnf
 enableNotifications = %s"NKEY " notifierKey recipientNotificationDhPublicKey
 notifierKey = length x509encoded
-; the notifier's Ed25519 or Ed448 public key public key to verify NSUB command for this queue
+; the notifier's Ed25519 or X25519 public key to verify NSUB command for this queue
 
 recipientNotificationDhPublicKey = length x509encoded
 ; the recipient's Curve25519 key for DH exchange to derive the secret
@@ -533,7 +584,7 @@ The server will respond with `notifierId` response if notifications were enabled
 
 ```abnf
 notifierId = %s"NID " notifierId srvNotificationDhPublicKey
-notifierId = length *OCTET ; 16-24 bytes
+notifierId = shortString ; 16-24 bytes
 srvNotificationDhPublicKey = length x509encoded
 ; the server's Curve25519 key for DH exchange to derive the secret
 ; that the server will use to encrypt notification metadata to the recipient (encryptedNMsgMeta in NMSG)
@@ -555,17 +606,30 @@ The server must respond `ok` to this command if it was successful.
 
 Once notifier's credentials are removed server will no longer send "NMSG" for this queue to notifier.
 
+#### Get message command
+
+The client can use this command to receive one message without subscribing to the queue. This command is used when processing push notifications.
+
+The client MUST NOT use `SUB` and `GET` command on the same queue in the same transport connection - doing so would create an error.
+
+```abnf
+getMessage = %s"GET"
+```
+
 #### Acknowledge message delivery
 
 The recipient should send the acknowledgement of message delivery once the message was stored in the client, to notify the server that the message should be deleted:
 
 ```abnf
-acknowledge = %s"ACK"
+acknowledge = %s"ACK" SP msgId
+msgId = shortString
 ```
 
-Even if acknowledgement is not sent by the recipient, the server should limit the time of message storage, whether it was delivered to the recipient or not.
+Client must send message ID to acknowledge a particular message - to prevent double acknowledgement (e.g., when command response times out) resulting in message being lost. If the message was not delivered or if the ID of the message does not match the last delivered message, the server SHOULD respond with `ERR NO_MSG` error.
 
-Having received the acknowledgement, SMP server should immediately delete the message and then send the next available message or respond with `ok` if there are no more messages available in this simplex queue.
+The server should limit the time the message is stored, even if the message was not delivered or if acknowledgement is not sent by the recipient.
+
+Having received the acknowledgement, SMP server should delete the message and then send the next available message or respond with `ok` if there are no more messages available in this simplex queue.
 
 #### Suspend queue
 
@@ -593,10 +657,67 @@ All undelivered messages must be deleted as soon as this command is received, be
 delete = %s"DEL"
 ```
 
+#### Get queue state
+
+This command is used by the queue recipient to get the debugging information about the current state of the queue.
+
+The response to that command is `INFO`.
+
+```abnf
+getQueueInfo = %s"QUE"
+queueInfo = %s"INFO " info
+info = <json encoded queue information>
+```
+
+The format of queue information is implementation specific, and is not part of the specification. For information, [JTD schema][17] for queue information returned by the reference implementation of SMP server is:
+
+```json
+{
+  "properties": {
+    "qiSnd": {"type": "boolean"},
+    "qiNtf": {"type": "boolean"},
+    "qiSize": {"type": "uint16"}
+  },
+  "optionalProperties": {
+    "qiSub": {
+      "properties": {
+        "qSubThread": {"enum": ["noSub", "subPending", "subThread", "prohibitSub"]}
+      },
+      "optionalProperties": {
+        "qDelivered": {"type": "string", "metadata": {"description": "message ID"}}
+      }
+    },
+    "qiMsg": {
+      "properties": {
+        "msgId": {"type": "string"},
+        "msgTs": {"type": "timestamp"},
+        "msgType": {"enum": ["message", "quota"]}
+      }
+    }
+  }
+}
+```
+
 ### Sender commands
 
 Currently SMP defines only one command that can be used by senders - `send` message. This command must be used with sender's ID, if recipient's ID is used the server must respond with `"ERR AUTH"` response (see [Error responses](#error-responses)).
 
+#### Secure queue by sender
+
+This command is used from v8 of SMP protocol. V8 and earlier uses [KEY](#secure-queue-by-recipient).
+
+This command is sent by the sender to the server to add sender's key to the queue:
+
+```abnf
+sndSecure = %s"SKEY " senderAuthPublicKey
+senderAuthPublicKey = length x509encoded
+; the sender's Ed25519 or X25519 key to verify SEND commands for this queue
+```
+
+Once the queue is secured only authorized messages can be sent to it.
+
+This command MUST be used in transmission with sender queue ID.
+
 #### Send message
 
 This command is sent to the server by the sender both to confirm the queue after the sender received out-of-band message from the recipient and to send messages after the queue is secured:
@@ -605,64 +726,79 @@ This command is sent to the server by the sender both to confirm the queue after
 send = %s"SEND " msgFlags SP smpEncMessage
 msgFlags = notificationFlag reserved
 notificationFlag = %s"T" / %s"F"
-smpEncMessage = smpPubHeader sentMsgBody ; message up to 16088 bytes
-smpPubHeader = smpClientVersion ("1" senderPublicDhKey / "0")
-smpClientVersion = word16
+smpEncMessage = smpEncClientMessage / smpEncConfirmation ; message up to 16064 bytes
+
+smpEncClientMessage = smpPubHeaderNoKey msgNonce sentClientMsgBody ; message up to 16064 bytes
+smpPubHeaderNoKey = smpClientVersion "0"
+sentClientMsgBody = 16016*16016 OCTET
+
+smpEncConfirmation = smpPubHeaderWithKey msgNonce sentConfirmationBody
+smpPubHeaderWithKey = smpClientVersion "1" senderPublicDhKey
+  ; sender's Curve25519 public key to agree DH secret for E2E encryption in this queue
+  ; it is only sent in confirmation message
+sentConfirmationBody = 15920*15920 OCTET ; E2E-encrypted smpClientMessage padded to 16016 bytes before encryption
 senderPublicDhKey = length x509encoded
-; sender's Curve25519 public key to agree DH secret for E2E encryption in this queue
-; it is only sent in confirmation message
+
+smpClientVersion = word16
 x509encoded = <binary X509 key encoding>
-sentMsgBody = 16032*16032 OCTET
-; E2E-encrypted smpClientMessage padded to 16032 bytes before encryption
+msgNonce = 24*24 OCTET
 word16 = 2*2 OCTET
 ```
 
-The first message is sent to confirm the queue - it should contain sender's server key (see decrypted message syntax below) - this first message must be sent without signature.
+The first message is sent to confirm the queue - it should contain sender's server key (see decrypted message syntax below) - this first message may be sent without authorization.
 
-Once the queue is secured (see [Secure queue command](#secure-queue-command)), the following send commands must be sent with the signature.
+Once the queue is secured (see [Secure queue by sender](#secure-queue-by-sender)), the subsequent `SEND` commands must be sent with the authorization.
 
 The server must respond with `"ERR AUTH"` response in the following cases:
 
 - the queue does not exist or is suspended
-- the queue is secured but the transmission does NOT have a signature
-- the queue is NOT secured but the transmission has a signature
+- the queue is secured but the transmission does NOT have a authorization
+- the queue is NOT secured but the transmission has a authorization
 
-Until the queue is secured, the server should accept any number of unsigned messages - it both enables the legitimate sender to resend the confirmation in case of failure and also allows the simplex messaging client to ignore any confirmation messages that may be sent by the attackers (assuming they could have intercepted the queue ID in the server response, but do not have a correct encryption key passed to sender in out-of-band message).
+The server must respond with `"ERR QUOTA"` response when queue capacity is exceeded. The number of messages that the server can hold is defined by the server configuration. When sender reaches queue capacity the server will not accept any further messages until the recipient receives ALL messages from the queue. After the last message is delivered, the server will deliver an additional special message indicating that the queue capacity was reached. See [Deliver queue message](#deliver-queue-message)
 
-The body should be encrypted with the recipient's "public" key (`EK`); once decrypted it must have this format:
+Until the queue is secured, the server should accept any number of unsigned messages (up to queue  capacity) - it allows the sender to resend the confirmation in case of failure.
+
+The body should be encrypted with the shared secret based on recipient's "public" key (`EK`); once decrypted it must have this format:
 
 ```abnf
-sentMsgBody = <encrypted padded(smpClientMessage, 16032)>
-smpClientMessage = smpPrivHeader clientMsgBody
-smpPrivHeader = emptyHeader / smpConfirmationHeader
-emptyHeader = " "
-smpConfirmationHeader = %s"K" senderKey
+sentClientMsgBody = <encrypted padded(smpClientMessage, 16016)>
+smpClientMessage = emptyHeader clientMsgBody
+emptyHeader = "_"
+clientMsgBody = *OCTET ; up to 16016 - 2
+
+sentConfirmationBody = <encrypted padded(smpConfirmation, 15920)>
+smpConfirmation = smpConfirmationHeader confirmationBody
+smpConfirmationHeader = emptyHeader / %s"K" senderKey
+  ; emptyHeader is used when queue is already secured by sender
+confirmationBody = *OCTET ; up to 15920 - 2
 senderKey = length x509encoded
-; the sender's Ed25519 or Ed448 public key to sign SEND commands for this queue
-clientMsgBody = *OCTET ; up to 16016 in case of emptyHeader
+  ; the sender's Ed25519 or X25519 public key to authorize SEND commands for this queue
 ```
 
 `clientHeader` in the initial unsigned message is used to transmit sender's server key and can be used in the future revisions of SMP protocol for other purposes.
 
-SMP transmission structure for sent messages:
+SMP transmission structure for directly sent messages:
 
 ```
-------- transmission (= 16384 bytes)
+------- transmissions (= 16384 bytes)
+    1 | transmission count (= 1)
     2 | originalLength
- 276- | signature sessionId corrId queueId %s"SEND" SP (1+114 + 1+32? + 1+32 + 1+24 + 4+1 = 210)
-      ....... smpEncMessage (= 16088 bytes = 16384 - 296 bytes)
+ 299- | authorization sessionId corrId queueId %s"SEND" SP (1+114 + 1+32? + 1+24 + 1+24 + 4+1 = 203)
+      ....... smpEncMessage (= 16064 bytes = 16384 - 320 bytes)
          8- | smpPubHeader (for messages it is only version and '0' to mean "no DH key" = 3 bytes)
          24 | nonce for smpClientMessage
          16 | auth tag for smpClientMessage
-            ------- smpClientMessage (E2E encrypted, = 16032 bytes = 16088 - 48)
+            ------- smpClientMessage (E2E encrypted, = 16016 bytes = 16064 - 48)
                 2 | originalLength
-               12- | smpPrivHeader
+               2- | smpPrivHeader
                   .......
-                        | clientMsgBody (<= 16016 bytes = 16032 - 14)
+                        | clientMsgBody (<= 16012 bytes = 16016 - 4)
                   .......
                0+ | smpClientMessage pad
             ------- smpClientMessage end
             |
+         0+ | message pad
       ....... smpEncMessage end
   18+ | transmission pad
 ------- transmission end
@@ -671,20 +807,23 @@ SMP transmission structure for sent messages:
 SMP transmission structure for received messages:
 
 ```
-------- transmission (= 16384 bytes)
+------- transmissions (= 16384 bytes)
+    1 | transmission count (= 1)
     2 | originalLength
- 276- | signature sessionId corrId queueId %s"MSG" SP msgId timestamp (1+114 + 1+32? + 1+32 + 1+24 + 3+1 + 24+1 + 8 = 243)
+ 283- | authorization sessionId corrId queueId %s"MSG" SP msgId (1+114 + 1+32? + 1+24 + 1+24 + 3+1 + 1+24 = 227)
    16 | auth tag (msgId is used as nonce)
-      ------- serverEncryptedMsg (= 16090 bytes = 16384 - 294 bytes)
+      ------- serverEncryptedMsg (= 16082 bytes = 16384 - 302 bytes)
           2 | originalLength
-            ....... smpEncMessage (= 16088 bytes = 16090 - 2 bytes)
-               16- | smpPubHeader (empty header for the message)
+          8 | timestamp
+         8- | message flags
+            ....... smpEncMessage (= 16064 bytes = 16082 - 18 bytes)
+               8- | smpPubHeader (empty header for the message)
                24 | nonce for smpClientMessage
                16 | auth tag for smpClientMessage
-                  ------- smpClientMessage (E2E encrypted, = 16032 bytes = 16088 - 56 bytes)
+                  ------- smpClientMessage (E2E encrypted, = 16016 bytes = 16064 - 48 bytes)
                       2 | originalLength
-                     16- | smpPrivHeader (empty header for the message)
-                        ....... clientMsgBody (<= 16016 bytes = 16032 - 16)
+                     2- | smpPrivHeader (empty header for the message)
+                        ....... clientMsgBody (<= 16012 bytes = 16016 - 4)
                               -- TODO move internal structure (below) to agent protocol
                           20- | agentPublicHeader (the size is for user messages post handshake, without E2E X3DH keys - it is version and 'M' for the messages - 3 bytes in total)
                               ....... E2E double-ratchet encrypted (<= 15996 bytes = 16016 - 20)
@@ -719,6 +858,149 @@ SMP transmission structure for received messages:
 ------- transmission end
 ```
 
+### Proxying sender commands
+
+To protect transport (IP address and session) anonymity of the sender from the server chosen (and, potentially, controlled) by the recipient SMP v8 added support for proxying sender's command to the recipient's server via the server chosen by the sender.
+
+Sequence diagram for sending the message and `SKEY` commands via SMP proxy:
+
+```
+-------------               -------------                     -------------              -------------
+|  sending  |               |    SMP    |                     |    SMP    |              | receiving |
+|  client   |               |   proxy   |                     |   server  |              |  client   |
+-------------               -------------                     -------------              -------------
+     |           `PRXY`           |                                 |                          |
+     | -------------------------> |                                 |                          |
+     |                            | ------------------------------> |                          |
+     |                            |          SMP handshake          |                          |
+     |                            | <------------------------------ |                          |
+     |           `PKEY`           |                                 |                          |
+     | <------------------------- |                                 |                          |
+     |                            |                                 |                          |
+     |        `PFWD` (s2r)        |                                 |                          |
+     | -------------------------> |                                 |                          |
+     |                            |           `RFWD` (p2r)          |                          |
+     |                            | ------------------------------> |                          |
+     |                            |           `RRES` (p2r)          |                          |
+     |                            | <------------------------------ |                          |
+     |        `PRES` (s2r)        |                                 |           `MSG`          |
+     | <------------------------- |                                 | -----------------------> |
+     |                            |                                 |           `ACK`          |
+     |                            |                                 | <----------------------- |
+     |                            |                                 |                          |
+     |                            |                                 |                          |
+```
+
+1. The client requests (`PRXY` command) the chosen server to connect to the destination SMP server and receives (`PKEY` response) the session information, including server certificate and the session key signed by this certificate. To protect client session anonymity the proxy MUST re-use the same session with all clients that request connection with any given destination server.
+
+2. The client encrypts the transmission (`SKEY` or `SEND`) to the destination server using the shared secret computed from per-command random key and server's session key and sends it to proxying server in `PFWD` command.
+
+3. Proxy additionally encrypts the body to prevent correlation by ciphertext (in case TLS is compromised) and forwards it to proxy in `RFWD` command.
+
+4. Proxy receives the double-encrypted response from the destination server, removes one encryption layer and forwards it to the client.
+
+The diagram below shows the encryption layers for `PFWD`/`RFWD` commands and `RRES`/`PRES` responses:
+
+- s2r - encryption between client and SMP relay, with relay key returned in relay handshake, with MITM by proxy mitigated by verifying the certificate fingerprint included in the relay address. This encryption prevents proxy server from observing commands and responses - proxy does not know how many different queues a connected client sends messages and commands to.
+- e2e - end-to-end encryption per SMP queue, with additional client encryption inside it.
+- p2r - additional encryption between proxy and SMP relay with the shared secret agreed in the handshake, to mitigate traffic correlation inside TLS.
+- r2c - additional encryption between SMP relay and client to prevent traffic correlation inside TLS.
+
+```
+-----------------             -----------------  -- TLS --  -----------------             -----------------
+|               |  -- TLS --  |               |  -- p2r --  |               |  -- TLS --  |               |
+|               |  -- s2r --  |               |  -- s2r --  |               |  -- r2c --  |               |
+|    sending    |  -- e2e --  |               |  -- e2e --  |               |  -- e2e --  |   receiving   |
+|    client     |     MSG     |   SMP proxy   |     MSG     |   SMP server  |     MSG     |    client     |
+|               |  -- e2e --  |               |  -- e2e --  |               |  -- e2e --  |               |
+|               |  -- s2r --  |               |  -- s2r --  |               |  -- r2c --  |               |
+|               |  -- TLS --  |               |  -- p2r --  |               |  -- TLS --  |               |
+-----------------             -----------------  -- TLS --  -----------------             -----------------
+```
+
+SMP proxy is not another type of the server, it is a role that any SMP server can play when forwarding the commands.
+
+#### Request proxied session
+
+The sender uses this command to request the session with the destination proxy.
+
+Servers SHOULD support basic auth with this command, to allow only server owners and trusted users to proxy commands to the destination servers.
+
+```abnf
+proxySession = %s"PRXY" SP smpServer basicAuth
+smpServer = hosts port fingerprint
+hosts = length 1*host
+host = shortString
+port = shortString
+fingerprint = shortString
+basicAuth = "0" / "1" shortString ; server password
+```
+
+```abnf
+proxySessionKey = %s"PKEY" SP sessionId smpVersionRange certChain signedKey
+sessionId = shortString
+  ; Session ID (tlsunique) of the proxy with the destination server.
+  ; This session ID should be used as entity ID in transmission with `PFWD` command
+certChain = length 1*cert
+cert = originalLength x509encoded
+signedKey = originalLength x509encoded ; key signed with certificate
+originalLength = 2*2 OCTET
+```
+
+When the client receives PKEY response it MUST validate that:
+- the fingerprint of the received certificate matches fingerprint in the server address - it mitigates MITM attack by proxy.
+- the server session key is correctly signed with the received certificate.
+
+The proxy server may respond with error response in case the destination server is not available or in case it has an earlier version that does not support proxied commands.
+
+#### Send command via proxy
+
+Sender can send `SKEY` and `SEND` commands via proxy after obtaining the session ID with `PRXY` command (see [Request proxied session](#request-proxied-session)).
+
+Transmission sent to proxy server should use session ID as entity ID and use a random correlation ID of 24 bytes as a nonce for crypto_box encryption of transmission to the destination server. The random ephemeral X25519 key to encrypt transmission should be unique per command, and it should be combined with the key sent by the server in the handshake header to proxy and to the client in `PKEY` command.
+
+Encrypted transmission should use the received session ID from the connection between proxy server and destination server in the authorized body.
+
+```abnf
+proxyCommand = %s"PFWD" SP smpVersion commandKey <encrypted padded(transmission, 16242)>
+smpVersion = 2*2 OCTET
+commandKey = length x509encoded
+```
+
+The proxy server will forward the encrypted transmission in `RFWD` command (see below).
+
+Having received the `RRES` response from the destination server, proxy server will forward `PRES` response to the client. `PRES` response should use the same correlation ID as `PFWD` command. The destination server will use this correlation ID increased by 1 as a nonce for encryption of the response.
+
+```abnf
+proxyResponse = %s"PRES" SP <encrypted padded(forwardedResponse, 16242)>
+```
+
+#### Forward command to destination server
+
+Having received `PFWD` command from the client, the server should additionally encrypt it (without padding, as the received transmission is already encrypted by the client and padded to a fixed size) together with the correlation ID, sender command key, and protocol version, and forward it to the destination server as `RFWD` command:
+
+Transmission forwarded to relay uses empty entity ID and its unique random correlation ID is used as a nonce to encrypt forwarded transmission. Correlation ID increased by 1 is used by the destination server as a nonce to encrypt responses.
+
+```abnf
+relayCommand = %s"RFWD" SP <encrypted(forwardedTransmission)>
+forwardedTransmission = fwdCorrId fwdSmpVersion fwdCommandKey transmission
+fwdCorrId = length 24*24 OCTET
+  ; `fwdCorrId` - correlation ID used in `PFWD` command transmission - it is used as a nonce for client encryption,
+  ; and `fwdCorrId + 1` is used as a nonce for the destination server response encryption.
+fwdSmpVersion = 2*2 OCTET
+fwdCommandKey = length x509encoded
+transmission = *OCTET ; note that it is not prefixed with the length
+```
+
+The destination server having received this command decrypts both encryption layers (proxy and client), verifies client authorization as usual, processes it, and send the double encrypted `RRES` response to proxy.
+
+The shared secret for encrypting transmission bodies between proxy server and destination server is agreed from proxy and destination server keys exchanged in handshake headers - proxy and server use the same shared secret during the session for the encryption between them.
+
+
+```abnf
+relayResponse = %s"RRES" SP <encrypted(responseTransmission)>
+```
+
 ### Notifier commands
 
 #### Subscribe to queue notifications
@@ -735,45 +1017,40 @@ The first message notification will be delivered either immediately or as soon a
 
 ### Server messages
 
-#### Queue IDs response
+This section includes server events and generic command responses used for several commands.
 
-Server must respond with this message when the new queue is created.
-
-See its syntax in [Create queue command](#create-queue-command)
+The syntax for command-specific responses is shown together with the commands.
 
 #### Deliver queue message
 
-The server must deliver messages to all subscribed simplex queues on the currently open transport connection. The syntax for the message delivery is:
-
-```abnf
-message = %s"MSG " msgId encryptedRcvMsgBody
-encryptedMsgBody = <encrypt paddedSentMsgBody> ; server-encrypted padded sent msgBody
-paddedSentMsgBody = <padded(sentMsgBody, maxMessageLength + 2)> ; maxMessageLength = 16088
-encryptedRcvMsgBody = <encrypt rcvMsgBody> ; server-encrypted meta-data and padded sent msgBody
-rcvMsgBody = timestamp msgFlags SP paddedSentMsgBody
-msgId = length 24*24OCTET
-timestamp = 8*8OCTET
-```
-
-`msgId` - unique message ID generated by the server based on cryptographically strong random bytes. It should be used by the clients to detect messages that were delivered more than once (in case the transport connection was interrupted and the server did not receive the message delivery acknowledgement). Message ID is used as a nonce for server/recipient encryption of message bodies.
-
-`timestamp` - system time when the server received the message from the sender as **a number of seconds** since Unix epoch (1970-01-01) encoded as 64-bit integer in network byte order. If a client system/language does not support 64-bit integers, until 2106 it is safe to simply skip the first 4 zero bytes and decode 32-bit unsigned integer (or as signed integer until 2038).
-
-`paddedSentMsgBody` - see syntax in [Send message](#send-message)
-
 When server delivers the messages to the recipient, message body should be encrypted with the secret derived from DH exchange using the keys passed during the queue creation and returned with `queueIds` response.
 
 This is done to prevent the possibility of correlation of incoming and outgoing traffic of SMP server inside transport protocol.
 
-#### Notifier queue ID response
+The server must deliver messages to all subscribed simplex queues on the currently open transport connection. The syntax for the message delivery is:
 
-Server must respond with this message when queue notifications are enabled.
+```abnf
+message = %s"MSG" SP msgId encryptedRcvMsgBody
+encryptedRcvMsgBody = <encrypt padded(rcvMsgBody, maxMessageLength + 2)>
+  ; server-encrypted padded sent msgBody
+  ; maxMessageLength = 16064
+rcvMsgBody = timestamp msgFlags SP sentMsgBody / msgQuotaExceeded
+msgQuotaExceeded = %s"QUOTA" SP timestamp
+msgId = length 24*24OCTET
+timestamp = 8*8OCTET
+```
 
-See its syntax in [Enable notifications command](#enable-notifications-command)
+If the sender exceeded queue capacity the recipient will receive a special message indicating the quota was exceeded. This can be used in the higher level protocol to notify sender client that it can continue sending messages.
+
+`msgId` - unique message ID generated by the server based on cryptographically strong random bytes. It should be used by the clients to detect messages that were delivered more than once (in case the transport connection was interrupted and the server did not receive the message delivery acknowledgement). Message ID is used as a nonce for server/recipient encryption of message bodies.
+
+`timestamp` - system time when the server received the message from the sender as **a number of seconds** since Unix epoch (1970-01-01) encoded as 64-bit integer in network byte order. If a client system/language does not support 64-bit integers, until 2106 it is safe to simply skip the first 4 zero bytes and decode 32-bit unsigned integer (or as signed integer until 2038).
+
+`sentMsgBody` - message sent by `SEND` command. See [Send message](#send-message).
 
 #### Deliver message notification
 
-The server must deliver message notifications to all simplex queues that were subscribed with `subscribeNotifications` command ("NSUB") on the currently open transport connection. The syntax for the message notification delivery is:
+The server must deliver message notifications to all simplex queues that were subscribed with `subscribeNotifications` command (`NSUB`) on the currently open transport connection. The syntax for the message notification delivery is:
 
 ```abnf
 messageNotification = %s"NMSG " nmsgNonce encryptedNMsgMeta
@@ -802,28 +1079,60 @@ No further messages should be delivered to unsubscribed transport connection.
 
 #### Error responses
 
-- incorrect block format, encoding or signature size (`BLOCK`).
+- incorrect block format, encoding or authorization size (`BLOCK`).
 - missing or different session ID - tls-unique binding of TLS transport (`SESSION`)
 - command errors (`CMD`):
-  - error parsing command (`SYNTAX`)
-  - prohibited command (`PROHIBITED`) - any server response sent from client or `ACK` sent without active subscription or without message delivery.
-  - transmission has no required signature or queue ID (`NO_AUTH`)
+  - unknown command (`UNKNOWN`).
+  - error parsing command (`SYNTAX`).
+  - prohibited command (`PROHIBITED`):
+    - `ACK` sent without active subscription or without message delivery.
+    - `GET` and `SUB` used in the same transport connection with the same queue.
+  - transmission has no required authorization or queue ID (`NO_AUTH`)
   - transmission has unexpected credentials (`HAS_AUTH`)
-  - transmission has no required queue ID (`NO_QUEUE`)
-- authentication error (`AUTH`) - incorrect signature, unknown (or suspended) queue, sender's ID is used in place of recipient's and vice versa, and some other cases (see [Send message](#send-message) command).
+  - transmission has no required queue ID (`NO_ENTITY`)
+- proxy server errors (`PROXY`):
+  - `PROTOCOL` - any error.
+  - `BASIC_AUTH` - incorrect basic auth.
+  - `NO_SESSION` - no destination server session with passed ID.
+  - `BROKER` - destination server error:
+    - `RESPONSE` - invalid server response (failed to parse).
+    - `UNEXPECTED` - unexpected response.
+    - `NETWORK` - network error.
+    - `TIMEOUT` - command response timeout.
+    - `HOST` - no compatible server host (e.g. onion when public is required, or vice versa)
+    - `TRANSPORT` - handshake or other transport error:
+      - `BLOCK` - error parsing transport block.
+      - `VERSION` - incompatible client or server version.
+      - `LARGE_MSG` - message too large.
+      - `SESSION` - incorrect session ID.
+      - `NO_AUTH` - absent server key - when the server did not provide a DH key to authorize commands for the queue that should be authorized with a DH key.
+      - `HANDSHAKE` - transport handshake error:
+        - `PARSE` - handshake syntax (parsing) error.
+        - `IDENTITY` - incorrect server identity (certificate fingerprint does not match server address).
+        - `BAD_AUTH` - incorrect or missing server credentials in handshake.
+- authentication error (`AUTH`) - incorrect authorization, unknown (or suspended) queue, sender's ID is used in place of recipient's and vice versa, and some other cases (see [Send message](#send-message) command).
 - message queue quota exceeded error (`QUOTA`) - too many messages were sent to the message queue. Further messages can only be sent after the recipient retrieves the messages.
-- sent message is too large (> 16088) to be delivered (`LARGE_MSG`).
+- sent message is too large (> 16064) to be delivered (`LARGE_MSG`).
 - internal server error (`INTERNAL`).
 
 The syntax for error responses:
 
 ```abnf
 error = %s"ERR " errorType
-errorType = %s"BLOCK" / %s"SESSION" / %s"CMD " cmdError / %s"AUTH" / %s"LARGE_MSG" /%s"INTERNAL"
+errorType = %s"BLOCK" / %s"SESSION" / %s"CMD" SP cmdError / %s"PROXY" proxyError /
+            %s"AUTH" / %s"QUOTA" / %s"LARGE_MSG" / %s"INTERNAL"
 cmdError = %s"SYNTAX" / %s"PROHIBITED" / %s"NO_AUTH" / %s"HAS_AUTH" / %s"NO_ENTITY"
+proxyError = %s"PROTOCOL" SP errorType / %s"BROKER" SP brokerError /
+             %s"BASIC_AUTH" / %s"NO_SESSION"
+brokerError = %s"RESPONSE" SP shortString / %s"UNEXPECTED" SP shortString /
+              %s"NETWORK" / %s"TIMEOUT" / %s"HOST" /
+              %s"TRANSPORT" SP transportError
+transportError = %s"BLOCK" / %s"VERSION" / %s"LARGE_MSG" / %s"SESSION" / %s"NO_AUTH" /
+                 %s"HANDSHAKE" SP handshakeError
+handshakeError = %s"PARSE" / %s"IDENTITY" / %s"BAD_AUTH"
 ```
 
-Server implementations must aim to respond within the same time for each command in all cases when `"ERR AUTH"` response is required to prevent timing attacks (e.g., the server should perform signature verification even when the queue does not exist on the server or the signature of different size is sent, using any RSA key with the same size as the signature size).
+Server implementations must aim to respond within the same time for each command in all cases when `"ERR AUTH"` response is required to prevent timing attacks (e.g., the server should verify authorization even when the queue does not exist on the server or the authorization of different type is sent, using any dummy key compatible with the used authorization).
 
 ### OK response
 
@@ -833,22 +1142,12 @@ When the command is successfully executed by the server, it should respond with
 ok = %s"OK"
 ```
 
-## Appendices
+## Transport connection with the SMP server
 
-### Appendix A.
-
-**SMP transport protocol.**
+### General transport protocol considerations
 
 Both the recipient and the sender can use TCP or some other, possibly higher level, transport protocol to communicate with the server. The default TCP port for SMP server is 5223.
 
-For scenarios when meta-data privacy is critical, it is recommended that clients:
-
-- communicating over Tor network,
-- establish a separate connection for each SMP queue,
-- send noise traffic (using PING command).
-
-In addition to that, the servers can be deployed as Tor onion services.
-
 The transport protocol should provide the following:
 
 - server authentication (by matching server certificate hash with `serverIdentity`),
@@ -856,40 +1155,110 @@ The transport protocol should provide the following:
 - integrity (preventing data modification by the attacker without detection),
 - unique channel binding (`sessionIdentifier`) to include in the signed part of SMP transmissions.
 
-By default, the client and server communicate using [TLS 1.3 protocol][13] restricted to:
+### TLS transport encryption
+
+The client and server communicate using [TLS 1.3 protocol][13] restricted to:
 
 - TLS_CHACHA20_POLY1305_SHA256 cipher suite (for better performance on mobile devices),
-- ed25519 and ed448 EdDSA algorithms for signatures,
-- x25519 and x448 ECDHE groups for key exchange.
-- servers must send the chain of exactly 2 self-signed certificates in the handshake, with the first (offline) certificate one signing the second (online) certificate. Offline certificate fingerprint is used as a server identity - it is a part of SMP server address.
+- ed25519 EdDSA algorithms for signatures,
+- x25519 ECDHE groups for key exchange.
+- servers must send the chain of 2, 3 or 4 self-signed certificates in the handshake (see [Server certificate](#server-certificate)), with the first (offline) certificate one signing the second (online) certificate. Offline certificate fingerprint is used as a server identity - it is a part of SMP server address.
 - The clients must abort the connection in case a different number of certificates is sent.
 - server and client TLS configuration should not allow resuming the sessions.
 
 During TLS handshake the client must validate that the fingerprint of the online server certificate is equal to the `serverIdentity` the client received as part of SMP server address; if the server identity does not match the client must abort the connection.
 
+### Server certificate
+
+Servers use self-signed certificates that the clients validate by comparing the fingerprint of one of the certificates in the chain with the certificate fingerprint present in the server address.
+
+Clients SHOULD support the chains of 2, 3 and 4 server certificates:
+
+**2 certificates**:
+1. offline server certificate:
+   - its fingerprint is present in the server address.
+   - its private key is not stored on the server.
+2. online server certificate:
+   - it must be signed by offline certificate.
+   - its private key is stored on the server and is used in TLS session.
+
+**3 certificates**:
+1. offline server certificate - same as with 2 certificates.
+2. online server certificate:
+   - it must be signed by offline certificate.
+   - its private key is stored on the server.
+3. session certificate:
+   - generated automatically on every server start and/or on schedule.
+   - signed by online server certificate.
+   - its private key is used in TLS session.
+
+**4 certificates**:
+0. offline operator identity certificate:
+   - used for all servers operated by the same entity.
+   - its private key is not stored on the server.
+1. offline server certificate:
+   - signed by offline operator certificate.
+   - same as with 2 certificates.
+2. online server certificate - same as with 3 certificates.
+3. session certificate - same as with 3 certificates.
+
+### ALPN to agree handshake version
+
+Client and server use [ALPN extension][18] of TLS to agree handshake version.
+
+Server SHOULD send `smp/1` protocol name and the client should confirm this name in order to use the current protocol version. This is added to allow support of older clients without breaking backward compatibility and to extend or modify handshake syntax.
+
+If the client does not confirm this protocol name, the server would fall back to v6 of SMP protocol.
+
+### Transport handshake
+
 Once TLS handshake is complete, client and server will exchange blocks of fixed size (16384 bytes).
 
-The first block sent by the server should be `serverHello` and the client should respond with `clientHello` - these blocks are used to agree SMP protocol version:
+The first block sent by the server should be `paddedServerHello` and the client should respond with `paddedClientHello` - these blocks are used to agree SMP protocol version:
 
 ```abnf
-serverHello = minSmpVersion maxSmpVersion sessionIdentifier pad
+paddedServerHello = <padded(serverHello, 16384)>
+serverHello = smpVersionRange sessionIdentifier [serverCert signedServerKey] ignoredPart
+smpVersionRange = minSmpVersion maxSmpVersion
 minSmpVersion = smpVersion
 maxSmpVersion = smpVersion
-sessionIdentifier = length *OCTET
+sessionIdentifier = shortString
 ; unique session identifier derived from transport connection handshake
-; it should be included in all SMP transmissions sent in this transport connection.
+; it should be included in authorized part of all SMP transmissions sent in this transport connection,
+; but it must not be sent as part of the transmission in the current protocol version.
+serverCert = originalLength x509encoded
+signedServerKey = originalLength x509encoded ; signed by server certificate
 
-clientHello = smpVersion pad
+paddedClientHello = <padded(clientHello, 16384)>
+clientHello = smpVersion [clientKey] ignoredPart
 ; chosen SMP protocol version - it must be the maximum supported version
 ; within the range offered by the server
+clientKey = length x509encoded
 
 smpVersion = 2*2OCTET ; Word16 version number
-
+originalLength = 2*2OCTET
+ignoredPart = *OCTET
 pad = *OCTET
 ```
 
+`signedServerKey` is used to compute a shared secret to authorize client transmission - it is combined with the per-queue key that was used when the queue was created.
+
+`clientKey` is used only by SMP proxy server when it connects to the destination server to agree shared secret for the additional encryption layer, end user clients do not use this key.
+
+`ignoredPart` in handshake allows to add additional parameters in handshake without changing protocol version - the client and servers must ignore any extra bytes within the original block length.
+
 For TLS transport client should assert that `sessionIdentifier` is equal to `tls-unique` channel binding defined in [RFC 5929][14] (TLS Finished message struct); we pass it in `serverHello` block to allow communication over some other transport protocol (possibly, with another channel binding).
 
+### Additional transport privacy
+
+For scenarios when meta-data privacy is critical, it is recommended that clients:
+
+- communicating over Tor network,
+- establish a separate connection for each SMP queue,
+- send noise traffic (using PING command).
+
+In addition to that, the servers can be deployed as Tor onion services.
+
 [1]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack
 [2]: https://en.wikipedia.org/wiki/End-to-end_encryption
 [3]: https://en.wikipedia.org/wiki/QR_code
@@ -906,3 +1275,5 @@ For TLS transport client should assert that `sessionIdentifier` is equal to `tls
 [14]: https://datatracker.ietf.org/doc/html/rfc5929#section-3
 [15]: https://www.rfc-editor.org/rfc/rfc8709.html
 [16]: https://nacl.cr.yp.to/box.html
+[17]: https://datatracker.ietf.org/doc/html/rfc8927
+[18]: https://datatracker.ietf.org/doc/html/rfc7301
diff --git a/protocol/xftp.md b/protocol/xftp.md
new file mode 100644
index 000000000..d6d271837
--- /dev/null
+++ b/protocol/xftp.md
@@ -0,0 +1,632 @@
+Version 2, 2024-06-22
+
+# SimpleX File Transfer Protocol
+
+## Table of contents
+
+- [Abstract](#abstract)
+- [Introduction](#introduction)
+- [XFTP Model](#xftp-model)
+- [Persistence model](#persistence-model)
+- [XFTP procedure](#xftp-procedure)
+- [File description](#file-description)
+- [URIs syntax](#uris-syntax)
+  - [XFTP server URI](#xftp-server-uri)
+  - [File description URI](#file-description-URI)
+- [XFTP qualities and features](#xftp-qualities-and-features)
+- [Cryptographic algorithms](#cryptographic-algorithms)
+- [File chunk IDs](#file-chunk-ids)
+- [Server security requirements](#server-security-requirements)
+- [Transport protocol](#transport-protocol)
+  - [TLS ALPN](#tls-alpn)
+  - [Connection handshake](#connection-handshake)
+  - [Requests and responses](#requests-and-responses)
+- [XFTP commands](#xftp-commands)
+  - [Correlating responses with commands](#correlating-responses-with-commands)
+  - [Command authentication](#command-authentication)
+  - [Keep-alive command](#keep-alive-command)
+  - [File sender commands](#file-sender-commands)
+    - [Register new file chunk](#register-new-file-chunk)
+    - [Add file chunk recipients](#add-file-chunk-recipients)
+    - [Upload file chunk](#upload-file-chunk)
+    - [Delete file chunk](#delete-file-chunk)
+  - [File recipient commands](#file-recipient-commands)
+    - [Download file chunk](#download-file-chunk)
+    - [Acknowledge file chunk download](#acknowledge-file-chunk-download)
+- [Threat model](#threat-model)
+
+## Abstract
+
+SimpleX File Transfer Protocol is a client-server protocol for asynchronous unidirectional file transmission.
+
+It's designed with the focus on communication security, integrity and meta-data privacy, under the assumption that any part of the message transmission network can be compromised.
+
+It is designed as a application level protocol to solve the problem of secure and private file transmission, making [MITM attacks][1] very difficult at any part of the file transmission system, and preserving meta-data privacy of the sent files.
+
+## Introduction
+
+The objective of SimpleX File Transfer Protocol (XFTP) is to facilitate the secure and private unidirectional transfer of files from senders to recipients via persistent file chunks stored by the xftp server.
+
+XFTP is implemented as an application level protocol on top of HTTP2 and TLS.
+
+The protocol describes the set of commands that senders and recipients can send to XFTP servers to create, upload, download and delete file chunks of several pre-defined sizes. XFTP servers SHOULD support chunks of 4 sizes: 64KB, 256KB, 1MB and 4MB (1KB = 1024 bytes, 1MB = 1024KB).
+
+The protocol is designed with the focus on meta-data privacy and security. While using TLS, the protocol does not rely on TLS security by using additional encryption to achieve that there are no identifiers or ciphertext in common in received and sent server traffic, frustrating traffic correlation even if TLS is compromised.
+
+XFTP does not use any form of participants' identities. It relies on out-of-band passing of "file description" - a human-readable YAML document with the list of file chunk locations, hashes and necessary cryptographic keys.
+
+## XFTP Model
+
+The XFTP model has three communication participants: the recipient, the file server (XFTP server) that is chosen and, possibly, controlled by the sender, and the sender.
+
+XFTP server allows uploading fixed size file chunks, with or without basic authentication. The same party that can be the sender of one file chunk can be the recipient of another, without exposing it to the server.
+
+Each file chunk allows multiple recipients, each recipient can download the same chunk multiple times. It allows depending on the threat model use the same recipient credentials for multiple parties, thus reducing server ability to understand the number of intended recipients (but server can still track IP addresses to determine it), or use one unique set of credentials for each recipient, frustrating traffic correlation on the assumption of compromised TLS. In the latter case, senders can create a larger number of recipient credentials to hide the actual number of intended recipients from the servers (which is what SimpleX clients do).
+
+```
+           Sender                      Internet                XFTP relays             Internet         Recipient
+----------------------------   |   -----------------   |   -------------------   |   ------------   |   ---------- 
+                               |                       |                         |                  |
+                               |                       |   (can be self-hosted)  |                  |
+                               |                       |        +---------+      |                  |
+                  chunk 1     ----- HTTP2 over TLS ------       |  XFTP   |     ---- HTTP2 / TLS -----   chunk 1
+                |---> SimpleX File Transfer Protocol (XFTP) --> |  Relay  | --->        XFTP         ------------->|
+                |             ---------------------------       +---------+     ----------------------             |
+                |              |                       |                         |                  |              | 
+                |              |                       |                         |                  |              v
+          +----------+         |                       |        +---------+      |                  |        +-------------+
+          | Sending  | ch. 2  ------- HTTP2 / TLS -------       |  XFTP   |     ---- HTTP2 / TLS ----  ch. 2 |  Receiving  |
+file ---> |   XFTP   | ------>           XFTP            ---->  |  Relay  | --->        XFTP         ------> |     XFTP    | ---> file
+          |  Client  |        ---------------------------       +---------+     ----------------------       |    Client   |
+          +----------+         |                       |                         |                  |        +-------------+
+                |              |                       |                         |                  |              ^
+                |              |                       |        +---------+      |                  |              |
+                |             ------- HTTP2 / TLS -------       |  XFTP   |     ---- HTTP2 / TLS ----              |
+                |------------->           XFTP           ---->  |  Relay  | --->        XFTP         ------------->|
+                   chunk N    ---------------------------       +---------+     ---------------------    chunk N
+                               |                       |   (store file chunks)   |                  |
+                               |                       |                         |                  |
+                               |                       |                         |                  |
+```
+
+When sender client uploads a file chunk, it has to register it first with one sender ID and multiple recipient IDs, and one random unique key per ID to authenticate sender and recipients, and also provide its size and hash that will be validated when chunk is uploaded.
+
+To send the actual file, the sender client MUST pad it and encrypt it with a random symmetric key and distribute chunks of fixed sized across multiple XFTP servers. Information about chunk locations, keys, hashes and required keys is passed to the recipients as "[file description](#file-description)" out-of-band.
+
+Creating, uploading, downloading and deleting file chunks requires sending commands to the XFTP server - they are described in detail in [XFTP commands](#xftp-commands) section.
+
+## Persistence model
+
+Server stores file chunk records in memory, with optional adding to append-only log, to allow restoring them on server restart. File chunk bodies can be stored as files or as objects in any object store (e.g. S3).
+
+## XFTP procedure
+
+1. Sending the file.
+
+To send the file, the sender will:
+
+1) Prepare file
+  - compute its SHA512 digest.
+  - prepend header with the name and pad the file to match the whole number of chunks in size. It is RECOMMENDED to use 2 of 4 allowed chunk sizes, to balance upload size and metadata privacy.
+  - encrypt it with a randomly chosen symmetric key and IV (e.g., using NaCL secret_box).
+  - split into allowed size chunks.
+  - generate per-recipient keys. It is recommended that the sending client generates more per-recipient keys than the actual number of recipients, rounding up to a power of 2, to conceal the actual number of intended recipients.
+
+2) Upload file chunks
+  - register each chunk record with randomly chosen one or more (for redundancy) XFTP server(s).
+  - optionally request additional recipient IDs, if required number of recipient keys didn't fit into register request.
+  - upload each chunk to chosen server(s).
+
+3) Prepare file descriptions, one per recipient.
+
+The sending client combines addresses of all chunks and other information into "file description", different for each file recipient, that will include:
+
+- an encryption key used to encrypt/decrypt the full file (the same for all recipients).
+- file SHA512 digest to validate download.
+- list of chunk descriptions; information for each chunk:
+  - private Ed25519 key to sign commands for file transfer server.
+  - chunk address (server host and chunk ID).
+  - chunk sha512 digest.
+
+To reduce the size of file description, chunks are grouped by the server host.
+
+4) Send file description(s) to the recipient(s) out-of-band, via pre-existing secure and authenticated channel. E.g., SimpleX clients send it as messages via SMP protocol, but it can be done via any other channel.
+
+![Sending file](./diagrams/xftp/xftp-sending-file.svg)
+
+2. Receiving the file.
+
+Having received the description, the recipient will:
+
+1) Download all chunks.
+
+The receiving client can fall back to secondary servers, if necessary:
+- if the server is not available.
+- if the chunk is not present on the server (ERR AUTH response).
+- if the hash of the downloaded file chunk does not match the description.
+
+Optionally recipient can acknowledge file chunk reception to delete file ID from server for this recipient.
+
+2) Combine the chunks into a file.
+
+3) Decrypt the file using the key in file description.
+
+4) Extract file name and unpad the file.
+
+5) Validate file digest with the file description.
+
+![Receiving file](./diagrams/xftp/xftp-receiving-file.svg)
+
+## File description
+
+"File description" is a human-readable YAML document that is sent via secure and authenticated channel.
+
+It includes these fields:
+- `party` - "sender" or "recipient". Sender's file description is required to delete the file.
+- `size` - padded file size equal to total size of all chunks, see `fileSize` syntax below.
+- `digest` - SHA512 hash of encrypted file, base64url encoded string.
+- `key` - symmetric encryption key to decrypt the file, base64url encoded string.
+- `nonce` - nonce to decrypt the file, base64url encoded string.
+- `chunkSize` - default chunk size, see `fileSize` syntax below.
+- `replicas` - the array of file chunk replicas descriptions.
+- `redirect` - optional property for redirect information indicating that the file is itself a description to another file, allowing to use file description as a short URI.
+
+Each replica description is an object with 2 fields:
+
+- `chunks` - and array of chunk replica descriptions stored on one server.
+- `server` - [server address](#xftp-server-uri) where the chunks can be downloaded from.
+
+Each server replica description is a string with this syntax:
+
+```abnf
+chunkReplica = chunkNo ":" replicaId ":" replicaKey [":" chunkDigest [":" chunkSize]]
+chunkNo = 1*DIGIT
+  ; a sequential 1-based chunk number in the original file.
+replicaId = base64url
+  ; server-assigned random chunk replica ID.
+replicaKey = base64url
+  ; sender-generated random key to receive (or to delete, in case of sender's file description) the chunk replica.
+chunkDigest = base64url
+  ; chunk digest that MUST be specified for the first replica of each chunk,
+  ; and SHOULD be omitted (or be the same) on the subsequent replicas
+chunkSize = fileSize
+fileSize = sizeInBytes / sizeInUnits
+  ; chunk size SHOULD only be specified on the first replica and only if it is different from default chunk size
+sizeInBytes = 1*DIGIT
+sizeInUnits = 1*DIGIT sizeUnit
+sizeUnit = %s"kb" / %s"mb" / %s"gb"
+base64url = <base64url encoded binary> ; RFC4648, section 5
+```
+
+Optional redirect information has two fields:
+- `size` - the size of the original encrypted file to which file description downloaded via the current file description will lead to, see `fileSize` syntax below.
+- `digest` - SHA512 hash of the original file, base64url encoded string.
+
+## URIs syntax
+
+### XFTP server URI
+
+The XFTP server address is a URI with the following syntax:
+
+```abnf
+xftpServerURI = %s"xftp://" xftpServer
+xftpServer = serverIdentity [":" basicAuth] "@" srvHost [":" port]
+srvHost = <hostname> ; RFC1123, RFC5891
+port = 1*DIGIT
+serverIdentity = base64url
+basicAuth = base64url
+```
+
+### File description URI
+
+This file description URI can be generated by the client application to share a small file description as a QR code or as a link. Practically, to be able to scan a QR code it should be under 1000 characters, so only file descriptions with 1-2 chunks can be used in this case. This is supported with `redirect` property when file description leads to a file which in itself is a larger file description to another file - akin to URL shortener.
+
+File description URI syntax:
+
+```abnf
+fileDescriptionURI = serviceScheme "/file"  "#/?desc=" description [ "&data=" userData ]
+serviceScheme = (%s"https://" clientAppServer) | %s"simplex:"
+clientAppServer = hostname [ ":" port ]
+; client app server, e.g. simplex.chat
+description = <URI-escaped YAML file description>
+userData = <any URI-compatible string>
+```
+
+clientAppServer is not a server the client connects to - it is a server that shows the instruction on how to download the client app that will connect using this connection request. This server can also host a mobile or desktop app manifest so that this link is opened directly in the app if it is installed on the device.
+
+"simplex" URI scheme in serviceScheme can be used instead of client app server. Client apps MUST support this URI scheme.
+
+## XFTP qualities and features
+
+XFTP stands for SimpleX File Transfer Protocol. Its design is based on the same ideas and has some of the qualities of SimpleX Messaging Protocol:
+
+- recipient cannot see sender's IP address, as the file fragments (chunks) are temporarily stored on multiple XFTP relays.
+- file can be sent asynchronously, without requiring the sender to be online for file to be received.
+- there is no network of peers that can observe this transfer - sender chooses which XFTP relays to use, and can self-host their own.
+- XFTP relays do not have any file metadata - they only see individual chunks, with access to each chunk authorized with anonymous credentials (using Edwards curve cryptographic signature) that are random per chunk.
+- chunks have one of the sizes allowed by the servers - 64KB, 256KB, 1MB and 4MB chunks, so sending a large file looks indistinguishable from sending many small files to XFTP server. If the same transport connection is reused, server would only know that chunks are sent by the same user.
+- each chunk can be downloaded by multiple recipients, but each recipient uses their own key and chunk ID to authorize access, and the chunk is encrypted by a different key agreed via ephemeral DH keys (NaCl crypto_box (SalsaX20Poly1305 authenticated encryption scheme ) with shared secret derived from Curve25519 key exchange) on the way from the server to each recipient. XFTP protocol as a result has the same quality as SMP protocol - there are no identifiers and ciphertext in common between sent and received traffic inside TLS connection, so even if TLS is compromised, it complicates traffic correlation attacks.
+- XFTP protocol supports redundancy - each file chunk can be sent via multiple relays, and the recipient can choose the one that is available. Current implementation of XFTP protocol in SimpleX Chat does not support redundancy though.
+- the file as a whole is encrypted with a random symmetric key using NaCl secret_box.
+
+## Cryptographic algorithms
+
+Clients must cryptographically authorize XFTP commands, see [Command authentication](#command-authentication).
+
+To authorize/verify transmissions clients and servers MUST use either signature algorithm Ed25519 algorithm defined in RFC8709 or using deniable authentication scheme based on NaCL crypto_box (see Simplex Messaging Protocol).
+
+To encrypt/decrypt file chunk bodies delivered to the recipients, servers/clients MUST use NaCL crypto_box.
+
+Clients MUST encrypt file chunk bodies sent via XFTP servers using use NaCL crypto_box.
+
+## File chunk IDs
+
+XFTP servers MUST generate a separate new set of IDs for each new chunk - for the sender (that uploads the chunk) and for each intended recipient. It is REQUIRED that:
+
+- These IDs are different and unique within the server.
+- Based on random bytes generated with cryptographically strong pseudo-random number generator.
+
+## Server security requirements
+
+XFTP server implementations MUST NOT create, store or send to any other servers:
+
+- Logs of the client commands and transport connections in the production environment.
+
+- History of retrieved files.
+
+- Snapshots of the database they use to store file chunks (instead clients can manage redundancy by creating chunk replicas using more than one XFTP server). In-memory persistence is recommended for file chunks records.
+
+- Any other information that may compromise privacy or [forward secrecy][4] of communication between clients using XFTP servers.
+
+## Transport protocol
+
+- binary-encoded commands sent as fixed-size padded block in the body of HTTP2 POST request, similar to SMP and notifications server protocol transmission encodings.
+- HTTP2 POST with a fixed size padded block body for file upload and download.
+
+Block size - 4096 bytes (it would fit ~120 Ed25519 recipient keys).
+
+The reasons to use HTTP2:
+
+- avoid the need to have two hostnames (or two different ports) for commands and file uploads.
+- compatibility with the existing HTTP2 client libraries.
+
+The reason not to use JSON bodies:
+
+- bigger request size, so fewer recipient keys would fit in a single request
+- signature over command has to be outside of JSON anyway.
+
+The reason not to use URI segments / HTTP verbs / REST semantics is to have consistent request size.
+
+### ALPN to agree handshake version
+
+Client and server use [ALPN extension][18] of TLS to agree handshake version.
+
+Server SHOULD send `xftp/1` protocol name and the client should confirm this name in order to use the current protocol version. This is added to allow support of older clients without breaking backward compatibility and to extend or modify handshake syntax.
+
+If the client does not confirm this protocol name, the server would fall back to v1 of XFTP protocol.
+
+### Transport handshake
+
+When a client and a server agree on handshake version using ALPN extension, they should proceed with XFTP handshake.
+
+As with SMP, a client doesn't reveal its version range to avoid version fingerprinting. Unlike SMP, XFTP runs a HTTP2 protocol over TLS and the server can't just send its handshake right away. So a session handshake is driven by client-sent requests:
+
+1. To pass initiative to the server, the client sends a request with empty body.
+2. Server responds with its `paddedServerHello` block.
+3. Clients sends a request containing `paddedClientHello` block,
+4. Server sends an empty response, finalizing the handshake.
+
+Once TLS handshake is complete, client and server will exchange blocks of fixed size (16384 bytes).
+
+```abnf
+paddedServerHello = <padded(serverHello, 16384)>
+serverHello = xftpVersionRange sessionIdentifier serverCert signedServerKey ignoredPart
+xftpVersionRange = minXftpVersion maxXftpVersion
+minXftpVersion = xftpVersion
+maxXftpVersion = xftpVersion
+sessionIdentifier = shortString
+; unique session identifier derived from transport connection handshake
+serverCert = originalLength <x509encoded>
+signedServerKey = originalLength <x509encoded> ; signed by server certificate
+
+paddedClientHello = <padded(clientHello, 16384)>
+clientHello = xftpVersion keyHash ignoredPart
+; chosen XFTP protocol version - must be the maximum supported version
+; within the range offered by the server
+
+xftpVersion = 2*2OCTET ; Word16 version number
+keyHash = shortString
+shortString = length length*OCTET
+length = 1*1OCTET
+originalLength = 2*2OCTET
+ignoredPart = *OCTET
+```
+
+In XFTP v2 the handshake is only used for version negotiation, but `serverCert` and `signedServerKey` must be validated by the client.
+
+`keyHash` is the CA fingerprint used by client to validate TLS certificate chain and is checked by a server against its own key.
+
+`ignoredPart` in handshake allows to add additional parameters in handshake without changing protocol version - the client and servers must ignore any extra bytes within the original block length.
+
+For TLS transport client should assert that `sessionIdentifier` is equal to `tls-unique` channel binding defined in [RFC 5929][14] (TLS Finished message struct); we pass it in `serverHello` block to allow communication over some other transport protocol (possibly, with another channel binding).
+
+### Requests and responses
+
+- File sender:
+  - create file chunk record.
+    - Parameters:
+      - Ed25519 key for subsequent sender commands and Ed25519 keys for commands of each recipient.
+      - chunk size.
+    - Response:
+      - chunk ID for the sender and different IDs for all recipients.
+  - add recipients to file chunk
+    - Parameters:
+      - sender's chunk ID
+      - Ed25519 keys for commands of each recipient.
+    - Response:
+      - chunk IDs for new recipients.
+  - upload file chunk.
+  - delete file chunk (invalidates all recipient IDs).
+- File recipient:
+  - download file chunk:
+    - chunk ID
+    - DH key for additional encryption of the chunk.
+    - command should be signed with the key passed by the sender when creating chunk record.
+  - delete file chunk ID (only for one recipient): signed with the same key.
+
+## XFTP commands
+
+Commands syntax below is provided using ABNF with case-sensitive strings extension.
+
+```abnf
+xftpCommand = ping / senderCommand / recipientCmd / serverMsg
+senderCommand = register / add / put / delete
+recipientCmd = get / ack
+serverMsg = pong / sndIds / rcvIds / ok / file
+```
+
+The syntax of specific commands and responses is defined below.
+
+### Correlating responses with commands
+
+Commands are made via HTTP2 requests, responses to commands are correlated as HTTP2 responses.
+
+### Command authentication
+
+XFTP servers must authenticate all transmissions (excluding `ping`) by verifying the client signatures. Command signature should be generated by applying the algorithm specified for the file to the `signed` block of the transmission, using the key associated with the file chunk ID (recipient's or sender's depending on which file chunk ID is used).
+
+### Keep-alive command
+
+To keep the transport connection alive and to generate noise traffic the clients should use `ping` command to which the server responds with `pong` response. This command should be sent unsigned and without file chunk ID.
+
+```abnf
+ping = %s"PING"
+```
+
+This command is always sent unsigned.
+
+  data FileResponse = ... | FRPong | ...
+
+```abnf
+pong = %s"PONG"
+```
+
+### File sender commands
+
+Sending any of the commands in this section (other than `register`, that is sent without file chunk ID) is only allowed with sender's ID.
+
+#### Register new file chunk
+
+This command is sent by the sender to the XFTP server to register a new file chunk.
+
+Servers SHOULD support basic auth with this command, to allow only server owners and trusted users to create file chunks on the servers.
+
+The syntax is:
+
+```abnf
+register = %s"FNEW " fileInfo rcvPublicAuthKeys basicAuth
+fileInfo = sndKey size digest
+sndKey = length x509encoded
+size = 1*DIGIT
+digest = length *OCTET
+rcvPublicAuthKeys = length 1*rcvPublicAuthKey
+rcvPublicAuthKey = length x509encoded
+basicAuth = "0" / "1" length *OCTET
+
+x509encoded = <binary X509 key encoding>
+
+length = 1*1 OCTET
+```
+
+If the file chunk is registered successfully, the server must send `sndIds` response with the sender's and recipients' file chunk IDs:
+
+```abnf
+sndIds = %s"SIDS " senderId recipientIds
+senderId = length *OCTET
+recipientIds = length 1*recipientId
+recipientId = length *OCTET
+```
+
+#### Add file chunk recipients
+
+This command is sent by the sender to the XFTP server to add additional recipient keys to the file chunk record, in case number of keys requested by client didn't fit into `register` command. The syntax is:
+
+```abnf
+add = %s"FADD " rcvPublicAuthKeys
+rcvPublicAuthKeys = length 1*rcvPublicAuthKey
+rcvPublicAuthKey = length x509encoded
+```
+
+If additional keys were added successfully, the server must send `rcvIds` response with the added recipients' file chunk IDs:
+
+```abnf
+rcvIds = %s"RIDS " recipientIds
+recipientIds = length 1*recipientId
+recipientId = length *OCTET
+```
+
+#### Upload file chunk
+
+This command is sent by the sender to the XFTP server to upload file chunk body to server. The syntax is:
+
+```abnf
+put = %s"FPUT"
+```
+
+Chunk body is streamed via HTTP2 request.
+
+If file chunk body was successfully received, the server must send `ok` response.
+
+```abnf
+ok = %s"OK"
+```
+
+#### Delete file chunk
+
+This command is sent by the sender to the XFTP server to delete file chunk from the server. The syntax is:
+
+```abnf
+delete = %s"FDEL"
+```
+
+Server should delete file chunk record, invalidating all recipient IDs, and delete file body from file storage. If file chunk was successfully deleted, the server must send `ok` response.
+
+### File recipient commands
+
+Sending any of the commands in this section is only allowed with recipient's ID.
+
+#### Download file chunk
+
+This command is sent by the recipient to the XFTP server to download file chunk body from the server. The syntax is:
+
+```abnf
+get = %s"FGET " rDhKey
+rDhKey = length x509encoded
+```
+
+If requested file is successfully located, the server must send `file` response. File chunk body is sent as HTTP2 response body.
+
+```abnf
+file = %s"FILE " sDhKey cbNonce
+sDhKey = length x509encoded
+cbNonce = <nonce used in NaCl crypto_box encryption scheme>
+```
+
+Chunk is additionally encrypted on the way from the server to the recipient using a key agreed via ephemeral DH keys `rDhKey` and `sDhKey`, so there is no ciphertext in common between sent and received traffic inside TLS connection, in order to complicate traffic correlation attacks, if TLS is compromised.
+
+#### Acknowledge file chunk download
+
+This command is sent by the recipient to the XFTP server to acknowledge file reception, deleting file ID from server for this recipient. The syntax is:
+
+```abnf
+ack = %s"FACK"
+```
+
+If file recipient ID is successfully deleted, the server must send `ok` response.
+
+In current implementation of XFTP protocol in SimpleX Chat clients don't use FACK command. Files are automatically expired on servers after configured time interval.
+
+## Threat model
+
+#### Global Assumptions
+
+ - A user protects their local database and key material.
+ - The user's application is authentic, and no local malware is running.
+ - The cryptographic primitives in use are not broken.
+ - A user's choice of servers is not directly tied to their identity or otherwise represents distinguishing information about the user.
+
+#### A passive adversary able to monitor the traffic of one user
+
+*can:*
+
+ - identify that and when a user is sending files over XFTP protocol.
+
+ - determine which servers the user sends/receives files to/from.
+
+ - observe how much traffic is being sent, and make guesses as to its purpose.
+
+*cannot:*
+
+ - see who sends files to the user and who the user sends the files to.
+
+#### A passive adversary able to monitor a set of file senders and recipients
+
+ *can:*
+
+ - learn which XFTP servers are used to send and receive files for which users.
+
+ - learn when files are sent and received.
+
+ - perform traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers.
+
+ - observe how much traffic is being sent, and make guesses as to its purpose
+
+*cannot, even in case of a compromised transport protocol:*
+
+ - perform traffic correlation attacks with any increase in efficiency over a non-compromised transport protocol
+
+#### XFTP server
+
+*can:*
+
+- learn when file senders and recipients are online.
+
+- know how many file chunks and chunk sizes are sent via the server.
+
+- perform the correlation of the file chunks as belonging to one file via either a re-used transport connection, user's IP address, or connection timing regularities.
+
+- learn file senders' and recipients' IP addresses, and infer information (e.g. employer) based on the IP addresses, as long as Tor is not used.
+
+- delete file chunks, preventing file delivery, as long as redundant delivery is not used.
+
+- lie about the state of a file chunk to the recipient and/or to the sender  (e.g. deleted when it is not).
+
+- refuse deleting the file when instructed by the sender.
+
+*cannot:*
+
+- undetectably corrupt file chunks.
+
+- learn the contents, name or the exact size of sent files.
+
+- learn approximate size of sent files, as long as more than one server is used to send file chunks.
+
+- compromise the users' end-to-end encryption of files with an active attack.
+
+#### An attacker who obtained Alice's (decrypted) chat database
+
+*can:*
+
+- see the history of all files exchanged by Alice with her communication partners, as long as files were not deleted from the database.
+
+- receive all files sent and received by Alice that did not expire yet, as long as information about these files was not removed from the database.
+
+- prevent Alice's contacts from receiving the files she sent by deleting all or some of the file chunks from XFTP servers.
+
+#### A user's contact
+
+*can:*
+
+- spam the user with files.
+
+- forever retain files from the user.
+
+*cannot:*
+
+- cryptographically prove to a third-party that a file came from a user (assuming the user's device is not seized).
+
+- prove that two contacts they have is the same user.
+
+- cannot collaborate with another of the user's contacts to confirm they are communicating with the same user, even if they receive the same file.
+
+#### An attacker with Internet access
+
+*can:*
+
+- Denial of Service XFTP servers.
+
+*cannot:*
+
+- send files to a user who they are not connected with.
+
+- enumerate file chunks on an XFTP server.
diff --git a/protocol/xrcp.md b/protocol/xrcp.md
new file mode 100644
index 000000000..9f7187e66
--- /dev/null
+++ b/protocol/xrcp.md
@@ -0,0 +1,330 @@
+Version 1, 2024-06-22
+
+# SimpleX Remote Control Protocol
+
+## Table of contents
+
+- [Abstract](#abstract)
+- [XRCP model](#xrcp-model)
+- [Transport protocol](#transport-protocol)
+  - [Session invitation](#session-invitation)
+  - [Establishing TLS connection](#establishing-tls-connection)
+  - [Session verification and protocol negotiation](#session-verification-and-protocol-negotiation)
+  - [Controller/host session operation](#сontrollerhost-session-operation)
+- [Key agreement for announcement packet and for session](#key-agreement-for-announcement-packet-and-for-session)
+- [Threat model](#threat-model)
+
+## Abstract
+
+The SimpleX Remote Control Protocol is a client-server protocol designed to transform application UIs into thin clients, enabling remote control from another device. This approach allows users to remotely access and utilize chat profiles without the complexities of master-master replication for end-to-end encryption states.
+
+Like SMP and XFTP, XRCP leverages out-of-band invitations to mitigate MITM attacks and employs multiple cryptographic layers to safeguard application data.
+
+## XRCP model
+
+XRCP assumes two application roles: host (that contain the application data) and controller that gains limited access to host data.
+Applications are also split into two components: UI and core.
+
+When an XRCP session is established a host UI is locked out and a controller UI uses its core to proxy commands to the host core, getting back responses and events.
+
+```
+
+          +------+              +------+     xrcp     +------+     +------+
+          | Ctrl |   commands   | Ctrl |   commands   | Host |     | Host |
+user ---> |  UI  | -----------> | Core | -----------> | Core |     |  UI  |
+          +------+              +------+              +------+     +------+
+              ^     responses     |  ^  xrcp responses  |  ^
+              |<------------------|  |<-----------------|  |      +-------------+
+              |      events       |                        |      | Application |-+
+              |<------------------|                        |----> |   protocol  | |
+                                                                  |   servers   | |
+                                                                  +-------------+ |
+                                                                   +--------------+
+```
+
+## Transport protocol
+
+Protocol consists of four phases:
+- controller session invitation
+- establishing session TLS connection
+- session verification and protocol negotiation
+- session operation
+
+![Session sequence](./diagrams/xrcp/session.svg)
+
+### Session invitation
+
+The invitation to the first session between host and controller pair MUST be shared out-of-band, to establish a long term identity keys/certificates of the controller to host device.
+
+The subsequent sessions can be announced via an application-defined site-local multicast group, e.g. `224.0.0.251` (also used in mDNS/bonjour) and an application-defined port (SimpleX Chat uses 5227).
+
+The session invitation contains this data:
+- supported version range for remote control protocol.
+- application-specific information, e.g. device name, application name and supported version range, settings, etc.
+- session start time in seconds since epoch.
+- if multicast is used, counter of announce packets sent by controller.
+- network address (ipv4 address and port) of the controller.
+- CA TLS certificate fingerprint of the controller - this is part of long term identity of the controller established during the first session, and repeated in the subsequent session announcements.
+- Session Ed25519 public key used to verify the announcement and commands - this mitigates the compromise of the long term signature key, as the controller will have to sign each command with this key first.
+- Long-term Ed25519 public key used to verify the announcement and commands - this is part of the long term controller identity.
+- Session X25519 DH key and SNTRUP761 KEM encapsulation key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. DH public key and KEM encapsulation key are sent unencrypted. NaCL crypto_box is used for encryption.
+
+Host application decrypts (except the first session) and validates the invitation:
+- Session signature is valid.
+- Timestamp is within some window from the current time.
+- Long-term key signature is valid.
+- Long-term CA and signature key are the same as in the first session.
+- Some version in the offered range is supported.
+
+OOB session invitation is a URI with this syntax:
+
+```abnf
+sessionAddressUri = "xrcp:/" encodedCAFingerprint "@" host ":" port "#/?" qsParams
+encodedCAFingerprint = base64url
+host = <ipv4 or ipv6 address> ; in textual form, RFC4001
+port = 1*DIGIT ; uint16
+qsParams = param *("&" param)
+param = versionRangeParam / appInfoParam / sessionTsParam /
+        sessPubKeyParam / idPubKeyParam / dhPubKeyParam /
+        sessSignatureParam / idSignatureParam
+versionRangeParam = "v=" (versionParam / (versionParam "-" versionParam))
+versionParam = 1*DIGIT
+appInfoParam = "app=" escapedJSON
+sessionTsParam = "ts=" 1*DIGIT
+sessPubKeyParam = "skey=" base64url
+idPubKeyParam = "idkey=" base64url
+dhPubKeyParam = "dh=" base64url
+sessSignatureParam = "ssig=" base64url ; signs the URI with this and idSignatureParam param removed
+idSignatureParam = "idsig=" base64url ; signs the URI with this param removed
+base64url = <base64url encoded binary> ; RFC4648, section 5
+```
+
+Multicast session announcement is a binary encoded packet with this syntax:
+
+```abnf
+sessionAddressPacket = dhPubKey nonce encrypted(unpaddedSize sessionAddress packetPad)
+dhPubKey = length x509encoded ; same as announced
+nonce = length *OCTET
+sessionAddress = largeLength sessionAddressUri ; as above
+length = 1*1 OCTET ; for binary data up to 255 bytes
+largeLength = 2*2 OCTET ; for binary data up to 65535 bytes
+packetPad = <pad packet size to 1450 bytes> ; possibly, we may need to move KEM agreement one step later,
+; with encapsulation key in HELLO block and KEM ciphertext in reply to HELLO.
+```
+
+### Establishing TLS connection
+
+Both controller and host use 2-element certificate chains with unique self-signed CA root representing long-term identities. Leaf certificates aren't stored and instead generated on each session start.
+
+A controller runs a TCP server to avoid opening listening socket on a host, which might create an attack vector. A controller keeps no sensitive data to be exposed this way.
+
+During TLS handshake, parties validate certificate chains against previously known (from invitation or storage) CA fingerprints. The fingerprints MUST be the same as in the invitation and in the subsequent connections.
+
+### Session verification and protocol negotiation
+
+Once TLS session is established, both the host and controller devices present a "session security code" to the user who must match them (e.g., visually or via QR code scan) and confirm on the host device. The session security code must be a digest of tlsunique channel binding. As it is computed as a digest of the TLS handshake for both the controller and the host, it will validate that the same TLS certificates are used on both sides, and that the same TLS session is established, mitigating the possibility of MITM attack in the connection.
+
+Once the session is confirmed by the user, the host sends HELLO block to the controller.
+
+XRCP blocks inside TLS are padded to 16384 bytes.
+
+Host HELLO block must contain:
+- new session DH key - used to compute new shared secret with the controller keys from the announcement.
+- encrypted part of HELLO block (JSON object), containing:
+  - chosen protocol version.
+  - host CA TLS certificate fingerprint - part of host long term identity - must match the one presented in TLS handshake and the previous sessions, otherwise the connection is terminated.
+  - KEM encapsulation key - used to compute new shared secret for the session.
+  - additional application specific parameters, e.g host device name, application version, host settings or JSON encoding format.
+
+Host HELLO block syntax:
+
+```abnf
+hostHello = %s"HELLO " dhPubKey nonce encrypted(unpaddedSize hostHelloJSON helloPad) pad
+unpaddedSize = largeLength
+dhPubKey = length x509encoded
+pad = <pad block size to 16384 bytes>
+helloPad = <pad hello size to 12888 bytes>
+largeLength = 2*2 OCTET
+```
+
+The controller decrypts (including the first session) and validates the received HELLO block:
+- Chosen versions are supported (must be within offered ranges).
+- CA fingerprint matches the one presented in TLS handshake and the previous sessions - in subsequent sessions TLS connection should be rejected if the fingerprint is different.
+
+[JTD schema](https://www.rfc-editor.org/rfc/rfc8927) for the encrypted part of host HELLO block `hostHelloJSON`:
+
+```json
+{
+  "definitions": {
+    "version": {
+      "type": "string",
+      "metadata": {
+        "format": "[0-9]+"
+      }
+    },
+    "base64url": {
+      "type": "string",
+      "metadata": {
+        "format": "base64url"
+      }
+    }
+  },
+  "properties": {
+    "v": {"ref": "version"},
+    "ca": {"ref": "base64url"},
+    "kem": {"ref": "base64url"}
+  },
+  "optionalProperties": {
+    "app": {"properties": {}, "additionalProperties": true}
+  },
+  "additionalProperties": true
+}
+```
+
+The controller should reply with with `ctrlHello` or `ctrlError` response:
+
+```abnf
+ctrlHello = %s"HELLO " kemCiphertext nonce encrypted(unpaddedSize ctrlHelloJSON helloPad) pad
+; ctrlHelloJSON is encrypted with the hybrid secret,
+; including both previously agreed DH secret and KEM secret from kemCiphertext
+unpaddedSize = largeLength
+kemCiphertext = largeLength *OCTET
+pad = <pad block size to 16384 bytes>
+helloPad = <pad hello size to 12888 bytes>
+largeLength = 2*2 OCTET
+
+ctrlError = %s"ERROR " nonce encrypted(unpaddedSize ctrlErrorMessage helloPad) pad
+ctrlErrorMessage = <utf-8 encoded text>; encrypted using previously agreed DH secret.
+```
+
+JTD schema for the encrypted part of controller HELLO block `ctrlHelloJSON`:
+
+```json
+{
+  "properties": {},
+  "additionalProperties": true
+}
+```
+
+Once the controller replies HELLO to the valid host HELLO block, it should stop accepting new TCP connections.
+
+### Controller/host session operation
+
+The protocol for communication during the session is out of scope of this protocol.
+
+SimpleX Chat uses HTTP2 encoding, where host device acts as a server and controller acts as a client (these roles are reversed compared with TLS connection, restoring client-server semantics in HTTP).
+
+Payloads in the protocol must be encrypted using NaCL secret_box using the hybrid shared secret agreed during session establishment.
+
+Commands of the controller must be signed after the encryption using the controller's session and long term Ed25519 keys.
+
+tlsunique channel binding from TLS session MUST be included in commands (included in the signed body).
+
+The syntax for encrypted command and response body encoding:
+
+```abnf
+commandBody = encBody sessSignature idSignature [attachment]
+responseBody = encBody [attachment] ; counter must match command
+encBody = nonce encLength32 encrypted(tlsunique counter body)
+attachment = %x01 nonce encLength32 encrypted(attachment)
+noAttachment = %x00
+tlsunique = length 1*OCTET
+counter = 8*8 OCTET ; int64
+encLength32 = 4*4 OCTET ; uint32, includes authTag
+```
+
+If the command or response includes attachment, its hash must be included in command/response and validated.
+
+## Key agreement for announcement packet and for session
+
+Initial announcement is shared out-of-band (URI with xrcp scheme), and it is not encrypted.
+
+This announcement contains only DH keys, as KEM key is too large to include in QR code, which are used to agree encryption key for host HELLO block. The host HELLO block will contain DH key in plaintext part and KEM encapsulation (public) key in encrypted part, that will be used to determine the shared secret (using SHA256 over concatenated DH shared secret and KEM encapsulated secret) both for controller HELLO response (that contains KEM ciphertext in plaintext part) and subsequent session commands and responses.
+
+During the next session the announcement is sent via encrypted multicast block. The shared key for this announcement and for host HELLO block is determined using the KEM shared secret from the previous session and DH shared secret computed using the host DH key from the previous session and the new controller DH key from the announcement.
+
+For the session, the shared secret is computed again using the KEM shared secret encapsulated by the controller using the new KEM key from the host HELLO block and DH shared secret computed using the host DH key from HELLO block and the new controller DH key from the announcement.
+
+In pseudo-code:
+
+```
+// session 1
+hostHelloSecret(1) = dhSecret(1)
+sessionSecret(1) = sha256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
+dhSecret(1) = dh(hostHelloDhKey(1), controllerInvitationDhKey(1))
+kemCiphertext(1) = enc(kemSecret(1), kemEncKey(1))
+// kemEncKey is included in host HELLO, kemCiphertext - in controller HELLO
+kemSecret(1) = dec(kemCiphertext(1), kemDecKey(1))
+
+// multicast announcement for session n
+announcementSecret(n) = sha256(dhSecret(n'))
+dhSecret(n') = dh(hostHelloDhKey(n - 1), controllerDhKey(n))
+
+// session n
+hostHelloSecret(n) = dhSecret(n)
+sessionSecret(n) = sha256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
+dhSecret(n) = dh(hostHelloDhKey(n), controllerDhKey(n))
+// controllerDhKey(n) is either from invitation or from multicast announcement
+kemCiphertext(n) = enc(kemSecret(n), kemEncKey(n))
+kemSecret(n) = dec(kemCiphertext(n), kemDecKey(n))
+```
+
+If controller fails to store the new host DH key after receiving HELLO block, the encryption will become out of sync and the host won't be able to decrypt the next announcement. To mitigate it, the host should keep the last session DH key and also previous session DH key to try to decrypt the next announcement computing shared secret using both keys (first the new one, and in case it fails - the previous).
+
+To decrypt a multicast announcement, the host should try to decrypt it using the keys of all known (paired) remote controllers.
+
+## Threat model
+
+#### A passive network adversary able to monitor the site-local traffic:
+
+*can:*
+- observe session times, duration and volume of the transmitted data between host and controller.
+
+*cannot:*
+- observe the content of the transmitted data.
+- substitute the transmitted commands or responses.
+- replay transmitted commands or events from the hosts.
+
+#### An active network adversary able to intercept and substitute the site-local traffic:
+
+*can:*
+- prevent host and controller devices from establishing the session
+
+*cannot:*
+- same as passive adversary, provided that user visually verified session code out-of-band.
+
+#### An active adversary with the access to the network:
+
+*can:*
+- spam controller device.
+
+*cannot:*
+- compromise host or controller devices.
+
+#### An active adversary with the access to the network who also observed OOB announcement:
+
+*can:*
+- connect to controller instead of the host.
+- present incorrect data to the controller.
+
+*cannot:*
+- connect to the host or make host connect to itself.
+
+#### Compromised controller device:
+
+*can:*
+- observe the content of the transmitted data.
+- access any data of the controlled host application, within the capabilities of the provided API.
+
+*cannot:*
+- access other data on the host device.
+- compromise host device.
+
+#### Compromised host device:
+
+*can:*
+- present incorrect data to the controller.
+- incorrectly interpret controller commands.
+
+*cannot:*
+- access controller data, even related to this host device.
diff --git a/rfcs/2022-12-26-simplex-file-transfer.md b/rfcs/done/2022-12-26-simplex-file-transfer.md
similarity index 100%
rename from rfcs/2022-12-26-simplex-file-transfer.md
rename to rfcs/done/2022-12-26-simplex-file-transfer.md
diff --git a/rfcs/2022-12-27-queue-quota.md b/rfcs/done/2022-12-27-queue-quota.md
similarity index 100%
rename from rfcs/2022-12-27-queue-quota.md
rename to rfcs/done/2022-12-27-queue-quota.md
diff --git a/rfcs/2023-05-02-resync-ratchets.md b/rfcs/done/2023-05-02-resync-ratchets.md
similarity index 100%
rename from rfcs/2023-05-02-resync-ratchets.md
rename to rfcs/done/2023-05-02-resync-ratchets.md
diff --git a/rfcs/2023-05-03-delivery-receipts.md b/rfcs/done/2023-05-03-delivery-receipts.md
similarity index 100%
rename from rfcs/2023-05-03-delivery-receipts.md
rename to rfcs/done/2023-05-03-delivery-receipts.md
diff --git a/rfcs/2023-05-24-smp-delivery-proxy.md b/rfcs/done/2023-05-24-smp-delivery-proxy.md
similarity index 100%
rename from rfcs/2023-05-24-smp-delivery-proxy.md
rename to rfcs/done/2023-05-24-smp-delivery-proxy.md
diff --git a/rfcs/2023-06-08-resync-ratchets.md b/rfcs/done/2023-06-08-resync-ratchets.md
similarity index 100%
rename from rfcs/2023-06-08-resync-ratchets.md
rename to rfcs/done/2023-06-08-resync-ratchets.md
diff --git a/rfcs/2023-09-12-second-relays.md b/rfcs/done/2023-09-12-second-relays.md
similarity index 100%
rename from rfcs/2023-09-12-second-relays.md
rename to rfcs/done/2023-09-12-second-relays.md
diff --git a/rfcs/2023-10-25-remote-control.md b/rfcs/done/2023-10-25-remote-control.md
similarity index 100%
rename from rfcs/2023-10-25-remote-control.md
rename to rfcs/done/2023-10-25-remote-control.md
diff --git a/rfcs/2024-01-26-file-links.md b/rfcs/done/2024-01-26-file-links.md
similarity index 100%
rename from rfcs/2024-01-26-file-links.md
rename to rfcs/done/2024-01-26-file-links.md
diff --git a/rfcs/2024-02-03-deniability.md b/rfcs/done/2024-02-03-deniability.md
similarity index 100%
rename from rfcs/2024-02-03-deniability.md
rename to rfcs/done/2024-02-03-deniability.md
diff --git a/rfcs/2024-03-28-xftp-version.md b/rfcs/done/2024-03-28-xftp-version.md
similarity index 100%
rename from rfcs/2024-03-28-xftp-version.md
rename to rfcs/done/2024-03-28-xftp-version.md
diff --git a/rfcs/2021-02-28-streams.md b/rfcs/rejected/2021-02-28-streams.md
similarity index 100%
rename from rfcs/2021-02-28-streams.md
rename to rfcs/rejected/2021-02-28-streams.md
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 0067d4ada..d6bbc13ca 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -332,7 +332,6 @@ data AEvent (e :: AEntity) where
   UP :: SMPServer -> [ConnId] -> AEvent AENone
   SWITCH :: QueueDirection -> SwitchPhase -> ConnectionStats -> AEvent AEConn
   RSYNC :: RatchetSyncState -> Maybe AgentCryptoError -> ConnectionStats -> AEvent AEConn
-  MID :: AgentMsgId -> PQEncryption -> AEvent AEConn
   SENT :: AgentMsgId -> Maybe SMPServer -> AEvent AEConn
   MWARN :: AgentMsgId -> AgentErrorType -> AEvent AEConn
   MERR :: AgentMsgId -> AgentErrorType -> AEvent AEConn
@@ -401,7 +400,6 @@ data AEventTag (e :: AEntity) where
   UP_ :: AEventTag AENone
   SWITCH_ :: AEventTag AEConn
   RSYNC_ :: AEventTag AEConn
-  MID_ :: AEventTag AEConn
   SENT_ :: AEventTag AEConn
   MWARN_ :: AEventTag AEConn
   MERR_ :: AEventTag AEConn
@@ -454,7 +452,6 @@ aEventTag = \case
   UP {} -> UP_
   SWITCH {} -> SWITCH_
   RSYNC {} -> RSYNC_
-  MID {} -> MID_
   SENT {} -> SENT_
   MWARN {} -> MWARN_
   MERR {} -> MERR_

From 9e7e0d102dc39846103c71101b84d793f16ab8ab Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Mon, 24 Jun 2024 15:15:08 +0300
Subject: [PATCH 014/195] smp-server: conserve resources (#1194)

* transport: force auth params, remove async wrapper

* stricter new messages

* bang more thunks

* style

* don't produce msgQuota unless requested

* strict

* refactor

* remove bangs

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 src/Simplex/Messaging/Agent.hs                 |  4 +++-
 src/Simplex/Messaging/Client.hs                | 17 +++++++++--------
 src/Simplex/Messaging/Client/Agent.hs          |  6 +++---
 src/Simplex/Messaging/Notifications/Server.hs  |  2 +-
 src/Simplex/Messaging/Server.hs                | 13 +++++++------
 src/Simplex/Messaging/Server/MsgStore/STM.hs   |  5 +++--
 src/Simplex/Messaging/Server/QueueStore/STM.hs |  3 ++-
 src/Simplex/Messaging/Transport.hs             | 10 +++++++---
 8 files changed, 35 insertions(+), 25 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 63f74b5b2..f1ab78200 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -427,7 +427,9 @@ setNetworkConfig c@AgentClient {useNetworkConfig} cfg' = do
     (_, cfg) <- readTVar useNetworkConfig
     if cfg == cfg'
       then pure False
-      else True <$ (writeTVar useNetworkConfig $! (slowNetworkConfig cfg', cfg'))
+      else
+        let cfgSlow = slowNetworkConfig cfg'
+         in True <$ (cfgSlow `seq` writeTVar useNetworkConfig (cfgSlow, cfg'))
   when changed $ reconnectAllServers c
 
 setUserNetworkInfo :: AgentClient -> UserNetworkInfo -> IO ()
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index e4413d595..de178e368 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -100,6 +100,7 @@ module Simplex.Messaging.Client
 where
 
 import Control.Applicative ((<|>))
+import Control.Concurrent (ThreadId, forkFinally, killThread, mkWeakThreadId)
 import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Exception
@@ -138,13 +139,14 @@ import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, diffToMicroseconds, ifM, liftEitherWith, raceAny_, threadDelay', tshow, whenM)
 import Simplex.Messaging.Version
+import System.Mem.Weak (Weak, deRefWeak)
 import System.Timeout (timeout)
 
 -- | 'SMPClient' is a handle used to send commands to a specific SMP server.
 --
 -- Use 'getSMPClient' to connect to an SMP server and create a client handle.
 data ProtocolClient v err msg = ProtocolClient
-  { action :: Maybe (Async ()),
+  { action :: Maybe (Weak ThreadId),
     thParams :: THandleParams v 'TClient,
     sessionTs :: UTCTime,
     client_ :: PClient v err msg
@@ -475,15 +477,14 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
       cVar <- newEmptyTMVarIO
       let tcConfig = (transportClientConfig networkConfig useHost) {alpn = clientALPN}
           username = proxyUsername transportSession
-      action <-
-        async $
-          runTransportClient tcConfig (Just username) useHost port' (Just $ keyHash srv) (client t c cVar)
-            `finally` atomically (tryPutTMVar cVar $ Left PCENetworkError)
+      tId <-
+        runTransportClient tcConfig (Just username) useHost port' (Just $ keyHash srv) (client t c cVar)
+          `forkFinally` \_ -> void (atomically . tryPutTMVar cVar $ Left PCENetworkError)
       c_ <- tcpConnectTimeout `timeout` atomically (takeTMVar cVar)
       case c_ of
-        Just (Right c') -> pure $ Right c' {action = Just action}
+        Just (Right c') -> mkWeakThreadId tId >>= \tId' -> pure $ Right c' {action = Just tId'}
         Just (Left e) -> pure $ Left e
-        Nothing -> cancel action $> Left PCENetworkError
+        Nothing -> killThread tId $> Left PCENetworkError
 
     useTransport :: (ServiceName, ATransport)
     useTransport = case port srv of
@@ -589,7 +590,7 @@ proxyUsername (userId, _, entityId_) = C.sha256Hash $ bshow userId <> maybe "" (
 
 -- | Disconnects client from the server and terminates client threads.
 closeProtocolClient :: ProtocolClient v err msg -> IO ()
-closeProtocolClient = mapM_ uninterruptibleCancel . action
+closeProtocolClient = mapM_ (deRefWeak >=> mapM_ killThread) . action
 {-# INLINE closeProtocolClient #-}
 
 -- | SMP client error type.
diff --git a/src/Simplex/Messaging/Client/Agent.hs b/src/Simplex/Messaging/Client/Agent.hs
index 8781d87a6..e7c22eec2 100644
--- a/src/Simplex/Messaging/Client/Agent.hs
+++ b/src/Simplex/Messaging/Client/Agent.hs
@@ -1,8 +1,7 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
@@ -171,7 +170,8 @@ getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, worke
       case r of
         Right smp -> do
           logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
-          let c = (isOwnServer ca srv, smp)
+          let !owned = isOwnServer ca srv
+              !c = (owned, smp)
           atomically $ do
             putTMVar (sessionVar v) (Right c)
             TM.insert (sessionId $ thParams smp) c smpSessions
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 892560660..5d3b4d806 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -382,7 +382,7 @@ send :: Transport c => THandleNTF c 'TServer -> NtfServerClient -> IO ()
 send h@THandle {params} NtfServerClient {sndQ, sndActiveAt} = forever $ do
   t <- atomically $ readTBQueue sndQ
   void . liftIO $ tPut h [Right (Nothing, encodeTransmission params t)]
-  atomically . writeTVar sndActiveAt =<< liftIO getSystemTime
+  atomically . (writeTVar sndActiveAt $!) =<< liftIO getSystemTime
 
 -- instance Show a => Show (TVar a) where
 --   show x = unsafePerformIO $ show <$> readTVarIO x
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index dfb4973ea..5c8d13a5e 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -525,7 +525,7 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
   forever $ do
     ts <- L.toList <$> liftIO (tGet h)
-    atomically . writeTVar rcvActiveAt =<< liftIO getSystemTime
+    atomically . (writeTVar rcvActiveAt $!) =<< liftIO getSystemTime
     stats <- asks serverStats
     (errs, cmds) <- partitionEithers <$> mapM (cmdAction stats) ts
     write sndQ errs
@@ -581,7 +581,7 @@ tSend :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> NonEmpty (Tran
 tSend th Client {sndActiveAt} ts = do
   withMVar th $ \h@THandle {params} ->
     void . tPut h $ L.map (\t -> Right (Nothing, encodeTransmission params t)) ts
-  atomically . writeTVar sndActiveAt =<< liftIO getSystemTime
+  atomically . (writeTVar sndActiveAt $!) =<< liftIO getSystemTime
 
 disconnectTransport :: Transport c => THandle v c 'TServer -> TVar SystemTime -> TVar SystemTime -> ExpirationConfig -> IO Bool -> IO ()
 disconnectTransport THandle {connection, params = THandleParams {sessionId}} rcvActiveAt sndActiveAt expCfg noSubscriptions = do
@@ -1037,15 +1037,16 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             mkMessage body = do
               msgId <- randomId =<< asks (msgIdBytes . config)
               msgTs <- liftIO getSystemTime
-              pure $ Message msgId msgTs msgFlags body
+              pure $! Message msgId msgTs msgFlags body
 
             expireMessages :: MsgQueue -> M ()
             expireMessages q = do
               msgExp <- asks $ messageExpiration . config
               old <- liftIO $ mapM expireBeforeEpoch msgExp
-              stats <- asks serverStats
               deleted <- atomically $ sum <$> mapM (deleteExpiredMsgs q) old
-              atomically $ modifyTVar' (msgExpired stats) (+ deleted)
+              when (deleted > 0) $ do
+                stats <- asks serverStats
+                atomically $ modifyTVar' (msgExpired stats) (+ deleted)
 
             trySendNotification :: NtfCreds -> Message -> TVar ChaChaDRG -> STM (Maybe Bool)
             trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg ntfNonceDrg =
@@ -1164,7 +1165,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             msgTs' = messageTs msg
 
         setDelivered :: Sub -> Message -> STM Bool
-        setDelivered s msg = tryPutTMVar (delivered s) (messageId msg)
+        setDelivered s msg = tryPutTMVar (delivered s) $! messageId msg
 
         getStoreMsgQueue :: T.Text -> RecipientId -> M MsgQueue
         getStoreMsgQueue name rId = time (name <> " getMsgQueue") $ do
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index 2d735d1d4..e315c4fe5 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -75,7 +76,7 @@ snapshotMsgQueue st rId = TM.lookup rId st >>= maybe (pure []) (snapshotTQueue .
       pure msgs
 
 writeMsg :: MsgQueue -> Message -> STM (Maybe Message)
-writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} msg = do
+writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = do
   canWrt <- readTVar canWrite
   empty <- isEmptyTQueue q
   if canWrt || empty
@@ -85,7 +86,7 @@ writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} msg = do
       modifyTVar' size (+ 1)
       if canWrt'
         then writeTQueue q msg $> Just msg
-        else writeTQueue q msgQuota $> Nothing
+        else (writeTQueue q $! msgQuota) $> Nothing
     else pure Nothing
   where
     msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index 8de7a38c6..d6cdaf10a 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -69,7 +70,7 @@ secureQueue QueueStore {queues} rId sKey =
     readTVar qVar >>= \q -> case senderKey q of
       Just k -> pure $ if sKey == k then Just q else Nothing
       _ ->
-        let q' = q {senderKey = Just sKey}
+        let !q' = q {senderKey = Just sKey}
          in writeTVar qVar q' $> Just q'
 
 addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> STM (Either ErrorType QueueRec)
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index 6eddcabf8..7088480f5 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -83,7 +83,7 @@ module Simplex.Messaging.Transport
 where
 
 import Control.Applicative (optional)
-import Control.Monad (forM)
+import Control.Monad (forM, (<$!>))
 import Control.Monad.Except
 import Control.Monad.Trans.Except (throwE)
 import qualified Data.Aeson.TH as J
@@ -540,12 +540,12 @@ smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange = do
 
 smpTHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRangeSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> THandleSMP c 'TServer
 smpTHandleServer th v vr pk k_ =
-  let thAuth = THAuthServer {serverPrivKey = pk, sessSecret' = (`C.dh'` pk) <$> k_}
+  let thAuth = THAuthServer {serverPrivKey = pk, sessSecret' = (`C.dh'` pk) <$!> k_}
    in smpTHandle_ th v vr (Just thAuth)
 
 smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> THandleSMP c 'TClient
 smpTHandleClient th v vr pk_ ck_ =
-  let thAuth = (\(k, ck) -> THAuthClient {serverPeerPubKey = k, serverCertKey = ck, sessSecret = C.dh' k <$> pk_}) <$> ck_
+  let thAuth = (\(k, ck) -> THAuthClient {serverPeerPubKey = k, serverCertKey = forceCertChain ck, sessSecret = C.dh' k <$!> pk_}) <$!> ck_
    in smpTHandle_ th v vr thAuth
 
 smpTHandle_ :: forall c p. THandleSMP c p -> VersionSMP -> VersionRangeSMP -> Maybe (THandleAuth p) -> THandleSMP c p
@@ -554,6 +554,10 @@ smpTHandle_ th@THandle {params} v vr thAuth =
   let params' = params {thVersion = v, thServerVRange = vr, thAuth, implySessId = v >= authCmdsSMPVersion}
    in (th :: THandleSMP c p) {params = params'}
 
+{-# INLINE forceCertChain #-}
+forceCertChain :: (X.CertificateChain, X.SignedExact T.PubKey) -> (X.CertificateChain, X.SignedExact T.PubKey)
+forceCertChain cert@(X.CertificateChain cc, signedKey) = length (show cc) `seq` show signedKey `seq` cert
+
 -- This function is only used with v >= 8, so currently it's a simple record update.
 -- It may require some parameters update in the future, to be consistent with smpTHandle_.
 smpTHParamsSetVersion :: VersionSMP -> THandleParams SMPVersion p -> THandleParams SMPVersion p

From c7886926870e97fa592d51fa36a2cdec49296388 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 25 Jun 2024 09:42:59 +0400
Subject: [PATCH 015/195] agent: servers summary types, api (#1202)

* agent: servers summary types, api [wip]

* encoding

* export

* Revert "export"

This reverts commit cd9f315fe8d3e07344cfb48bac24b8dcf38fdfa1.

* comment

* rename

* simplify types

* uncomment

* comment

* rework

* comment, exports

* save, restore stats wip

* remove

* rename

* save stats periodically

* sigint, sigterm experiments

* corrections

* remove some proxy stats

* increase stat

* proposed stats

* fields

* Revert "sigint, sigterm experiments"

This reverts commit f876fbd418889bb59384497d535c91575d7cbb77.

* wip

* retries -> attempts

* errs

* fix

* other errs

* more stat tracking

* sub stats

* remove xftp successes stats

* xftp stats tracking

* revert

* revert

* refactor

* remove imports

* comment

* Revert "refactor"

This reverts commit 26c368d82a5bb1366f2b2cb50bdba82f29d6db96.

* Revert "revert"

This reverts commit 4c9e3753b5251daf39e21c36d356c734431bed50.

* Revert "revert"

This reverts commit 6f656440538bccd1fbe63cf431b40f3184a523a4.

* todos

* persistence

* rename, fix

* config

* comment

* add started at to summary

* delete stats on user deletion

* reset api

* move

* getAgentServersSummary collect state logic

* corrections

* corrections

* remove

* rework

* decrease contention

* update

* more stats

* count sentProxied

* count subs

* remove unused

* comment

* remove comment

* comment

* export

* refactor

* cleanup

* intervals

* refactor

* refactor2

* refactor3

* refactor4

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 simplexmq.cabal                               |   2 +
 src/Simplex/FileTransfer/Agent.hs             |  21 +-
 src/Simplex/Messaging/Agent.hs                | 165 ++++++---
 src/Simplex/Messaging/Agent/Client.hs         | 155 +++++++-
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |   4 +
 src/Simplex/Messaging/Agent/Stats.hs          | 337 ++++++++++++++++++
 src/Simplex/Messaging/Agent/Store.hs          |   2 +
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  20 ++
 .../Agent/Store/SQLite/Migrations.hs          |   4 +-
 .../Migrations/M20240518_servers_stats.hs     |  29 ++
 .../Store/SQLite/Migrations/agent_schema.sql  |   7 +
 src/Simplex/Messaging/Util.hs                 |  11 +-
 12 files changed, 698 insertions(+), 59 deletions(-)
 create mode 100644 src/Simplex/Messaging/Agent/Stats.hs
 create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240518_servers_stats.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 1166ca4ff..2474cebd4 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -95,6 +95,7 @@ library
       Simplex.Messaging.Agent.Protocol
       Simplex.Messaging.Agent.QueryString
       Simplex.Messaging.Agent.RetryInterval
+      Simplex.Messaging.Agent.Stats
       Simplex.Messaging.Agent.Store
       Simplex.Messaging.Agent.Store.SQLite
       Simplex.Messaging.Agent.Store.SQLite.Common
@@ -132,6 +133,7 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240518_servers_stats
       Simplex.Messaging.Agent.TRcvQueues
       Simplex.Messaging.Client
       Simplex.Messaging.Client.Agent
diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 890966888..90dda5cbc 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -63,6 +63,7 @@ import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
@@ -184,6 +185,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
             liftIO $ waitForUserNetwork c
+            atomically $ incXFTPServerStat c userId srv downloadAttempts
             downloadFileChunk fc replica approvedRelays
               `catchAgentError` \e -> retryOnError "XFTP rcv worker" (retryLoop loop e delay') (retryDone e) e
           where
@@ -194,7 +196,11 @@ runXFTPRcvWorker c srv Worker {doWork} = do
                 withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
               atomically $ assertAgentForeground c
               loop
-            retryDone = rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath)
+            retryDone e = do
+              atomically . incXFTPServerStat c userId srv $ case e of
+                XFTP _ XFTP.AUTH -> downloadAuthErrs
+                _ -> downloadErrs
+              rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath) e
     downloadFileChunk :: RcvFileChunk -> RcvFileChunkReplica -> Bool -> AM ()
     downloadFileChunk RcvFileChunk {userId, rcvFileId, rcvFileEntityId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath} replica approvedRelays = do
       unlessM ((approvedRelays ||) <$> ipAddressProtected') $ throwE $ FILE NOT_APPROVED
@@ -214,6 +220,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
               Just RcvFileRedirect {redirectFileInfo = RedirectFileInfo {size = FileSize finalSize}, redirectEntityId} -> (redirectEntityId, finalSize)
         liftIO . when complete $ updateRcvFileStatus db rcvFileId RFSReceived
         pure (entityId, complete, RFPROG rcvd total)
+      atomically $ incXFTPServerStat c userId srv downloads
       notify c entityId progress
       when complete . lift . void $
         getXFTPRcvWorker True c Nothing
@@ -484,6 +491,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
             liftIO $ waitForUserNetwork c
+            atomically $ incXFTPServerStat c userId srv uploadAttempts
             uploadFileChunk cfg fc replica
               `catchAgentError` \e -> retryOnError "XFTP snd worker" (retryLoop loop e delay') (retryDone e) e
           where
@@ -494,7 +502,9 @@ runXFTPSndWorker c srv Worker {doWork} = do
                 withStore' c $ \db -> updateSndChunkReplicaDelay db sndChunkReplicaId replicaDelay
               atomically $ assertAgentForeground c
               loop
-            retryDone = sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath)
+            retryDone e = do
+              atomically $ incXFTPServerStat c userId srv uploadErrs
+              sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) e
     uploadFileChunk :: AgentConfig -> SndFileChunk -> SndFileChunkReplica -> AM ()
     uploadFileChunk AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients} sndFileChunk@SndFileChunk {sndFileId, userId, chunkSpec = chunkSpec@XFTPChunkSpec {filePath}, digest = chunkDigest} replica = do
       replica'@SndFileChunkReplica {sndChunkReplicaId} <- addRecipients sndFileChunk replica
@@ -510,6 +520,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
       let uploaded = uploadedSize chunks
           total = totalSize chunks
           complete = all chunkUploaded chunks
+      atomically $ incXFTPServerStat c userId srv uploads
       notify c sndFileEntityId $ SFPROG uploaded total
       when complete $ do
         (sndDescr, rcvDescrs) <- sndFileToDescrs sf
@@ -651,6 +662,7 @@ runXFTPDelWorker c srv Worker {doWork} = do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
             liftIO $ waitForUserNetwork c
+            atomically $ incXFTPServerStat c userId srv deleteAttempts
             deleteChunkReplica
               `catchAgentError` \e -> retryOnError "XFTP del worker" (retryLoop loop e delay') (retryDone e) e
           where
@@ -661,10 +673,13 @@ runXFTPDelWorker c srv Worker {doWork} = do
                 withStore' c $ \db -> updateDeletedSndChunkReplicaDelay db deletedSndChunkReplicaId replicaDelay
               atomically $ assertAgentForeground c
               loop
-            retryDone = delWorkerInternalError c deletedSndChunkReplicaId
+            retryDone e = do
+              atomically $ incXFTPServerStat c userId srv deleteErrs
+              delWorkerInternalError c deletedSndChunkReplicaId e
             deleteChunkReplica = do
               agentXFTPDeleteChunk c userId replica
               withStore' c $ \db -> deleteDeletedSndChunkReplica db deletedSndChunkReplicaId
+              atomically $ incXFTPServerStat c userId srv deletions
 
 delWorkerInternalError :: AgentClient -> Int64 -> AgentErrorType -> AM ()
 delWorkerInternalError c deletedSndChunkReplicaId e = do
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index f1ab78200..0c433cfed 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -104,6 +104,8 @@ module Simplex.Messaging.Agent
     rcConnectHost,
     rcConnectCtrl,
     rcDiscoverCtrl,
+    getAgentServersSummary,
+    resetAgentServersStats,
     foregroundAgent,
     suspendAgent,
     execAgentStoreSQL,
@@ -157,6 +159,7 @@ import Simplex.Messaging.Agent.Lock (withLock, withLock')
 import Simplex.Messaging.Agent.NtfSubSupervisor
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
@@ -202,23 +205,57 @@ getSMPAgentClient_ clientId cfg initServers store backgroundMode =
   liftIO $ newSMPAgentEnv cfg store >>= runReaderT runAgent
   where
     runAgent = do
-      c@AgentClient {acThread} <- atomically . newAgentClient clientId initServers =<< ask
+      currentTs <- liftIO getCurrentTime
+      c@AgentClient {acThread} <- atomically . newAgentClient clientId initServers currentTs =<< ask
       t <- runAgentThreads c `forkFinally` const (liftIO $ disconnectAgentClient c)
       atomically . writeTVar acThread . Just =<< mkWeakThreadId t
       pure c
     runAgentThreads c
       | backgroundMode = run c "subscriber" $ subscriber c
-      | otherwise =
+      | otherwise = do
+          restoreServersStats c
           raceAny_
             [ run c "subscriber" $ subscriber c,
               run c "runNtfSupervisor" $ runNtfSupervisor c,
-              run c "cleanupManager" $ cleanupManager c
+              run c "cleanupManager" $ cleanupManager c,
+              run c "logServersStats" $ logServersStats c
             ]
+            `E.finally` saveServersStats c
     run AgentClient {subQ, acThread} name a =
       a `E.catchAny` \e -> whenM (isJust <$> readTVarIO acThread) $ do
         logError $ "Agent thread " <> name <> " crashed: " <> tshow e
         atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ CRITICAL True $ show e)
 
+logServersStats :: AgentClient -> AM' ()
+logServersStats c = do
+  delay <- asks (initialLogStatsDelay . config)
+  liftIO $ threadDelay' delay
+  int <- asks (logStatsInterval . config)
+  forever $ do
+    saveServersStats c
+    liftIO $ threadDelay' int
+
+saveServersStats :: AgentClient -> AM' ()
+saveServersStats c@AgentClient {subQ, smpServersStats, xftpServersStats} = do
+  sss <- mapM (lift . getAgentSMPServerStats) =<< readTVarIO smpServersStats
+  xss <- mapM (lift . getAgentXFTPServerStats) =<< readTVarIO xftpServersStats
+  let stats = AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss}
+  tryAgentError' (withStore' c (`updateServersStats` stats)) >>= \case
+    Left e -> atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
+    Right () -> pure ()
+
+restoreServersStats :: AgentClient -> AM' ()
+restoreServersStats c@AgentClient {smpServersStats, xftpServersStats, srvStatsStartedAt} = do
+  tryAgentError' (withStore c getServersStats) >>= \case
+    Left e -> atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
+    Right (startedAt, Nothing) -> atomically $ writeTVar srvStatsStartedAt startedAt
+    Right (startedAt, Just AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss}) -> do
+      atomically $ writeTVar srvStatsStartedAt startedAt
+      sss' <- mapM (atomically . newAgentSMPServerStats') sss
+      atomically $ writeTVar smpServersStats sss'
+      xss' <- mapM (atomically . newAgentXFTPServerStats') xss
+      atomically $ writeTVar xftpServersStats xss'
+
 disconnectAgentClient :: AgentClient -> IO ()
 disconnectAgentClient c@AgentClient {agentEnv = Env {ntfSupervisor = ns, xftpAgent = xa}} = do
   closeAgentClient c
@@ -550,6 +587,10 @@ rcDiscoverCtrl :: AgentClient -> NonEmpty RCCtrlPairing -> AE (RCCtrlPairing, RC
 rcDiscoverCtrl AgentClient {agentEnv = Env {multicastSubscribers = subs}} = withExceptT RCP . discoverRCCtrl subs
 {-# INLINE rcDiscoverCtrl #-}
 
+resetAgentServersStats :: AgentClient -> AE ()
+resetAgentServersStats c = withAgentEnv c $ resetAgentServersStats' c
+{-# INLINE resetAgentServersStats #-}
+
 getAgentStats :: AgentClient -> IO [(AgentStatsKey, Int)]
 getAgentStats c = readTVarIO (agentStats c) >>= mapM (\(k, cnt) -> (k,) <$> readTVarIO cnt) . M.assocs
 
@@ -581,11 +622,15 @@ createUser' c smp xftp = do
   pure userId
 
 deleteUser' :: AgentClient -> UserId -> Bool -> AM ()
-deleteUser' c userId delSMPQueues = do
+deleteUser' c@AgentClient {smpServersStats, xftpServersStats} userId delSMPQueues = do
   if delSMPQueues
     then withStore c (`setUserDeleted` userId) >>= deleteConnectionsAsync_ delUser c False
     else withStore c (`deleteUserRecord` userId)
   atomically $ TM.delete userId $ smpServers c
+  atomically $ TM.delete userId $ xftpServers c
+  atomically $ modifyTVar' smpServersStats $ M.filterWithKey (\(userId', _) _ -> userId' /= userId)
+  atomically $ modifyTVar' xftpServersStats $ M.filterWithKey (\(userId', _) _ -> userId' /= userId)
+  lift $ saveServersStats c
   where
     delUser =
       whenM (withStore' c (`deleteUserWithoutConns` userId)) . atomically $
@@ -701,12 +746,13 @@ newConnSrv c userId connId hasNewConn enableNtfs cMode clientData pqInitKeys sub
   newRcvConnSrv c userId connId' enableNtfs cMode clientData pqInitKeys subMode srv
 
 newRcvConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, ConnectionRequestUri c)
-newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv = do
+newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srvWithAuth@(ProtoServerWithAuth srv _) = do
   case (cMode, pqInitKeys) of
     (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv"
     _ -> pure ()
   AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
-  (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv smpClientVRange subMode `catchAgentError` \e -> liftIO (print e) >> throwE e
+  (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srvWithAuth smpClientVRange subMode `catchAgentError` \e -> liftIO (print e) >> throwE e
+  atomically $ incSMPServerStat c userId srv connCreated
   rq' <- withStore c $ \db -> updateNewConnRcv db connId rq
   lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
   when enableNtfs $ do
@@ -1121,6 +1167,7 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
         ICDeleteRcvQueue rId -> withServer $ \srv -> tryWithLock "ICDeleteRcvQueue" $ do
           rq <- withStore c (\db -> getDeletedRcvQueue db connId srv rId)
           deleteQueue c rq
+          atomically $ incSMPServerStat c userId srv connDeleted
           withStore' c (`deleteConnRcvQueue` rq)
         ICQSecure rId senderKey ->
           withServer $ \srv -> tryWithLock "ICQSecure" . withDuplexConn $ \(DuplexConnection cData rqs sqs) ->
@@ -1129,6 +1176,9 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
                 case find ((replaceQId ==) . dbQId) rqs of
                   Just rq1 -> when (status == Confirmed) $ do
                     secureQueue c rq' senderKey
+                    -- we may add more statistics special to queue rotation later on,
+                    -- not accounting secure during rotation for now:
+                    -- atomically $ incSMPServerStat c userId server connSecured
                     withStore' c $ \db -> setRcvQueueStatus db rq' Secured
                     void . enqueueMessages c cData sqs SMP.noMsgFlags $ QUSE [((server, sndId), True)]
                     rq1' <- withStore' c $ \db -> setRcvSwitchStatus db rq1 $ Just RSSendingQUSE
@@ -1164,8 +1214,9 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
             rq <- withStore c $ \db -> getRcvQueue db connId srv rId
             ackQueueMessage c rq srvMsgId
           secure :: RcvQueue -> SMP.SndPublicAuthKey -> AM ()
-          secure rq senderKey = do
+          secure rq@RcvQueue {server} senderKey = do
             secureQueue c rq senderKey
+            atomically $ incSMPServerStat c userId server connSecured
             withStore' c $ \db -> setRcvQueueStatus db rq Secured
       where
         withServer a = case server_ of
@@ -1281,7 +1332,7 @@ submitPendingMsg c cData sq = do
   void $ getDeliveryWorker True c cData sq
 
 runSmpQueueMsgDelivery :: AgentClient -> ConnData -> SndQueue -> (Worker, TMVar ()) -> AM ()
-runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork}, qLock) = do
+runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userId, server} (Worker {doWork}, qLock) = do
   AgentConfig {messageRetryInterval = ri, messageTimeout, helloTimeout, quotaExceededTimeout} <- asks config
   forever $ do
     atomically $ endAgentOperation c AOSndNetwork
@@ -1304,36 +1355,40 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork
             Left e -> do
               let err = if msgType == AM_A_MSG_ then MERR mId e else ERR e
               case e of
-                SMP _ SMP.QUOTA -> case msgType of
-                  AM_CONN_INFO -> connError msgId NOT_AVAILABLE
-                  AM_CONN_INFO_REPLY -> connError msgId NOT_AVAILABLE
-                  _ -> do
-                    expireTs <- addUTCTime (-quotaExceededTimeout) <$> liftIO getCurrentTime
-                    if internalTs < expireTs
-                      then notifyDelMsgs msgId e expireTs
-                      else do
-                        notify $ MWARN (unId msgId) e
-                        retrySndMsg RISlow
-                SMP _ SMP.AUTH -> case msgType of
-                  AM_CONN_INFO -> connError msgId NOT_AVAILABLE
-                  AM_CONN_INFO_REPLY -> connError msgId NOT_AVAILABLE
-                  AM_RATCHET_INFO -> connError msgId NOT_AVAILABLE
-                  -- in duplexHandshake mode (v2) HELLO is only sent once, without retrying,
-                  -- because the queue must be secured by the time the confirmation or the first HELLO is received
-                  AM_HELLO_ -> case rq_ of
-                    -- party initiating connection
-                    Just _ -> connError msgId NOT_AVAILABLE
-                    -- party joining connection
-                    _ -> connError msgId NOT_ACCEPTED
-                  AM_REPLY_ -> notifyDel msgId err
-                  AM_A_MSG_ -> notifyDel msgId err
-                  AM_A_RCVD_ -> notifyDel msgId err
-                  AM_QCONT_ -> notifyDel msgId err
-                  AM_QADD_ -> qError msgId "QADD: AUTH"
-                  AM_QKEY_ -> qError msgId "QKEY: AUTH"
-                  AM_QUSE_ -> qError msgId "QUSE: AUTH"
-                  AM_QTEST_ -> qError msgId "QTEST: AUTH"
-                  AM_EREADY_ -> notifyDel msgId err
+                SMP _ SMP.QUOTA -> do
+                  atomically $ incSMPServerStat c userId server sentQuotaErrs
+                  case msgType of
+                    AM_CONN_INFO -> connError msgId NOT_AVAILABLE
+                    AM_CONN_INFO_REPLY -> connError msgId NOT_AVAILABLE
+                    _ -> do
+                      expireTs <- addUTCTime (-quotaExceededTimeout) <$> liftIO getCurrentTime
+                      if internalTs < expireTs
+                        then notifyDelMsgs msgId e expireTs
+                        else do
+                          notify $ MWARN (unId msgId) e
+                          retrySndMsg RISlow
+                SMP _ SMP.AUTH -> do
+                  atomically $ incSMPServerStat c userId server sentAuthErrs
+                  case msgType of
+                    AM_CONN_INFO -> connError msgId NOT_AVAILABLE
+                    AM_CONN_INFO_REPLY -> connError msgId NOT_AVAILABLE
+                    AM_RATCHET_INFO -> connError msgId NOT_AVAILABLE
+                    -- in duplexHandshake mode (v2) HELLO is only sent once, without retrying,
+                    -- because the queue must be secured by the time the confirmation or the first HELLO is received
+                    AM_HELLO_ -> case rq_ of
+                      -- party initiating connection
+                      Just _ -> connError msgId NOT_AVAILABLE
+                      -- party joining connection
+                      _ -> connError msgId NOT_ACCEPTED
+                    AM_REPLY_ -> notifyDel msgId err
+                    AM_A_MSG_ -> notifyDel msgId err
+                    AM_A_RCVD_ -> notifyDel msgId err
+                    AM_QCONT_ -> notifyDel msgId err
+                    AM_QADD_ -> qError msgId "QADD: AUTH"
+                    AM_QKEY_ -> qError msgId "QKEY: AUTH"
+                    AM_QUSE_ -> qError msgId "QUSE: AUTH"
+                    AM_QTEST_ -> qError msgId "QTEST: AUTH"
+                    AM_EREADY_ -> notifyDel msgId err
                 _
                   -- for other operations BROKER HOST is treated as a permanent error (e.g., when connecting to the server),
                   -- the message sending would be retried
@@ -1345,7 +1400,9 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork
                         else do
                           when (serverHostError e) $ notify $ MWARN (unId msgId) e
                           retrySndMsg RIFast
-                  | otherwise -> notifyDel msgId err
+                  | otherwise -> do
+                      atomically $ incSMPServerStat c userId server sentOtherErrs
+                      notifyDel msgId err
               where
                 retrySndMsg riMode = do
                   withStore' c $ \db -> updatePendingMsgRIState db connId msgId riState
@@ -1369,7 +1426,9 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork
                       -- it would lead to the non-deterministic internal ID of the first sent message, at to some other race conditions,
                       -- because it can be sent before HELLO is received
                       -- With `status == Active` condition, CON is sent here only by the accepting party, that previously received HELLO
-                      when (status == Active) $ notify $ CON pqEncryption
+                      when (status == Active) $ do
+                        atomically $ incSMPServerStat c userId server connCompleted
+                        notify $ CON pqEncryption
                     -- this branch should never be reached as receive queue is created before the confirmation,
                     _ -> logError "HELLO sent without receive queue"
                 AM_A_MSG_ -> notify $ SENT mId proxySrv_
@@ -1422,6 +1481,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork
       forM_ (L.nonEmpty msgIds_) $ \msgIds -> do
         notify $ MERRS (L.map unId msgIds) err
         withStore' c $ \db -> forM_ msgIds $ \msgId' -> deleteSndMsgDelivery db connId sq msgId' False `catchAll_` pure ()
+      atomically $ incSMPServerStat' c userId server sentExpiredErrs (length msgIds_ + 1)
     delMsg :: InternalId -> AM ()
     delMsg = delMsgKeep False
     delMsgKeep :: Bool -> InternalId -> AM ()
@@ -1940,6 +2000,12 @@ setNtfServers :: AgentClient -> [NtfServer] -> IO ()
 setNtfServers c = atomically . writeTVar (ntfServers c)
 {-# INLINE setNtfServers #-}
 
+resetAgentServersStats' :: AgentClient -> AM ()
+resetAgentServersStats' c@AgentClient {smpServersStats, xftpServersStats} = do
+  atomically $ TM.clear smpServersStats
+  atomically $ TM.clear xftpServersStats
+  withStore' c resetServersStats
+
 -- | Activate operations
 foregroundAgent :: AgentClient -> IO ()
 foregroundAgent c = do
@@ -2108,13 +2174,15 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
             Left e -> notify' connId (ERR e)
             Right () -> pure ()
     processSubOk :: RcvQueue -> TVar [ConnId] -> AM ()
-    processSubOk rq@RcvQueue {connId} upConnIds =
+    processSubOk rq@RcvQueue {userId, connId} upConnIds = do
       atomically . whenM (isPendingSub connId) $ do
         addSubscription c rq
         modifyTVar' upConnIds (connId :)
+      atomically $ incSMPServerStat c userId srv connSubscribed
     processSubErr :: RcvQueue -> SMPClientError -> AM ()
-    processSubErr rq@RcvQueue {connId} e = do
+    processSubErr rq@RcvQueue {userId, connId} e = do
       atomically . whenM (isPendingSub connId) $ failSubscription c rq e
+      atomically $ incSMPServerStat c userId srv connSubErrs
       lift $ notifyErr connId e
     isPendingSub connId = (&&) <$> hasPendingSubscription c connId <*> activeClientSession c tSess sessId
     notify' :: forall e m. (AEntityI e, MonadIO m) => ConnId -> AEvent e -> m ()
@@ -2128,7 +2196,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
       cData@ConnData {userId, connId, connAgentVersion, ratchetSyncState = rss}
       smpMsg =
         withConnLock c connId "processSMP" $ case smpMsg of
-          SMP.MSG msg@SMP.RcvMessage {msgId = srvMsgId} ->
+          SMP.MSG msg@SMP.RcvMessage {msgId = srvMsgId} -> do
+            atomically $ incSMPServerStat c userId srv recvMsgs
             void . handleNotifyAck $ do
               msg' <- decryptSMPMessage rq msg
               ack' <- handleNotifyAck $ case msg' of
@@ -2212,6 +2281,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                           Right Nothing -> prohibited "msg: bad agent msg" >> ack
                           Left e@(AGENT A_DUPLICATE) -> do
                             atomically updateDupMsgCount
+                            atomically $ incSMPServerStat c userId srv recvDuplicates
                             withStore' c (\db -> getLastMsg db connId srvMsgId) >>= \case
                               Just RcvMsg {internalId, msgMeta, msgBody = agentMsgBody, userAck}
                                 | userAck -> ackDel internalId
@@ -2224,6 +2294,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                                       _ -> ack
                               _ -> checkDuplicateHash e encryptedMsgHash >> ack
                           Left (AGENT (A_CRYPTO e)) -> do
+                            atomically $ incSMPServerStat c userId srv recvCryptoErrs
                             exists <- withStore' c $ \db -> checkRcvMsgHashExists db connId encryptedMsgHash
                             unless exists notifySync
                             ack
@@ -2236,7 +2307,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                                       conn'' = updateConnection cData'' connDuplex
                                   notify . RSYNC rss' (Just e) $ connectionStats conn''
                                   withStore' c $ \db -> setConnRatchetSync db connId rss'
-                          Left e -> checkDuplicateHash e encryptedMsgHash >> ack
+                          Left e -> do
+                            atomically $ incSMPServerStat c userId srv recvErrs
+                            checkDuplicateHash e encryptedMsgHash >> ack
                         where
                           checkDuplicateHash :: AgentErrorType -> ByteString -> AM ()
                           checkDuplicateHash e encryptedMsgHash =
@@ -2400,7 +2473,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                     -- `sndStatus == Active` when HELLO was previously sent, and this is the reply HELLO
                     -- this branch is executed by the accepting party in duplexHandshake mode (v2)
                     -- (was executed by initiating party in v1 that is no longer supported)
-                    | sndStatus == Active -> notify $ CON pqEncryption
+                    | sndStatus == Active -> do
+                        atomically $ incSMPServerStat c userId srv connCompleted
+                        notify $ CON pqEncryption
                     | otherwise -> enqueueDuplexHello sq
                   _ -> pure ()
             where
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 2ffd6e3a4..ec8424745 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
@@ -88,6 +89,10 @@ module Simplex.Messaging.Agent.Client
     activeClientSession,
     agentClientStore,
     agentDRG,
+    AgentServersSummary (..),
+    ServerSessions (..),
+    SMPServerSubs (..),
+    getAgentServersSummary,
     getAgentSubscriptions,
     slowNetworkConfig,
     protocolClientError,
@@ -135,6 +140,9 @@ module Simplex.Messaging.Agent.Client
     getNextServer,
     withUserServers,
     withNextSrv,
+    incSMPServerStat,
+    incSMPServerStat',
+    incXFTPServerStat,
     AgentWorkersDetails (..),
     getAgentWorkersDetails,
     AgentWorkersSummary (..),
@@ -174,7 +182,7 @@ 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 (isJust, isNothing, listToMaybe)
+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe)
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Text (Text)
@@ -196,6 +204,7 @@ import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), withTransaction)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
@@ -315,7 +324,10 @@ data AgentClient = AgentClient
     agentStats :: TMap AgentStatsKey (TVar Int),
     msgCounts :: TMap ConnId (TVar (Int, Int)), -- (total, duplicates)
     clientId :: Int,
-    agentEnv :: Env
+    agentEnv :: Env,
+    smpServersStats :: TMap (UserId, SMPServer) AgentSMPServerStats,
+    xftpServersStats :: TMap (UserId, XFTPServer) AgentXFTPServerStats,
+    srvStatsStartedAt :: TVar UTCTime
   }
 
 data SMPConnectedClient = SMPConnectedClient
@@ -443,8 +455,8 @@ data UserNetworkType = UNNone | UNCellular | UNWifi | UNEthernet | UNOther
   deriving (Eq, Show)
 
 -- | Creates an SMP agent client instance that receives commands and sends responses via 'TBQueue's.
-newAgentClient :: Int -> InitialAgentServers -> Env -> STM AgentClient
-newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv = do
+newAgentClient :: Int -> InitialAgentServers -> UTCTime -> Env -> STM AgentClient
+newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs agentEnv = do
   let cfg = config agentEnv
       qSize = tbqSize cfg
   acThread <- newTVar Nothing
@@ -482,6 +494,9 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv =
   smpSubWorkers <- TM.empty
   agentStats <- TM.empty
   msgCounts <- TM.empty
+  smpServersStats <- TM.empty
+  xftpServersStats <- TM.empty
+  srvStatsStartedAt <- newTVar currentTs
   return
     AgentClient
       { acThread,
@@ -520,7 +535,10 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv =
         agentStats,
         msgCounts,
         clientId,
-        agentEnv
+        agentEnv,
+        smpServersStats,
+        xftpServersStats,
+        srvStatsStartedAt
       }
 
 slowNetworkConfig :: NetworkConfig -> NetworkConfig
@@ -1060,7 +1078,11 @@ sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do
     unknownServer = maybe True (all ((destSrv /=) . protoServer)) <$> TM.lookup userId (userServers c)
     sendViaProxy destSess@(_, _, qId) = do
       r <- tryAgentError . withProxySession c destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess) -> do
-        liftClient SMP (clientServer smp) (proxySMPMessage smp proxySess spKey_ senderId msgFlags msg) >>= \case
+        r' <- liftClient SMP (clientServer smp) $ do
+          atomically $ incSMPServerStat c userId destSrv sentViaProxyAttempts
+          atomically $ incSMPServerStat c userId (protocolClientServer' smp) sentProxiedAttempts
+          proxySMPMessage smp proxySess spKey_ senderId msgFlags msg
+        case r' of
           Right () -> pure . Just $ protocolClientServer' smp
           Left proxyErr -> do
             case proxyErr of
@@ -1088,13 +1110,23 @@ sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do
               sameClient smp' = sessionId (thParams smp) == sessionId (thParams smp')
               sameProxiedRelay proxySess' = prSessionId proxySess == prSessionId proxySess'
       case r of
-        Right r' -> pure r'
+        Right r' -> do
+          atomically $ incSMPServerStat c userId destSrv sentViaProxy
+          forM_ r' $ \proxySrv -> atomically $ incSMPServerStat c userId proxySrv sentProxied
+          pure r'
         Left e
           | serverHostError e -> ifM (atomically directAllowed) (sendDirectly destSess $> Nothing) (throwE e)
           | otherwise -> throwE e
     sendDirectly tSess =
-      withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) ->
-        liftClient SMP (clientServer smp) $ sendSMPMessage smp spKey_ senderId msgFlags msg
+      withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
+        r <-
+          tryAgentError $
+            liftClient SMP (clientServer smp) $ do
+              atomically $ incSMPServerStat c userId destSrv sentDirectAttempts
+              sendSMPMessage smp spKey_ senderId msgFlags msg
+        case r of
+          Right () -> atomically $ incSMPServerStat c userId destSrv sentDirect
+          Left e -> throwE e
 
 ipAddressProtected :: NetworkConfig -> ProtocolServer p -> Bool
 ipAddressProtected NetworkConfig {socksProxy, hostMode} (ProtocolServer _ hosts _ _) = do
@@ -1369,6 +1401,8 @@ subscribeQueues c qs = do
       pure $ if prohibited then Left (rq, Left $ CMD PROHIBITED "subscribeQueues") else Right rq
     subscribeQueues_ :: Env -> TVar (Maybe SessionId) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
     subscribeQueues_ env session smp qs' = do
+      let (userId, srv, _) = transportSession' smp
+      atomically $ incSMPServerStat' c userId srv connSubAttempts (length qs')
       rs <- sendBatch subscribeSMPQueues smp qs'
       active <-
         atomically $
@@ -1916,6 +1950,103 @@ withNextSrv c userId usedSrvs initUsed action = do
     writeTVar usedSrvs $! used'
   action srvAuth
 
+incSMPServerStat :: AgentClient -> UserId -> SMPServer -> (AgentSMPServerStats -> TVar Int) -> STM ()
+incSMPServerStat c userId srv sel = incSMPServerStat' c userId srv sel 1
+
+incSMPServerStat' :: AgentClient -> UserId -> SMPServer -> (AgentSMPServerStats -> TVar Int) -> Int -> STM ()
+incSMPServerStat' AgentClient {smpServersStats} userId srv sel n = do
+  TM.lookup (userId, srv) smpServersStats >>= \case
+    Just v -> modifyTVar' (sel v) (+ n)
+    Nothing -> do
+      newStats <- newAgentSMPServerStats
+      modifyTVar' (sel newStats) (+ n)
+      TM.insert (userId, srv) newStats smpServersStats
+
+incXFTPServerStat :: AgentClient -> UserId -> XFTPServer -> (AgentXFTPServerStats -> TVar Int) -> STM ()
+incXFTPServerStat AgentClient {xftpServersStats} userId srv sel = do
+  TM.lookup (userId, srv) xftpServersStats >>= \case
+    Just v -> modifyTVar' (sel v) (+ 1)
+    Nothing -> do
+      newStats <- newAgentXFTPServerStats
+      modifyTVar' (sel newStats) (+ 1)
+      TM.insert (userId, srv) newStats xftpServersStats
+
+data AgentServersSummary = AgentServersSummary
+  { smpServersStats :: Map (UserId, SMPServer) AgentSMPServerStatsData,
+    xftpServersStats :: Map (UserId, XFTPServer) AgentXFTPServerStatsData,
+    statsStartedAt :: UTCTime,
+    smpServersSessions :: Map (UserId, SMPServer) ServerSessions,
+    smpServersSubs :: Map (UserId, SMPServer) SMPServerSubs,
+    xftpServersSessions :: Map (UserId, XFTPServer) ServerSessions,
+    xftpRcvInProgress :: [XFTPServer],
+    xftpSndInProgress :: [XFTPServer],
+    xftpDelInProgress :: [XFTPServer]
+  }
+  deriving (Show)
+
+data SMPServerSubs = SMPServerSubs
+  { ssActive :: Int, -- based on activeSubs
+    ssPending :: Int -- based on pendingSubs
+  }
+  deriving (Show)
+
+data ServerSessions = ServerSessions
+  { ssConnected :: Int,
+    ssErrors :: Int,
+    ssConnecting :: Int
+  }
+  deriving (Show)
+
+getAgentServersSummary :: AgentClient -> IO AgentServersSummary
+getAgentServersSummary c@AgentClient {smpServersStats, xftpServersStats, srvStatsStartedAt, agentEnv} = do
+  sss <- mapM getAgentSMPServerStats =<< readTVarIO smpServersStats
+  xss <- mapM getAgentXFTPServerStats =<< readTVarIO xftpServersStats
+  statsStartedAt <- readTVarIO srvStatsStartedAt
+  smpServersSessions <- countSessions =<< readTVarIO (smpClients c)
+  smpServersSubs <- getServerSubs
+  xftpServersSessions <- countSessions =<< readTVarIO (xftpClients c)
+  xftpRcvInProgress <- catMaybes <$> getXFTPWorkerSrvs xftpRcvWorkers
+  xftpSndInProgress <- catMaybes <$> getXFTPWorkerSrvs xftpSndWorkers
+  xftpDelInProgress <- getXFTPWorkerSrvs xftpDelWorkers
+  pure
+    AgentServersSummary
+      { smpServersStats = sss,
+        xftpServersStats = xss,
+        statsStartedAt,
+        smpServersSessions,
+        smpServersSubs,
+        xftpServersSessions,
+        xftpRcvInProgress,
+        xftpSndInProgress,
+        xftpDelInProgress
+      }
+  where
+    getServerSubs = do
+      subs <- M.foldrWithKey' (addSub incActive) M.empty <$> readTVarIO (getRcvQueues $ activeSubs c)
+      M.foldrWithKey' (addSub incPending) subs <$> readTVarIO (getRcvQueues $ pendingSubs c)
+      where
+        addSub f (userId, srv, _) _ = M.alter (Just . f . fromMaybe SMPServerSubs {ssActive = 0, ssPending = 0}) (userId, srv)
+        incActive ss = ss {ssActive = ssActive ss + 1}
+        incPending ss = ss {ssPending = ssPending ss + 1}
+    Env {xftpAgent = XFTPAgent {xftpRcvWorkers, xftpSndWorkers, xftpDelWorkers}} = agentEnv
+    getXFTPWorkerSrvs workers = foldM addSrv [] . M.toList =<< readTVarIO workers
+      where
+        addSrv acc (srv, Worker {doWork}) = do
+          hasWork <- atomically $ not <$> isEmptyTMVar doWork
+          pure $ if hasWork then srv : acc else acc
+    countSessions :: Map (TransportSession msg) (ClientVar msg) -> IO (Map (UserId, ProtoServer msg) ServerSessions)
+    countSessions = foldM addClient M.empty . M.toList
+      where
+        addClient !acc ((userId, srv, _), SessionVar {sessionVar}) = do
+          c_ <- atomically $ tryReadTMVar sessionVar
+          pure $ M.alter (Just . add c_) (userId, srv) acc
+          where
+            add c_ = modifySessions c_ . fromMaybe ServerSessions {ssConnected = 0, ssErrors = 0, ssConnecting = 0}
+            modifySessions c_ ss = case c_ of
+              Just (Right _) -> ss {ssConnected = ssConnected ss + 1}
+              Just (Left _) -> ss {ssErrors = ssErrors ss + 1}
+              Nothing -> ss {ssConnecting = ssConnecting ss + 1}
+
 data SubInfo = SubInfo {userId :: UserId, server :: Text, rcvId :: Text, subError :: Maybe String}
   deriving (Show)
 
@@ -2106,6 +2237,12 @@ $(J.deriveJSON (enumJSON $ dropPrefix "TS") ''ProtocolTestStep)
 
 $(J.deriveJSON defaultJSON ''ProtocolTestFailure)
 
+$(J.deriveJSON defaultJSON ''ServerSessions)
+
+$(J.deriveJSON defaultJSON ''SMPServerSubs)
+
+$(J.deriveJSON defaultJSON ''AgentServersSummary)
+
 $(J.deriveJSON defaultJSON ''SubInfo)
 
 $(J.deriveJSON defaultJSON ''SubscriptionsInfo)
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index ee2bb16cc..2ae2ad5c0 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -100,6 +100,8 @@ data AgentConfig = AgentConfig
     persistErrorInterval :: NominalDiffTime,
     initialCleanupDelay :: Int64,
     cleanupInterval :: Int64,
+    initialLogStatsDelay :: Int64,
+    logStatsInterval :: Int64,
     cleanupStepInterval :: Int,
     maxWorkerRestartsPerMin :: Int,
     storedMsgDataTTL :: NominalDiffTime,
@@ -170,6 +172,8 @@ defaultAgentConfig =
       persistErrorInterval = 3, -- seconds
       initialCleanupDelay = 30 * 1000000, -- 30 seconds
       cleanupInterval = 30 * 60 * 1000000, -- 30 minutes
+      initialLogStatsDelay = 10 * 1000000, -- 10 seconds
+      logStatsInterval = 10 * 1000000, -- 10 seconds
       cleanupStepInterval = 200000, -- 200ms
       maxWorkerRestartsPerMin = 5,
       storedMsgDataTTL = 21 * nominalDay,
diff --git a/src/Simplex/Messaging/Agent/Stats.hs b/src/Simplex/Messaging/Agent/Stats.hs
new file mode 100644
index 000000000..c8f81a6aa
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Stats.hs
@@ -0,0 +1,337 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Messaging.Agent.Stats where
+
+import qualified Data.Aeson.TH as J
+import Data.Map (Map)
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
+import Simplex.Messaging.Agent.Protocol (UserId)
+import Simplex.Messaging.Parsers (defaultJSON, fromTextField_)
+import Simplex.Messaging.Protocol (SMPServer, XFTPServer)
+import Simplex.Messaging.Util (decodeJSON, encodeJSON)
+import UnliftIO.STM
+
+data AgentSMPServerStats = AgentSMPServerStats
+  { sentDirect :: TVar Int, -- successfully sent messages
+    sentViaProxy :: TVar Int, -- successfully sent messages via proxy
+    sentProxied :: TVar Int, -- successfully sent messages to other destination server via this as proxy
+    sentDirectAttempts :: TVar Int, -- direct sending attempts (min 1 for each sent message)
+    sentViaProxyAttempts :: TVar Int, -- proxy sending attempts
+    sentProxiedAttempts :: TVar Int, -- attempts sending to other destination server via this as proxy
+    sentAuthErrs :: TVar Int, -- send AUTH errors
+    sentQuotaErrs :: TVar Int, -- send QUOTA permanent errors (message expired)
+    sentExpiredErrs :: TVar Int, -- send expired errors
+    sentOtherErrs :: TVar Int, -- other send permanent errors (excluding above)
+    recvMsgs :: TVar Int, -- total messages received
+    recvDuplicates :: TVar Int, -- duplicate messages received
+    recvCryptoErrs :: TVar Int, -- message decryption errors
+    recvErrs :: TVar Int, -- receive errors
+    connCreated :: TVar Int,
+    connSecured :: TVar Int,
+    connCompleted :: TVar Int,
+    connDeleted :: TVar Int,
+    connSubscribed :: TVar Int, -- total successful subscription
+    connSubAttempts :: TVar Int, -- subscription attempts
+    connSubErrs :: TVar Int -- permanent subscription errors (temporary accounted for in attempts)
+  }
+
+data AgentSMPServerStatsData = AgentSMPServerStatsData
+  { _sentDirect :: Int,
+    _sentViaProxy :: Int,
+    _sentProxied :: Int,
+    _sentDirectAttempts :: Int,
+    _sentViaProxyAttempts :: Int,
+    _sentProxiedAttempts :: Int,
+    _sentAuthErrs :: Int,
+    _sentQuotaErrs :: Int,
+    _sentExpiredErrs :: Int,
+    _sentOtherErrs :: Int,
+    _recvMsgs :: Int,
+    _recvDuplicates :: Int,
+    _recvCryptoErrs :: Int,
+    _recvErrs :: Int,
+    _connCreated :: Int,
+    _connSecured :: Int,
+    _connCompleted :: Int,
+    _connDeleted :: Int,
+    _connSubscribed :: Int,
+    _connSubAttempts :: Int,
+    _connSubErrs :: Int
+  }
+  deriving (Show)
+
+newAgentSMPServerStats :: STM AgentSMPServerStats
+newAgentSMPServerStats = do
+  sentDirect <- newTVar 0
+  sentViaProxy <- newTVar 0
+  sentProxied <- newTVar 0
+  sentDirectAttempts <- newTVar 0
+  sentViaProxyAttempts <- newTVar 0
+  sentProxiedAttempts <- newTVar 0
+  sentAuthErrs <- newTVar 0
+  sentQuotaErrs <- newTVar 0
+  sentExpiredErrs <- newTVar 0
+  sentOtherErrs <- newTVar 0
+  recvMsgs <- newTVar 0
+  recvDuplicates <- newTVar 0
+  recvCryptoErrs <- newTVar 0
+  recvErrs <- newTVar 0
+  connCreated <- newTVar 0
+  connSecured <- newTVar 0
+  connCompleted <- newTVar 0
+  connDeleted <- newTVar 0
+  connSubscribed <- newTVar 0
+  connSubAttempts <- newTVar 0
+  connSubErrs <- newTVar 0
+  pure
+    AgentSMPServerStats
+      { sentDirect,
+        sentViaProxy,
+        sentProxied,
+        sentDirectAttempts,
+        sentViaProxyAttempts,
+        sentProxiedAttempts,
+        sentAuthErrs,
+        sentQuotaErrs,
+        sentExpiredErrs,
+        sentOtherErrs,
+        recvMsgs,
+        recvDuplicates,
+        recvCryptoErrs,
+        recvErrs,
+        connCreated,
+        connSecured,
+        connCompleted,
+        connDeleted,
+        connSubscribed,
+        connSubAttempts,
+        connSubErrs
+      }
+
+newAgentSMPServerStats' :: AgentSMPServerStatsData -> STM AgentSMPServerStats
+newAgentSMPServerStats' s = do
+  sentDirect <- newTVar $ _sentDirect s
+  sentViaProxy <- newTVar $ _sentViaProxy s
+  sentProxied <- newTVar $ _sentProxied s
+  sentDirectAttempts <- newTVar $ _sentDirectAttempts s
+  sentViaProxyAttempts <- newTVar $ _sentViaProxyAttempts s
+  sentProxiedAttempts <- newTVar $ _sentProxiedAttempts s
+  sentAuthErrs <- newTVar $ _sentAuthErrs s
+  sentQuotaErrs <- newTVar $ _sentQuotaErrs s
+  sentExpiredErrs <- newTVar $ _sentExpiredErrs s
+  sentOtherErrs <- newTVar $ _sentOtherErrs s
+  recvMsgs <- newTVar $ _recvMsgs s
+  recvDuplicates <- newTVar $ _recvDuplicates s
+  recvCryptoErrs <- newTVar $ _recvCryptoErrs s
+  recvErrs <- newTVar $ _recvErrs s
+  connCreated <- newTVar $ _connCreated s
+  connSecured <- newTVar $ _connSecured s
+  connCompleted <- newTVar $ _connCompleted s
+  connDeleted <- newTVar $ _connDeleted s
+  connSubscribed <- newTVar $ _connSubscribed s
+  connSubAttempts <- newTVar $ _connSubAttempts s
+  connSubErrs <- newTVar $ _connSubErrs s
+  pure
+    AgentSMPServerStats
+      { sentDirect,
+        sentViaProxy,
+        sentProxied,
+        sentDirectAttempts,
+        sentViaProxyAttempts,
+        sentProxiedAttempts,
+        sentAuthErrs,
+        sentQuotaErrs,
+        sentExpiredErrs,
+        sentOtherErrs,
+        recvMsgs,
+        recvDuplicates,
+        recvCryptoErrs,
+        recvErrs,
+        connCreated,
+        connSecured,
+        connCompleted,
+        connDeleted,
+        connSubscribed,
+        connSubAttempts,
+        connSubErrs
+      }
+
+-- as this is used to periodically update stats in db,
+-- this is not STM to decrease contention with stats updates
+getAgentSMPServerStats :: AgentSMPServerStats -> IO AgentSMPServerStatsData
+getAgentSMPServerStats s = do
+  _sentDirect <- readTVarIO $ sentDirect s
+  _sentViaProxy <- readTVarIO $ sentViaProxy s
+  _sentProxied <- readTVarIO $ sentProxied s
+  _sentDirectAttempts <- readTVarIO $ sentDirectAttempts s
+  _sentViaProxyAttempts <- readTVarIO $ sentViaProxyAttempts s
+  _sentProxiedAttempts <- readTVarIO $ sentProxiedAttempts s
+  _sentAuthErrs <- readTVarIO $ sentAuthErrs s
+  _sentQuotaErrs <- readTVarIO $ sentQuotaErrs s
+  _sentExpiredErrs <- readTVarIO $ sentExpiredErrs s
+  _sentOtherErrs <- readTVarIO $ sentOtherErrs s
+  _recvMsgs <- readTVarIO $ recvMsgs s
+  _recvDuplicates <- readTVarIO $ recvDuplicates s
+  _recvCryptoErrs <- readTVarIO $ recvCryptoErrs s
+  _recvErrs <- readTVarIO $ recvErrs s
+  _connCreated <- readTVarIO $ connCreated s
+  _connSecured <- readTVarIO $ connSecured s
+  _connCompleted <- readTVarIO $ connCompleted s
+  _connDeleted <- readTVarIO $ connDeleted s
+  _connSubscribed <- readTVarIO $ connSubscribed s
+  _connSubAttempts <- readTVarIO $ connSubAttempts s
+  _connSubErrs <- readTVarIO $ connSubErrs s
+  pure
+    AgentSMPServerStatsData
+      { _sentDirect,
+        _sentViaProxy,
+        _sentProxied,
+        _sentDirectAttempts,
+        _sentViaProxyAttempts,
+        _sentProxiedAttempts,
+        _sentAuthErrs,
+        _sentQuotaErrs,
+        _sentExpiredErrs,
+        _sentOtherErrs,
+        _recvMsgs,
+        _recvDuplicates,
+        _recvCryptoErrs,
+        _recvErrs,
+        _connCreated,
+        _connSecured,
+        _connCompleted,
+        _connDeleted,
+        _connSubscribed,
+        _connSubAttempts,
+        _connSubErrs
+      }
+
+data AgentXFTPServerStats = AgentXFTPServerStats
+  { uploads :: TVar Int, -- total replicas uploaded to server
+    uploadAttempts :: TVar Int, -- upload attempts
+    uploadErrs :: TVar Int, -- upload errors
+    downloads :: TVar Int, -- total replicas downloaded from server
+    downloadAttempts :: TVar Int, -- download attempts
+    downloadAuthErrs :: TVar Int, -- download AUTH errors
+    downloadErrs :: TVar Int, -- other download errors (excluding above)
+    deletions :: TVar Int, -- total replicas deleted from server
+    deleteAttempts :: TVar Int, -- delete attempts
+    deleteErrs :: TVar Int -- delete errors
+  }
+
+data AgentXFTPServerStatsData = AgentXFTPServerStatsData
+  { _uploads :: Int,
+    _uploadAttempts :: Int,
+    _uploadErrs :: Int,
+    _downloads :: Int,
+    _downloadAttempts :: Int,
+    _downloadAuthErrs :: Int,
+    _downloadErrs :: Int,
+    _deletions :: Int,
+    _deleteAttempts :: Int,
+    _deleteErrs :: Int
+  }
+  deriving (Show)
+
+newAgentXFTPServerStats :: STM AgentXFTPServerStats
+newAgentXFTPServerStats = do
+  uploads <- newTVar 0
+  uploadAttempts <- newTVar 0
+  uploadErrs <- newTVar 0
+  downloads <- newTVar 0
+  downloadAttempts <- newTVar 0
+  downloadAuthErrs <- newTVar 0
+  downloadErrs <- newTVar 0
+  deletions <- newTVar 0
+  deleteAttempts <- newTVar 0
+  deleteErrs <- newTVar 0
+  pure
+    AgentXFTPServerStats
+      { uploads,
+        uploadAttempts,
+        uploadErrs,
+        downloads,
+        downloadAttempts,
+        downloadAuthErrs,
+        downloadErrs,
+        deletions,
+        deleteAttempts,
+        deleteErrs
+      }
+
+newAgentXFTPServerStats' :: AgentXFTPServerStatsData -> STM AgentXFTPServerStats
+newAgentXFTPServerStats' s = do
+  uploads <- newTVar $ _uploads s
+  uploadAttempts <- newTVar $ _uploadAttempts s
+  uploadErrs <- newTVar $ _uploadErrs s
+  downloads <- newTVar $ _downloads s
+  downloadAttempts <- newTVar $ _downloadAttempts s
+  downloadAuthErrs <- newTVar $ _downloadAuthErrs s
+  downloadErrs <- newTVar $ _downloadErrs s
+  deletions <- newTVar $ _deletions s
+  deleteAttempts <- newTVar $ _deleteAttempts s
+  deleteErrs <- newTVar $ _deleteErrs s
+  pure
+    AgentXFTPServerStats
+      { uploads,
+        uploadAttempts,
+        uploadErrs,
+        downloads,
+        downloadAttempts,
+        downloadAuthErrs,
+        downloadErrs,
+        deletions,
+        deleteAttempts,
+        deleteErrs
+      }
+
+-- as this is used to periodically update stats in db,
+-- this is not STM to decrease contention with stats updates
+getAgentXFTPServerStats :: AgentXFTPServerStats -> IO AgentXFTPServerStatsData
+getAgentXFTPServerStats s = do
+  _uploads <- readTVarIO $ uploads s
+  _uploadAttempts <- readTVarIO $ uploadAttempts s
+  _uploadErrs <- readTVarIO $ uploadErrs s
+  _downloads <- readTVarIO $ downloads s
+  _downloadAttempts <- readTVarIO $ downloadAttempts s
+  _downloadAuthErrs <- readTVarIO $ downloadAuthErrs s
+  _downloadErrs <- readTVarIO $ downloadErrs s
+  _deletions <- readTVarIO $ deletions s
+  _deleteAttempts <- readTVarIO $ deleteAttempts s
+  _deleteErrs <- readTVarIO $ deleteErrs s
+  pure
+    AgentXFTPServerStatsData
+      { _uploads,
+        _uploadAttempts,
+        _uploadErrs,
+        _downloads,
+        _downloadAttempts,
+        _downloadAuthErrs,
+        _downloadErrs,
+        _deletions,
+        _deleteAttempts,
+        _deleteErrs
+      }
+
+-- Type for gathering both smp and xftp stats across all users and servers,
+-- to then be persisted to db as a single json.
+data AgentPersistedServerStats = AgentPersistedServerStats
+  { smpServersStats :: Map (UserId, SMPServer) AgentSMPServerStatsData,
+    xftpServersStats :: Map (UserId, XFTPServer) AgentXFTPServerStatsData
+  }
+  deriving (Show)
+
+$(J.deriveJSON defaultJSON ''AgentSMPServerStatsData)
+
+$(J.deriveJSON defaultJSON ''AgentXFTPServerStatsData)
+
+$(J.deriveJSON defaultJSON ''AgentPersistedServerStats)
+
+instance ToField AgentPersistedServerStats where
+  toField = toField . encodeJSON
+
+instance FromField AgentPersistedServerStats where
+  fromField = fromTextField_ decodeJSON
diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs
index 807ca223a..b9ffecbbd 100644
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -635,4 +635,6 @@ data StoreError
     SEDeletedSndChunkReplicaNotFound
   | -- | Error when reading work item that suspends worker - do not use!
     SEWorkItemError ByteString
+  | -- | Servers stats not found.
+    SEServersStatsNotFound
   deriving (Eq, Show, Exception)
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index a8b18c5b7..434344c89 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -210,6 +210,10 @@ module Simplex.Messaging.Agent.Store.SQLite
     deleteDeletedSndChunkReplica,
     getPendingDelFilesServers,
     deleteDeletedSndChunkReplicasExpired,
+    -- Stats
+    updateServersStats,
+    getServersStats,
+    resetServersStats,
 
     -- * utilities
     withConnection,
@@ -263,6 +267,7 @@ import Simplex.FileTransfer.Protocol (FileParty (..), SFileParty (..))
 import Simplex.FileTransfer.Types
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval (RI2State (..))
+import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite.Common
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
@@ -3017,6 +3022,21 @@ deleteDeletedSndChunkReplicasExpired db ttl = do
   cutoffTs <- addUTCTime (-ttl) <$> getCurrentTime
   DB.execute db "DELETE FROM deleted_snd_chunk_replicas WHERE created_at < ?" (Only cutoffTs)
 
+updateServersStats :: DB.Connection -> AgentPersistedServerStats -> IO ()
+updateServersStats db stats = do
+  updatedAt <- getCurrentTime
+  DB.execute db "UPDATE servers_stats SET servers_stats = ?, updated_at = ? WHERE servers_stats_id = 1" (stats, updatedAt)
+
+getServersStats :: DB.Connection -> IO (Either StoreError (UTCTime, Maybe AgentPersistedServerStats))
+getServersStats db =
+  firstRow id SEServersStatsNotFound $
+    DB.query_ db "SELECT started_at, servers_stats FROM servers_stats WHERE servers_stats_id = 1"
+
+resetServersStats :: DB.Connection -> IO ()
+resetServersStats db = do
+  currentTs <- getCurrentTime
+  DB.execute db "UPDATE servers_stats SET servers_stats = NULL, started_at = ?, updated_at = ? WHERE servers_stats_id = 1" (currentTs, currentTs)
+
 $(J.deriveJSON defaultJSON ''UpMigration)
 
 $(J.deriveToJSON (sumTypeJSON $ dropPrefix "ME") ''MigrationError)
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
index 5a5ed5b5b..340063f5c 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
@@ -72,6 +72,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240518_servers_stats
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -112,7 +113,8 @@ schemaMigrations =
     ("m20240124_file_redirect", m20240124_file_redirect, Just down_m20240124_file_redirect),
     ("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
     ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
-    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays)
+    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
+    ("m20240518_servers_stats", m20240518_servers_stats, Just down_m20240518_servers_stats)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240518_servers_stats.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240518_servers_stats.hs
new file mode 100644
index 000000000..fe017e233
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240518_servers_stats.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240518_servers_stats where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+-- servers_stats_id: dummy id, there should always only be one record with servers_stats_id = 1
+-- servers_stats: overall accumulated stats, past and session, reset to null on stats reset
+-- started_at: starting point of tracking stats, reset on stats reset
+m20240518_servers_stats :: Query
+m20240518_servers_stats =
+    [sql|
+CREATE TABLE servers_stats(
+  servers_stats_id INTEGER PRIMARY KEY,
+  servers_stats TEXT,
+  started_at TEXT NOT NULL DEFAULT(datetime('now')),
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+
+INSERT INTO servers_stats (servers_stats_id) VALUES (1);
+|]
+
+down_m20240518_servers_stats :: Query
+down_m20240518_servers_stats =
+    [sql|
+DROP TABLE servers_stats;
+|]
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
index caf94418a..50cf6d74a 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
@@ -394,6 +394,13 @@ CREATE TABLE processed_ratchet_key_hashes(
   created_at TEXT NOT NULL DEFAULT(datetime('now')),
   updated_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
+CREATE TABLE servers_stats(
+  servers_stats_id INTEGER PRIMARY KEY,
+  servers_stats TEXT,
+  started_at TEXT NOT NULL DEFAULT(datetime('now')),
+  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);
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index 37557cd23..b023f460a 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -8,16 +8,19 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except
+import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Aeson as J
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as LB
 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.Text.Encoding (decodeUtf8With, encodeUtf8)
 import Data.Time (NominalDiffTime)
 import GHC.Conc (labelThread, myThreadId, threadDelay)
 import UnliftIO
@@ -170,3 +173,9 @@ diffToMilliseconds diff = fromIntegral ((truncate $ diff * 1000) :: Integer)
 
 labelMyThread :: MonadIO m => String -> m ()
 labelMyThread label = liftIO $ myThreadId >>= (`labelThread` label)
+
+encodeJSON :: ToJSON a => a -> Text
+encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
+
+decodeJSON :: FromJSON a => Text -> Maybe a
+decodeJSON = J.decode . LB.fromStrict . encodeUtf8

From 9ee684b0f4051a43d0eee60eb7b9d99ea5262e30 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 30 Jun 2024 08:36:24 +0100
Subject: [PATCH 016/195] rfc: faster handshake protocol (#1203)

* rfc: faster handshake protocol

* update

* 1 message

* SKEY

* use SKEY for both parties

* test

* update doc

* NEW command parameter

* add k=s param to queue URI

* fix

* add sndSecure field to queues

* make sender key non-optional in SndQueue (WIP, tests fail)

* fast handshake sometimes works (many tests fail)

* correctly handle SKEY retries, avoiding to re-generate the keys

* handle SKEY retries during async connection

* fix most tests (1 test fails)

* remove do

* fix contact requests encoding/tests

* export

* fix: ignore duplicate confirmations, fixes testBatchedPendingMessages

* do not store sndSecure in store log if it is false to allow server downgrade

* add connection invitation encoding tests
---
 .../duplex-messaging/duplex-creating-v6.mmd   |  63 ++
 rfcs/2024-06-14-fast-connection.md            |  42 +
 simplexmq.cabal                               |   1 +
 src/Simplex/Messaging/Agent.hs                | 210 +++--
 src/Simplex/Messaging/Agent/Client.hs         |  35 +-
 src/Simplex/Messaging/Agent/Protocol.hs       |  60 +-
 src/Simplex/Messaging/Agent/QueryString.hs    |   7 +-
 src/Simplex/Messaging/Agent/Store.hs          |   9 +-
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  63 +-
 .../Agent/Store/SQLite/Migrations.hs          |   4 +-
 .../SQLite/Migrations/M20240624_snd_secure.hs |  36 +
 .../Store/SQLite/Migrations/agent_schema.sql  |   4 +-
 src/Simplex/Messaging/Client.hs               |  11 +-
 src/Simplex/Messaging/Protocol.hs             |  50 +-
 src/Simplex/Messaging/Server.hs               |  38 +-
 src/Simplex/Messaging/Server/QueueStore.hs    |   1 +
 src/Simplex/Messaging/Server/StoreLog.hs      |   7 +-
 src/Simplex/Messaging/Transport.hs            |  10 +-
 tests/AgentTests/ConnectionRequestTests.hs    | 296 ++++---
 tests/AgentTests/FunctionalAPITests.hs        | 793 ++++++++++--------
 tests/AgentTests/NotificationTests.hs         |  79 +-
 tests/AgentTests/SQLiteTests.hs               |  11 +-
 tests/CoreTests/TRcvQueuesTests.hs            |   1 +
 tests/NtfClient.hs                            |  17 +-
 tests/SMPAgentClient.hs                       |   6 +-
 tests/SMPClient.hs                            |  24 +-
 tests/SMPProxyTests.hs                        |  39 +-
 tests/ServerTests.hs                          |  26 +-
 tests/XFTPAgent.hs                            |  12 +-
 tests/XFTPClient.hs                           |   8 +-
 30 files changed, 1184 insertions(+), 779 deletions(-)
 create mode 100644 protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd
 create mode 100644 rfcs/2024-06-14-fast-connection.md
 create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240624_snd_secure.hs

diff --git a/protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd b/protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd
new file mode 100644
index 000000000..183e4bfa9
--- /dev/null
+++ b/protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd
@@ -0,0 +1,63 @@
+sequenceDiagram
+  participant A as Alice
+  participant AA as Alice's<br>agent
+  participant AS as Alice's<br>server
+  participant BS as Bob's<br>server
+  participant BA as Bob's<br>agent
+  participant B as Bob
+
+  note over AA, BA: status (receive/send): NONE/NONE
+
+  note over A, AA: 1. request connection<br>from agent
+  A ->> AA: NEW: create<br>duplex connection
+ 
+  note over AA, AS: 2. create Alice's SMP queue
+  AA ->> AS: NEW: create SMP queue
+  AS ->> AA: IDS: SMP queue IDs
+  note over AA: status: NEW/NONE
+
+  AA ->> A: INV: invitation<br>to connect
+
+  note over A, B: 3. out-of-band invitation
+  A ->> B: OOB: invitation to connect
+
+  note over BA, B: 4. accept connection
+  B ->> BA: JOIN:<br>via invitation info
+  note over BA: status: NONE/NEW
+
+  note over BA, AS: 5. secure Alice's SMP queue
+  BA ->> AS: SKEY: secure queue (this command needs to be proxied)
+  note over BA: status: NONE/SECURED
+
+  note over BA, BS: 6. create Bob's SMP queue
+  BA ->> BS: NEW: create SMP queue
+  BS ->> BA: IDS: SMP queue IDs
+  note over BA: status: NEW/SECURED
+
+  note over BA, AA: 7. confirm Alice's SMP queue
+  BA ->> AS: SEND: Bob's info without sender's key (SMP confirmation with reply queues)
+  note over BA: status: NEW/CONFIRMED
+
+  AS ->> AA: MSG: Bob's info without<br>sender server key
+  note over AA: status: CONFIRMED/NEW
+  AA ->> AS: ACK: confirm message
+
+  note over AA, BS: 8. secure Bob's SMP queue
+  AA ->> BS: SKEY: secure queue (this command needs to be proxied)
+  note over BA: status: CONFIRMED/SECURED
+
+  AA ->> BS: SEND: Alice's info without sender's server key (SMP confirmation without reply queues)
+  note over AA: status: CONFIRMED/CONFIRMED
+
+  note over AA, A: 9. notify Alice<br>about connection success<br>(no HELLO needed in v6)
+  AA ->> A: CON: connected
+  note over AA: status: ACTIVE/ACTIVE
+
+  BS ->> BA: MSG: Alice's info without<br>sender's server key
+  note over BA: status: CONFIRMED/CONFIRMED
+  BA ->> B: INFO: Alice's info
+  BA ->> BS: ACK: confirm message
+
+  note over BA, B: 10. notify Bob<br>about connection success
+  BA ->> B: CON: connected
+  note over BA: status: ACTIVE/ACTIVE
diff --git a/rfcs/2024-06-14-fast-connection.md b/rfcs/2024-06-14-fast-connection.md
new file mode 100644
index 000000000..000f0ef10
--- /dev/null
+++ b/rfcs/2024-06-14-fast-connection.md
@@ -0,0 +1,42 @@
+# Faster connection establishment
+
+## Problem
+
+SMP protocol is unidirectional, and to create a connection users have to agree two messaging queues.
+
+V1 of handshake protocol required 5 messages and multiple HELLO sent between the users, which consumed a lot of traffic.
+
+V2 of handshake protocol was optimized to remove multiple HELLO and also REPLY message, thanks to including queue address together with the key to secure this queue into the confirmation message.
+
+This eliminated unnecessary traffic from repeated HELLOs, but still requires 4 messages in total and 2 times of each client being online. It is perceived by the users as "it didn't work" (because they see "connecting" after using the link) or "we have to be online at the same time" (and even in this case it is slow on bad network). This hurts usability and creates churn of the new users, as unless people are onboarded by the friends who know how the app works, they cannot figure out how to connect.
+
+Ideally, we want to have handshake protocol design when an accepting user can send messages straight after using the link (their client says "connected") and the initiating client can send messages as soon as it received confirmation message with the profile.
+
+This RFC proposes modifications to SMP and SMP Agent protocols to reduce the number of required messages to 2 and allows accepting client to send messages straight after using the link (and sending the confirmation), before receiving the profile of the initiating client in the second message, and the initiating client can send the messages straight after processing the confirmation and sending its own confirmation.
+
+## Solution
+
+The current protocol design allows additional confirmation step where the initiating client can confirm the connection having received the profile of the sender. We don't use it in the UI - this confirmation is done automatically and unconditionally.
+
+Instead of requiring the initiating client to secure its queue with sender's key, we can allow the accepting client to secure it with the additional SKEY command. This would avoid "connecting" state but would introduce "Profile unknown" state where the accepting client does not yet have the profile of the initiating client. In this case we could also use the non-optional alias created during the connection (or have something like "Add alias to be able to send messages immediately" and show warning if the user proceeds without it).
+
+The additional advantage here is that if the queue of the initiating client was removed, the connection will not procede to create additional queue, failing faster.
+
+These are the proposed changes:
+
+1. Modify NEW command to add flag allowing sender to secure the queue (it should not be allowed if queue is created for the contact address).
+2. Include flag into the invitation link URI and in reply address encoding that queue(s) can be secured by the sender (to avoid coupling with the protocol version and preserve the possibility of the longer handshakes).
+3. Add SKEY command to SMP protocol to allow the sender securing the message queue.
+4. This command has to be supported by SMP proxy as well, so that the sender does not connect to the recipient's server directly.
+5. Accepting client will secure the messaging queue before sending the confirmation to it.
+6. Initiating client will secure the messaging queue before sending the confirmation.
+
+See [this sequence diagram](../protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd) for the updated handshake protocol.
+
+Changes to threat model: the attacker who compromised TLS and knows the queue address can block the connection, as the protocol no longer requires the recipient to decrypt the confirmation to secure the queue.
+
+Possibly, "fast connection" should be an option in Privacy & security settings.
+
+## Implementation questions
+
+Currently we store received confirmations in the database, so that the client can confirm them. This becomes unnecessary.
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 2474cebd4..d46b58dc2 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -134,6 +134,7 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240518_servers_stats
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
       Simplex.Messaging.Agent.TRcvQueues
       Simplex.Messaging.Client
       Simplex.Messaging.Client.Agent
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 0c433cfed..121c1a1f4 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -175,7 +175,7 @@ import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfReg
 import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..))
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
-import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), EntityId, ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, XFTPServerWithAuth)
+import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), EntityId, ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, XFTPServerWithAuth, sndAuthKeySMPClientVersion)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
@@ -751,7 +751,8 @@ newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv
     (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv"
     _ -> pure ()
   AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
-  (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srvWithAuth smpClientVRange subMode `catchAgentError` \e -> liftIO (print e) >> throwE e
+  let sndSecure = case cMode of SCMInvitation -> True; SCMContact -> False
+  (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srvWithAuth smpClientVRange subMode sndSecure `catchAgentError` \e -> liftIO (print e) >> throwE e
   atomically $ incSMPServerStat c userId srv connCreated
   rq' <- withStore c $ \db -> updateNewConnRcv db connId rq
   lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
@@ -771,7 +772,7 @@ newConnToJoin :: forall c. AgentClient -> UserId -> ConnId -> Bool -> Connection
 newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of
   CRInvitationUri {} ->
     lift (compatibleInvitationUri cReq) >>= \case
-      Just (_, (Compatible (CR.E2ERatchetParams v _ _ _)), aVersion) -> create aVersion (Just v)
+      Just (_, Compatible (CR.E2ERatchetParams v _ _ _), aVersion) -> create aVersion (Just v)
       Nothing -> throwE $ AGENT A_VERSION
   CRContactUri {} ->
     lift (compatibleContactUri cReq) >>= \case
@@ -793,10 +794,10 @@ joinConn c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode = do
     _ -> getSMPServer c userId
   joinConnSrv c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode srv
 
-startJoinInvitation :: UserId -> ConnId -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, NewSndQueue, CR.Ratchet 'C.X448, CR.SndE2ERatchetParams 'C.X448)
-startJoinInvitation userId connId enableNtfs cReqUri pqSup =
+startJoinInvitation :: UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, NewSndQueue, C.PublicKeyX25519, CR.Ratchet 'C.X448, CR.SndE2ERatchetParams 'C.X448)
+startJoinInvitation userId connId sq_ enableNtfs cReqUri pqSup =
   lift (compatibleInvitationUri cReqUri) >>= \case
-    Just (qInfo, (Compatible e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_)), Compatible connAgentVersion) -> do
+    Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_), Compatible connAgentVersion) -> do
       g <- asks random
       let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v)
       (pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport)
@@ -805,9 +806,13 @@ startJoinInvitation userId connId enableNtfs cReqUri pqSup =
       maxSupported <- asks $ maxVersion . e2eEncryptVRange . config
       let rcVs = CR.RatchetVersions {current = v, maxSupported}
           rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams
-      q <- lift $ newSndQueue userId "" qInfo
+      -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out
+      -- e2ePubKey is always present, it's Maybe historically
+      (q, e2ePubKey) <- case sq_ of
+        Just sq@SndQueue {e2ePubKey = Just k} -> pure ((sq :: SndQueue) {dbQueueId = DBNewQueue}, k)
+        _ -> lift $ newSndQueue userId "" qInfo
       let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
-      pure (cData, q, rc, e2eSndParams)
+      pure (cData, q, e2ePubKey, rc, e2eSndParams)
     Nothing -> throwE $ AGENT A_VERSION
 
 connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport))
@@ -843,7 +848,7 @@ versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && ma
 joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ConnId
 joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv =
   withInvLock c (strEncode inv) "joinConnSrv" $ do
-    (cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqSup
+    (cData, q, _, rc, e2eSndParams) <- startJoinInvitation userId connId Nothing enableNtfs inv pqSup
     g <- asks random
     (connId', sq) <- withStore c $ \db -> runExceptT $ do
       r@(connId', _) <-
@@ -853,7 +858,10 @@ joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo p
       liftIO $ createRatchet db connId' rc
       pure r
     let cData' = (cData :: ConnData) {connId = connId'}
-    tryError (confirmQueue c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case
+    -- joinConnSrv is only used on user interaction, and its failure is permanent,
+    -- otherwise we would need to manage retries here to avoid SndQueue recreated with a different key,
+    -- similar to how joinConnAsync does that.
+    tryError (secureConfirmQueue c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case
       Right _ -> pure connId'
       Left e -> do
         -- possible improvement: recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md
@@ -869,17 +877,26 @@ joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo
 
 joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ()
 joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = do
-  (cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqSupport
-  q' <- withStore c $ \db -> runExceptT $ do
-    liftIO $ createRatchet db connId rc
-    ExceptT $ updateNewConnSnd db connId q
-  confirmQueueAsync c cData q' srv cInfo (Just e2eSndParams) subMode
+  SomeConn cType conn <- withStore c (`getConn` connId)
+  case conn of
+    NewConnection _ -> doJoin Nothing
+    SndConnection _ sq -> doJoin $ Just sq
+    _ -> throwE $ CMD PROHIBITED $ "joinConnSrvAsync: bad connection " <> show cType
+  where
+    doJoin :: Maybe SndQueue -> AM ()
+    doJoin sq_ = do
+      (cData, sq, _, rc, e2eSndParams) <- startJoinInvitation userId connId sq_ enableNtfs inv pqSupport
+      sq' <- withStore c $ \db -> runExceptT $ do
+        liftIO $ createRatchet db connId rc
+        maybe (ExceptT $ updateNewConnSnd db connId sq) pure sq_
+      secureConfirmQueueAsync c cData sq' srv cInfo (Just e2eSndParams) subMode
 joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _pqSupport _srv = do
   throwE $ CMD PROHIBITED "joinConnSrvAsync"
 
 createReplyQueue :: AgentClient -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo
 createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVersion} subMode srv = do
-  (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv (versionToRange smpClientVersion) subMode
+  let sndSecure = smpClientVersion >= sndAuthKeySMPClientVersion
+  (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv (versionToRange smpClientVersion) subMode sndSecure
   let qInfo = toVersionT qUri smpClientVersion
   rq' <- withStore c $ \db -> upgradeSndConnToDuplex db connId rq
   lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
@@ -1156,8 +1173,11 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
             withStore c $ \db -> runExceptT $ (,) <$> ExceptT (getConn db connId) <*> ExceptT (getAcceptedConfirmation db connId)
           case conn of
             RcvConnection cData rq -> do
-              secure rq senderKey
-              mapM_ (connectReplyQueues c cData ownConnInfo) (L.nonEmpty $ smpReplyQueues senderConf)
+              mapM_ (secure rq) senderKey
+              mapM_ (connectReplyQueues c cData ownConnInfo Nothing) (L.nonEmpty $ smpReplyQueues senderConf)
+            -- duplex connection is matched to handle SKEY retries
+            DuplexConnection cData _ (sq :| _) ->
+              mapM_ (connectReplyQueues c cData ownConnInfo (Just sq)) (L.nonEmpty $ smpReplyQueues senderConf)
             _ -> throwE $ INTERNAL $ "incorrect connection type " <> show (internalCmdTag cmd)
         ICDuplexSecure _rId senderKey -> withServer' . tryWithLock "ICDuplexSecure" . withDuplexConn $ \(DuplexConnection cData (rq :| _) (sq :| _)) -> do
           secure rq senderKey
@@ -1332,7 +1352,7 @@ submitPendingMsg c cData sq = do
   void $ getDeliveryWorker True c cData sq
 
 runSmpQueueMsgDelivery :: AgentClient -> ConnData -> SndQueue -> (Worker, TMVar ()) -> AM ()
-runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userId, server} (Worker {doWork}, qLock) = do
+runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userId, server, sndSecure} (Worker {doWork}, qLock) = do
   AgentConfig {messageRetryInterval = ri, messageTimeout, helloTimeout, quotaExceededTimeout} <- asks config
   forever $ do
     atomically $ endAgentOperation c AOSndNetwork
@@ -1380,7 +1400,6 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
                       Just _ -> connError msgId NOT_AVAILABLE
                       -- party joining connection
                       _ -> connError msgId NOT_ACCEPTED
-                    AM_REPLY_ -> notifyDel msgId err
                     AM_A_MSG_ -> notifyDel msgId err
                     AM_A_RCVD_ -> notifyDel msgId err
                     AM_QCONT_ -> notifyDel msgId err
@@ -1409,10 +1428,11 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
                   retrySndOp c $ loop riMode
             Right proxySrv_ -> do
               case msgType of
-                AM_CONN_INFO -> setConfirmed
-                AM_CONN_INFO_REPLY -> setConfirmed
+                AM_CONN_INFO
+                  | sndSecure -> notify (CON pqEncryption) >> setStatus Active
+                  | otherwise -> setStatus Confirmed
+                AM_CONN_INFO_REPLY -> setStatus Confirmed
                 AM_RATCHET_INFO -> pure ()
-                AM_REPLY_ -> pure ()
                 AM_HELLO_ -> do
                   withStore' c $ \db -> setSndQueueStatus db sq Active
                   case rq_ of
@@ -1469,9 +1489,9 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
                 AM_EREADY_ -> pure ()
               delMsgKeep (msgType == AM_A_MSG_) msgId
               where
-                setConfirmed = do
+                setStatus status = do
                   withStore' c $ \db -> do
-                    setSndQueueStatus db sq Confirmed
+                    setSndQueueStatus db sq status
                     when (isJust rq_) $ removeConfirmations db connId
   where
     notifyDelMsgs :: InternalId -> AgentErrorType -> UTCTime -> AM ()
@@ -1558,13 +1578,14 @@ switchConnection' c connId =
       _ -> throwE $ CMD PROHIBITED "switchConnection: not duplex"
 
 switchDuplexConnection :: AgentClient -> Connection 'CDuplex -> RcvQueue -> AM ConnectionStats
-switchDuplexConnection c (DuplexConnection cData@ConnData {connId, userId} rqs sqs) rq@RcvQueue {server, dbQueueId = DBQueueId dbQueueId, sndId} = do
+switchDuplexConnection c (DuplexConnection cData@ConnData {connId, userId, connAgentVersion} rqs sqs) rq@RcvQueue {server, dbQueueId = DBQueueId dbQueueId, sndId} = do
   checkRQSwchStatus rq RSSwitchStarted
   clientVRange <- asks $ smpClientVRange . config
   -- try to get the server that is different from all queues, or at least from the primary rcv queue
   srvAuth@(ProtoServerWithAuth srv _) <- getNextServer c userId $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
   srv' <- if srv == server then getNextServer c userId [server] else pure srvAuth
-  (q, qUri, tSess, sessId) <- newRcvQueue c userId connId srv' clientVRange SMSubscribe
+  let sndSecure = connAgentVersion >= sndAuthKeySMPAgentVersion
+  (q, qUri, tSess, sessId) <- newRcvQueue c userId connId srv' clientVRange SMSubscribe sndSecure
   let rq' = (q :: NewRcvQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
   rq'' <- withStore c $ \db -> addConnRcvQueue db connId rq'
   lift $ addNewQueueSubscription c rq'' tSess sessId
@@ -2191,7 +2212,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
     notifyErr connId = notify' connId . ERR . protocolClientError SMP (B.unpack $ strEncode srv)
     processSMP :: forall c. RcvQueue -> Connection c -> ConnData -> BrokerMsg -> AM ()
     processSMP
-      rq@RcvQueue {rcvId = rId, e2ePrivKey, e2eDhSecret, status}
+      rq@RcvQueue {rcvId = rId, sndSecure, e2ePrivKey, e2eDhSecret, status}
       conn
       cData@ConnData {userId, connId, connAgentVersion, ratchetSyncState = rss}
       smpMsg =
@@ -2220,7 +2241,10 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                     let e2eDh = C.dh' e2ePubKey e2ePrivKey
                     decryptClientMessage e2eDh clientMsg >>= \case
                       (SMP.PHConfirmation senderKey, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) ->
-                        smpConfirmation srvMsgId conn senderKey e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack
+                        smpConfirmation srvMsgId conn (Just senderKey) e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack
+                      (SMP.PHEmpty, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion})
+                        | sndSecure -> smpConfirmation srvMsgId conn Nothing e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack
+                        | otherwise -> prohibited "handshake: missing sender key" >> ack
                       (SMP.PHEmpty, AgentInvitation {connReq, connInfo}) ->
                         smpInvitation srvMsgId conn connReq connInfo >> ack
                       _ -> prohibited "handshake: incorrect state" >> ack
@@ -2348,7 +2372,12 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                                 pure $ Just (internalId, msgMeta, aMessage, rc)
                               _ -> pure Nothing
                       _ -> prohibited "msg: bad client msg" >> ack
-                  _ -> prohibited "msg: no keys" >> ack
+                  (Just e2eDh, Just _) ->
+                    decryptClientMessage e2eDh clientMsg >>= \case
+                      -- this is a repeated confirmation delivery because ack failed to be sent
+                      (_, AgentConfirmation {}) -> ack
+                      _ -> prohibited "msg: public header" >> ack
+                  (Nothing, Nothing) -> prohibited "msg: no keys" >> ack
               updateConnVersion :: Connection c -> ConnData -> VersionSMPA -> AM (Connection c)
               updateConnVersion conn' cData' msgAgentVersion = do
                 aVRange <- asks $ smpAgentVRange . config
@@ -2385,8 +2414,10 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
           notify :: forall e m. (AEntityI e, MonadIO m) => AEvent e -> m ()
           notify = notify' connId
 
-          prohibited :: String -> AM ()
-          prohibited = notify . ERR . AGENT . A_PROHIBITED
+          prohibited :: Text -> AM ()
+          prohibited s = do
+            logError $ "prohibited: " <> s
+            notify . ERR . AGENT $ A_PROHIBITED $ T.unpack s
 
           enqueueCmd :: InternalCommand -> AM ()
           enqueueCmd = enqueueCommand c "" connId (Just srv) . AInternalCommand
@@ -2413,7 +2444,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
           parseMessage :: Encoding a => ByteString -> AM a
           parseMessage = liftEither . parse smpP (AGENT A_MESSAGE)
 
-          smpConfirmation :: SMP.MsgId -> Connection c -> C.APublicAuthKey -> C.PublicKeyX25519 -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> ByteString -> VersionSMPC -> VersionSMPA -> AM ()
+          smpConfirmation :: SMP.MsgId -> Connection c -> Maybe C.APublicAuthKey -> C.PublicKeyX25519 -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> ByteString -> VersionSMPC -> VersionSMPA -> AM ()
           smpConfirmation srvMsgId conn' senderKey e2ePubKey e2eEncryption encConnInfo smpClientVersion agentVersion = do
             logServer "<--" c srv rId $ "MSG <CONF>:" <> logSecret srvMsgId
             AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
@@ -2436,8 +2467,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                   case (agentMsgBody_, skipped) of
                     (Right agentMsgBody, CR.SMDNoChange) ->
                       parseMessage agentMsgBody >>= \case
-                        AgentConnInfoReply smpQueues connInfo ->
+                        AgentConnInfoReply smpQueues connInfo -> do
                           processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion}
+                          withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody)
                         _ -> prohibited "conf: not AgentConnInfoReply" -- including AgentConnInfo, that is prohibited here in v2
                       where
                         processConf connInfo senderConf = do
@@ -2450,14 +2482,21 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                           notify $ CONF confId pqSupport' srvs connInfo
                     _ -> prohibited "conf: decrypt error or skipped"
                 -- party accepting connection
-                (DuplexConnection _ (RcvQueue {smpClientVersion = v'} :| _) _, Nothing) -> do
+                (DuplexConnection _ (rq'@RcvQueue {smpClientVersion = v'} :| _) _, Nothing) -> do
                   g <- asks random
-                  withStore c (\db -> runExceptT $ agentRatchetDecrypt g db connId encConnInfo) >>= parseMessage . fst >>= \case
+                  (agentMsgBody, pqEncryption) <- withStore c $ \db -> runExceptT $ agentRatchetDecrypt g db connId encConnInfo
+                  parseMessage agentMsgBody >>= \case
                     AgentConnInfo connInfo -> do
                       notify $ INFO pqSupport connInfo
                       let dhSecret = C.dh' e2ePubKey e2ePrivKey
-                      withStore' c $ \db -> setRcvQueueConfirmedE2E db rq dhSecret $ min v' smpClientVersion
-                      enqueueCmd $ ICDuplexSecure rId senderKey
+                      withStore' c $ \db -> do
+                        setRcvQueueConfirmedE2E db rq dhSecret $ min v' smpClientVersion
+                        updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody)
+                      case senderKey of
+                        Just k -> enqueueCmd $ ICDuplexSecure rId k
+                        Nothing -> do
+                          notify $ CON pqEncryption
+                          withStore' c $ \db -> setRcvQueueStatus db rq' Active
                     _ -> prohibited "conf: not AgentConnInfo"
                 _ -> prohibited "conf: incorrect state"
               _ -> prohibited "conf: status /= new"
@@ -2533,21 +2572,17 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                     let (delSqs, keepSqs) = L.partition ((Just dbQueueId ==) . dbReplaceQId) sqs
                     case L.nonEmpty keepSqs of
                       Just sqs' -> do
-                        -- move inside case?
-                        sq_@SndQueue {sndPublicKey, e2ePubKey} <- lift $ newSndQueue userId connId qInfo
+                        (sq_@SndQueue {sndPublicKey}, dhPublicKey) <- lift $ newSndQueue userId connId qInfo
                         sq2 <- withStore c $ \db -> do
                           liftIO $ mapM_ (deleteConnSndQueue db connId) delSqs
                           addConnSndQueue db connId (sq_ :: NewSndQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
-                        case (sndPublicKey, e2ePubKey) of
-                          (Just sndPubKey, Just dhPublicKey) -> do
-                            logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret srvMsgId <> " " <> logSecret (senderId queueAddress)
-                            let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
-                            void . enqueueMessages c cData' sqs SMP.noMsgFlags $ QKEY [(sqInfo', sndPubKey)]
-                            sq1 <- withStore' c $ \db -> setSndSwitchStatus db sq $ Just SSSendingQKEY
-                            let sqs'' = updatedQs sq1 sqs' <> [sq2]
-                                conn' = DuplexConnection cData' rqs sqs''
-                            notify . SWITCH QDSnd SPStarted $ connectionStats conn'
-                          _ -> qError "absent sender keys"
+                        logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret srvMsgId <> " " <> logSecret (senderId queueAddress)
+                        let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
+                        void . enqueueMessages c cData' sqs SMP.noMsgFlags $ QKEY [(sqInfo', sndPublicKey)]
+                        sq1 <- withStore' c $ \db -> setSndSwitchStatus db sq $ Just SSSendingQKEY
+                        let sqs'' = updatedQs sq1 sqs' <> [sq2]
+                            conn' = DuplexConnection cData' rqs sqs''
+                        notify . SWITCH QDSnd SPStarted $ connectionStats conn'
                       _ -> qError "QADD: won't delete all snd queues in connection"
                   _ -> qError "QADD: replaced queue address is not found in connection"
               _ -> throwE $ AGENT A_VERSION
@@ -2717,23 +2752,30 @@ switchStatusError q expected actual =
       <> (", expected=" <> show expected)
       <> (", actual=" <> show actual)
 
-connectReplyQueues :: AgentClient -> ConnData -> ConnInfo -> NonEmpty SMPQueueInfo -> AM ()
-connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo (qInfo :| _) = do
+connectReplyQueues :: AgentClient -> ConnData -> ConnInfo -> Maybe SndQueue -> NonEmpty SMPQueueInfo -> AM ()
+connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _) = do
   clientVRange <- asks $ smpClientVRange . config
   case qInfo `proveCompatible` clientVRange of
     Nothing -> throwE $ AGENT A_VERSION
     Just qInfo' -> do
-      sq <- lift $ newSndQueue userId connId qInfo'
-      sq' <- withStore c $ \db -> upgradeRcvConnToDuplex db connId sq
+      -- in case of SKEY retry the connection is already duplex
+      sq' <- maybe upgradeConn pure sq_
+      agentSecureSndQueue c sq'
       enqueueConfirmation c cData sq' ownConnInfo Nothing
+      where
+        upgradeConn = do
+          (sq, _) <- lift $ newSndQueue userId connId qInfo'
+          withStore c $ \db -> upgradeRcvConnToDuplex db connId sq
 
-confirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
-confirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do
+secureConfirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
+secureConfirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do
+  agentSecureSndQueue c sq
   storeConfirmation c cData sq e2eEncryption_ =<< mkAgentConfirmation c cData sq srv connInfo subMode
   lift $ submitPendingMsg c cData sq
 
-confirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
-confirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connInfo e2eEncryption_ subMode = do
+secureConfirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
+secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connInfo e2eEncryption_ subMode = do
+  agentSecureSndQueue c sq
   msg <- mkConfirmation =<< mkAgentConfirmation c cData sq srv connInfo subMode
   void $ sendConfirmation c sq msg
   withStore' c $ \db -> setSndQueueStatus db sq Confirmed
@@ -2742,11 +2784,19 @@ confirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connI
     mkConfirmation aMessage = do
       currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config
       withStore c $ \db -> runExceptT $ do
-        void . liftIO $ updateSndIds db connId
+        let agentMsgBody = smpEncode aMessage
+        (_, internalSndId, _) <- liftIO $ updateSndIds db connId
+        liftIO $ updateSndMsgHash db connId internalSndId (C.sha256Hash agentMsgBody)
         let pqEnc = CR.pqSupportToEnc pqSupport
-        (encConnInfo, _) <- agentRatchetEncrypt db cData (smpEncode aMessage) e2eEncConnInfoLength (Just pqEnc) currentE2EVersion
+        (encConnInfo, _) <- agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just pqEnc) currentE2EVersion
         pure . smpEncode $ AgentConfirmation {agentVersion = connAgentVersion, e2eEncryption_, encConnInfo}
 
+agentSecureSndQueue :: AgentClient -> SndQueue -> AM ()
+agentSecureSndQueue c sq@SndQueue {sndSecure, status} =
+  when (sndSecure && status == New) $ do
+    secureSndQueue c sq
+    withStore' c $ \db -> setSndQueueStatus db sq Secured
+
 mkAgentConfirmation :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> SubscriptionMode -> AM AgentMessage
 mkAgentConfirmation c cData sq srv connInfo subMode = do
   qInfo <- createReplyQueue c cData sq subMode srv
@@ -2822,26 +2872,28 @@ agentRatchetDecrypt' g db connId rc encAgentMsg = do
   liftIO $ updateRatchet db connId rc' skippedDiff
   liftEither $ bimap (SEAgentError . cryptoError) (,CR.rcRcvKEM rc') agentMsgBody_
 
-newSndQueue :: UserId -> ConnId -> Compatible SMPQueueInfo -> AM' NewSndQueue
-newSndQueue userId connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey = rcvE2ePubDhKey})) = do
+newSndQueue :: UserId -> ConnId -> Compatible SMPQueueInfo -> AM' (NewSndQueue, C.PublicKeyX25519)
+newSndQueue userId connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAddress {smpServer, senderId, sndSecure, dhPublicKey = rcvE2ePubDhKey})) = do
   C.AuthAlg a <- asks $ sndAuthAlg . config
   g <- asks random
   (sndPublicKey, sndPrivateKey) <- atomically $ C.generateAuthKeyPair a g
   (e2ePubKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
-  pure
-    SndQueue
-      { userId,
-        connId,
-        server = smpServer,
-        sndId = senderId,
-        sndPublicKey = Just sndPublicKey,
-        sndPrivateKey,
-        e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
-        e2ePubKey = Just e2ePubKey,
-        status = New,
-        dbQueueId = DBNewQueue,
-        primary = True,
-        dbReplaceQueueId = Nothing,
-        sndSwchStatus = Nothing,
-        smpClientVersion
-      }
+  let sq =
+        SndQueue
+          { userId,
+            connId,
+            server = smpServer,
+            sndId = senderId,
+            sndSecure,
+            sndPublicKey,
+            sndPrivateKey,
+            e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
+            e2ePubKey = Just e2ePubKey,
+            status = New,
+            dbQueueId = DBNewQueue,
+            primary = True,
+            dbReplaceQueueId = Nothing,
+            sndSwchStatus = Nothing,
+            smpClientVersion
+          }
+  pure (sq, e2ePubKey)
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index ec8424745..2f48ee17e 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -53,6 +53,7 @@ module Simplex.Messaging.Agent.Client
     temporaryOrHostError,
     serverHostError,
     secureQueue,
+    secureSndQueue,
     enableQueueNotifications,
     enableQueuesNtfs,
     disableQueueNotifications,
@@ -73,7 +74,6 @@ module Simplex.Messaging.Agent.Client
     agentXFTPUploadChunk,
     agentXFTPAddRecipients,
     agentXFTPDeleteChunk,
-    agentCbEncrypt,
     agentCbDecrypt,
     cryptoError,
     sendAck,
@@ -240,6 +240,7 @@ import Simplex.Messaging.Protocol
     RcvNtfPublicDhKey,
     SMPMsgMeta (..),
     SProtocolType (..),
+    SenderCanSecure,
     SndPublicAuthKey,
     SubscriptionMode (..),
     UserProtocol,
@@ -1196,11 +1197,14 @@ runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
     getProtocolClient g tSess cfg Nothing (\_ -> pure ()) >>= \case
       Right smp -> do
         rKeys@(_, rpKey) <- atomically $ C.generateAuthKeyPair ra g
-        (sKey, _) <- atomically $ C.generateAuthKeyPair sa g
+        (sKey, spKey) <- atomically $ C.generateAuthKeyPair sa g
         (dhKey, _) <- atomically $ C.generateKeyPair g
         r <- runExceptT $ do
-          SMP.QIK {rcvId} <- liftError (testErr TSCreateQueue) $ createSMPQueue smp rKeys dhKey auth SMSubscribe
-          liftError (testErr TSSecureQueue) $ secureSMPQueue smp rpKey rcvId sKey
+          SMP.QIK {rcvId, sndId, sndSecure} <- liftError (testErr TSCreateQueue) $ createSMPQueue smp rKeys dhKey auth SMSubscribe True
+          liftError (testErr TSSecureQueue) $
+            if sndSecure
+              then secureSndSMPQueue smp spKey sndId sKey
+              else secureSMPQueue smp rpKey rcvId sKey
           liftError (testErr TSDeleteQueue) $ deleteSMPQueue smp rpKey rcvId
         ok <- tcpTimeout (networkConfig cfg) `timeout` closeProtocolClient smp
         pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
@@ -1307,8 +1311,8 @@ getSessionMode :: AgentClient -> IO TransportSessionMode
 getSessionMode = atomically . fmap sessionMode . getNetworkConfig
 {-# INLINE getSessionMode #-}
 
-newRcvQueue :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SubscriptionMode -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
-newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
+newRcvQueue :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SubscriptionMode -> SenderCanSecure -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
+newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode senderCanSecure = do
   C.AuthAlg a <- asks (rcvAuthAlg . config)
   g <- asks random
   rKeys@(_, rcvPrivateKey) <- atomically $ C.generateAuthKeyPair a g
@@ -1316,9 +1320,9 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
   (e2eDhKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
   logServer "-->" c srv "" "NEW"
   tSess <- liftIO $ mkTransportSession c userId srv connId
-  (sessId, QIK {rcvId, sndId, rcvPublicDhKey}) <-
+  (sessId, QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}) <-
     withClient c tSess "NEW" $ \(SMPConnectedClient smp _) ->
-      (sessionId $ thParams smp,) <$> createSMPQueue smp rKeys dhKey auth subMode
+      (sessionId $ thParams smp,) <$> createSMPQueue smp rKeys dhKey auth subMode senderCanSecure
   liftIO . logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
   let rq =
         RcvQueue
@@ -1331,6 +1335,7 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
             e2ePrivKey,
             e2eDhSecret = Nothing,
             sndId,
+            sndSecure,
             status = New,
             dbQueueId = DBNewQueue,
             primary = True,
@@ -1340,7 +1345,7 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
             clientNtfCreds = Nothing,
             deleteErrors = 0
           }
-      qUri = SMPQueueUri vRange $ SMPQueueAddress srv sndId e2eDhKey
+      qUri = SMPQueueUri vRange $ SMPQueueAddress srv sndId e2eDhKey sndSecure
   pure (rq, qUri, tSess, sessId)
 
 processSubResult :: AgentClient -> RcvQueue -> Either SMPClientError () -> STM ()
@@ -1524,10 +1529,11 @@ logSecret bs = encode $ B.take 3 bs
 {-# INLINE logSecret #-}
 
 sendConfirmation :: AgentClient -> SndQueue -> ByteString -> AM (Maybe SMPServer)
-sendConfirmation c sq@SndQueue {userId, server, sndId, sndPublicKey = Just sndPublicKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = do
-  let clientMsg = SMP.ClientMessage (SMP.PHConfirmation sndPublicKey) agentConfirmation
+sendConfirmation c sq@SndQueue {userId, server, sndId, sndSecure, sndPublicKey, sndPrivateKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = do
+  let (privHdr, spKey) = if sndSecure then (SMP.PHEmpty, Just sndPrivateKey) else (SMP.PHConfirmation sndPublicKey, Nothing)
+      clientMsg = SMP.ClientMessage privHdr agentConfirmation
   msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
-  sendOrProxySMPMessage c userId server "<CONF>" Nothing sndId (MsgFlags {notification = True}) msg
+  sendOrProxySMPMessage c userId server "<CONF>" spKey sndId (MsgFlags {notification = True}) msg
 sendConfirmation _ _ _ = throwE $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
 
 sendInvitation :: AgentClient -> UserId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM (Maybe SMPServer)
@@ -1568,6 +1574,11 @@ secureQueue c rq@RcvQueue {rcvId, rcvPrivateKey} senderKey =
   withSMPClient c rq "KEY <key>" $ \smp ->
     secureSMPQueue smp rcvPrivateKey rcvId senderKey
 
+secureSndQueue :: AgentClient -> SndQueue -> AM ()
+secureSndQueue c sq@SndQueue {sndId, sndPrivateKey, sndPublicKey} =
+  withSMPClient c sq "SKEY <key>" $ \smp ->
+    secureSndSMPQueue smp sndPrivateKey sndId sndPublicKey
+
 enableQueueNotifications :: AgentClient -> RcvQueue -> SMP.NtfPublicAuthKey -> SMP.RcvNtfPublicDhKey -> AM (SMP.NotifierId, SMP.RcvNtfPublicDhKey)
 enableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} notifierKey rcvNtfPublicDhKey =
   withSMPClient c rq "NKEY <nkey>" $ \smp ->
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index d6bbc13ca..b123fc1ec 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -41,6 +41,7 @@ module Simplex.Messaging.Agent.Protocol
     ratchetSyncSMPAgentVersion,
     deliveryRcptsSMPAgentVersion,
     pqdrSMPAgentVersion,
+    sndAuthKeySMPAgentVersion,
     currentSMPAgentVersion,
     supportedSMPAgentVRange,
     e2eEncConnInfoLength,
@@ -208,6 +209,7 @@ import Simplex.Messaging.Protocol
     legacyStrEncodeServer,
     noAuthSrv,
     sameSrvAddr,
+    sndAuthKeySMPClientVersion,
     srvHostnamesSMPClientVersion,
     pattern ProtoServerWithAuth,
     pattern SMPServer,
@@ -227,6 +229,7 @@ import UnliftIO.Exception (Exception)
 -- 3 - support ratchet renegotiation (6/30/2023)
 -- 4 - delivery receipts (7/13/2023)
 -- 5 - post-quantum double ratchet (3/14/2024)
+-- 6 - secure reply queues with provided keys (6/14/2024)
 
 data SMPAgentVersion
 
@@ -251,11 +254,17 @@ deliveryRcptsSMPAgentVersion = VersionSMPA 4
 pqdrSMPAgentVersion :: VersionSMPA
 pqdrSMPAgentVersion = VersionSMPA 5
 
+sndAuthKeySMPAgentVersion :: VersionSMPA
+sndAuthKeySMPAgentVersion = VersionSMPA 6
+
+minSupportedSMPAgentVersion :: VersionSMPA
+minSupportedSMPAgentVersion = duplexHandshakeSMPAgentVersion
+
 currentSMPAgentVersion :: VersionSMPA
-currentSMPAgentVersion = VersionSMPA 5
+currentSMPAgentVersion = VersionSMPA 6
 
 supportedSMPAgentVRange :: VersionRangeSMPA
-supportedSMPAgentVRange = mkVersionRange duplexHandshakeSMPAgentVersion currentSMPAgentVersion
+supportedSMPAgentVRange = mkVersionRange minSupportedSMPAgentVersion currentSMPAgentVersion
 
 -- it is shorter to allow all handshake headers,
 -- including E2E (double-ratchet) parameters and
@@ -685,7 +694,7 @@ data MsgMeta = MsgMeta
 
 data SMPConfirmation = SMPConfirmation
   { -- | sender's public key to use for authentication of sender's commands at the recepient's server
-    senderKey :: SndPublicAuthKey,
+    senderKey :: Maybe SndPublicAuthKey,
     -- | sender's DH public key for simple per-queue e2e encryption
     e2ePubKey :: C.PublicKeyX25519,
     -- | sender's information to be associated with the connection, e.g. sender's profile information
@@ -775,12 +784,12 @@ instance Encoding AgentMessage where
       'M' -> AgentMessage <$> smpP <*> smpP
       _ -> fail "bad AgentMessage"
 
+-- internal type for storing message type in the database
 data AgentMessageType
   = AM_CONN_INFO
   | AM_CONN_INFO_REPLY
   | AM_RATCHET_INFO
   | AM_HELLO_
-  | AM_REPLY_
   | AM_A_MSG_
   | AM_A_RCVD_
   | AM_QCONT_
@@ -797,7 +806,6 @@ instance Encoding AgentMessageType where
     AM_CONN_INFO_REPLY -> "D"
     AM_RATCHET_INFO -> "S"
     AM_HELLO_ -> "H"
-    AM_REPLY_ -> "R"
     AM_A_MSG_ -> "M"
     AM_A_RCVD_ -> "V"
     AM_QCONT_ -> "QC"
@@ -812,7 +820,6 @@ instance Encoding AgentMessageType where
       'D' -> pure AM_CONN_INFO_REPLY
       'S' -> pure AM_RATCHET_INFO
       'H' -> pure AM_HELLO_
-      'R' -> pure AM_REPLY_
       'M' -> pure AM_A_MSG_
       'V' -> pure AM_A_RCVD_
       'Q' ->
@@ -1004,7 +1011,8 @@ instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where
         where
           queryStr =
             strEncode . QSP QEscape $
-              [("v", strEncode crAgentVRange), ("smp", strEncode crSmpQueues)]
+              -- semicolon is used to separate SMP queues because comma is used to separate server address hostnames
+              [("v", strEncode crAgentVRange), ("smp", B.intercalate ";" $ map strEncode $ L.toList crSmpQueues)]
                 <> maybe [] (\e2e -> [("e2e", strEncode e2e)]) e2eParams
                 <> maybe [] (\cd -> [("data", encodeUtf8 cd)]) crClientData
   strP = connReqUriP' (Just SSSimplex)
@@ -1026,7 +1034,7 @@ connReqUriP overrideScheme = do
   crMode <- A.char '/' *> crModeP <* optional (A.char '/') <* "#/?"
   query <- strP
   aVRange <- queryParam "v" query
-  crSmpQueues <- queryParam "smp" query
+  crSmpQueues <- queryParamParser queuesP "smp" query
   let crClientData = safeDecodeUtf8 <$> queryParamStr "data" query
       crData = ConnReqUriData {crScheme, crAgentVRange = aVRange, crSmpQueues, crClientData}
   case crMode of
@@ -1038,8 +1046,10 @@ connReqUriP overrideScheme = do
     CMContact -> pure . ACR SCMContact $ CRContactUri crData {crAgentVRange = adjustAgentVRange aVRange}
   where
     crModeP = "invitation" $> CMInvitation <|> "contact" $> CMContact
+    -- semicolon is used to separate SMP queues because comma is used to separate server address hostnames
+    queuesP = L.fromList <$> (strDecode <$?> A.takeTill (== ';')) `A.sepBy1'` A.char ';'
     adjustAgentVRange vr =
-      let v = max duplexHandshakeSMPAgentVersion $ minVersion vr
+      let v = max minSupportedSMPAgentVersion $ minVersion vr
        in fromMaybe vr $ safeVersionRange v (max v $ maxVersion vr)
 
 instance ConnectionModeI m => FromJSON (ConnectionRequestUri m) where
@@ -1117,14 +1127,16 @@ data SMPQueueInfo = SMPQueueInfo {clientVersion :: VersionSMPC, queueAddress ::
   deriving (Eq, Show)
 
 instance Encoding SMPQueueInfo where
-  smpEncode (SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey})
+  smpEncode (SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure})
+    | clientVersion >= sndAuthKeySMPClientVersion && sndSecure = smpEncode (clientVersion, smpServer, senderId, dhPublicKey, sndSecure)
     | clientVersion > initialSMPClientVersion = smpEncode (clientVersion, smpServer, senderId, dhPublicKey)
     | otherwise = smpEncode clientVersion <> legacyEncodeServer smpServer <> smpEncode (senderId, dhPublicKey)
   smpP = do
     clientVersion <- smpP
     smpServer <- if clientVersion > initialSMPClientVersion then smpP else updateSMPServerHosts <$> legacyServerP
     (senderId, dhPublicKey) <- smpP
-    pure $ SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey}
+    sndSecure <- fromMaybe False <$> optional smpP
+    pure $ SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure}
 
 -- This instance seems contrived and there was a temptation to split a common part of both types.
 -- But this is created to allow backward and forward compatibility where SMPQueueUri
@@ -1150,7 +1162,8 @@ data SMPQueueUri = SMPQueueUri {clientVRange :: VersionRangeSMPC, queueAddress :
 data SMPQueueAddress = SMPQueueAddress
   { smpServer :: SMPServer,
     senderId :: SMP.SenderId,
-    dhPublicKey :: C.PublicKeyX25519
+    dhPublicKey :: C.PublicKeyX25519,
+    sndSecure :: Bool
   }
   deriving (Eq, Show)
 
@@ -1177,37 +1190,42 @@ sameQAddress (srv, qId) (srv', qId') = sameSrvAddr srv srv' && qId == qId'
 {-# INLINE sameQAddress #-}
 
 instance StrEncoding SMPQueueUri where
-  strEncode (SMPQueueUri vr SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey})
+  strEncode (SMPQueueUri vr SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey, sndSecure})
     | minVersion vr >= srvHostnamesSMPClientVersion = strEncode srv <> "/" <> strEncode qId <> "#/?" <> query queryParams
     | otherwise = legacyStrEncodeServer srv <> "/" <> strEncode qId <> "#/?" <> query (queryParams <> srvParam)
     where
       query = strEncode . QSP QEscape
-      queryParams = [("v", strEncode vr), ("dh", strEncode dhPublicKey)]
+      queryParams = [("v", strEncode vr), ("dh", strEncode dhPublicKey)] <> [("k", "s") | sndSecure]
       srvParam = [("srv", strEncode $ TransportHosts_ hs) | not (null hs)]
       hs = L.tail $ host srv
   strP = do
     srv@ProtocolServer {host = h :| host} <- strP <* A.char '/'
     senderId <- strP <* optional (A.char '/') <* A.char '#'
-    (vr, hs, dhPublicKey) <- unversioned <|> versioned
+    (vr, hs, dhPublicKey, sndSecure) <- versioned <|> unversioned
     let srv' = srv {host = h :| host <> hs}
         smpServer = if maxVersion vr < srvHostnamesSMPClientVersion then updateSMPServerHosts srv' else srv'
-    pure $ SMPQueueUri vr SMPQueueAddress {smpServer, senderId, dhPublicKey}
+    pure $ SMPQueueUri vr SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure}
     where
-      unversioned = (versionToRange initialSMPClientVersion,[],) <$> strP <* A.endOfInput
+      unversioned = (versionToRange initialSMPClientVersion,[],,False) <$> strP <* A.endOfInput
       versioned = do
         dhKey_ <- optional strP
         query <- optional (A.char '/') *> A.char '?' *> strP
         vr <- queryParam "v" query
         dhKey <- maybe (queryParam "dh" query) pure dhKey_
         hs_ <- queryParam_ "srv" query
-        pure (vr, maybe [] thList_ hs_, dhKey)
+        let sndSecure = queryParamStr "k" query == Just "s"
+        pure (vr, maybe [] thList_ hs_, dhKey, sndSecure)
 
 instance Encoding SMPQueueUri where
-  smpEncode (SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey}) =
-    smpEncode (clientVRange, smpServer, senderId, dhPublicKey)
+  smpEncode (SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure})
+    | maxVersion clientVRange >= sndAuthKeySMPClientVersion && sndSecure =
+        smpEncode (clientVRange, smpServer, senderId, dhPublicKey, sndSecure)
+    | otherwise =
+        smpEncode (clientVRange, smpServer, senderId, dhPublicKey)
   smpP = do
     (clientVRange, smpServer, senderId, dhPublicKey) <- smpP
-    pure $ SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey}
+    sndSecure <- fromMaybe False <$> optional smpP
+    pure $ SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey, sndSecure}
 
 data ConnectionRequestUri (m :: ConnectionMode) where
   CRInvitationUri :: ConnReqUriData -> RcvE2ERatchetParamsUri 'C.X448 -> ConnectionRequestUri CMInvitation
diff --git a/src/Simplex/Messaging/Agent/QueryString.hs b/src/Simplex/Messaging/Agent/QueryString.hs
index fee552a01..9dc0e94a9 100644
--- a/src/Simplex/Messaging/Agent/QueryString.hs
+++ b/src/Simplex/Messaging/Agent/QueryString.hs
@@ -24,9 +24,12 @@ instance StrEncoding QueryStringParams where
   strP = QSP QEscape . Q.parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
 
 queryParam :: StrEncoding a => ByteString -> QueryStringParams -> Parser a
-queryParam name q =
+queryParam = queryParamParser strP
+
+queryParamParser :: Parser a -> ByteString -> QueryStringParams -> Parser a
+queryParamParser p name q =
   case queryParamStr name q of
-    Just p -> either fail pure $ parseAll strP p
+    Just s -> either fail pure $ parseAll p s
     _ -> fail $ "no qs param " <> B.unpack name
 
 queryParam_ :: StrEncoding a => ByteString -> QueryStringParams -> Parser (Maybe a)
diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs
index b9ffecbbd..baec2ef93 100644
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -44,6 +44,7 @@ import Simplex.Messaging.Protocol
     RcvPrivateAuthKey,
     SndPrivateAuthKey,
     SndPublicAuthKey,
+    SenderCanSecure,
     VersionSMPC,
   )
 import qualified Simplex.Messaging.Protocol as SMP
@@ -83,6 +84,8 @@ data StoredRcvQueue (q :: QueueStored) = RcvQueue
     e2eDhSecret :: Maybe C.DhSecretX25519,
     -- | sender queue ID
     sndId :: SMP.SenderId,
+    -- | sender can secure the queue
+    sndSecure :: SenderCanSecure,
     -- | queue status
     status :: QueueStatus,
     -- | database queue ID (within connection)
@@ -138,9 +141,11 @@ data StoredSndQueue (q :: QueueStored) = SndQueue
     server :: SMPServer,
     -- | sender queue ID
     sndId :: SMP.SenderId,
+    -- | sender can secure the queue
+    sndSecure :: SenderCanSecure,
     -- | key pair used by the sender to authorize transmissions
     -- TODO combine keys to key pair so that types match
-    sndPublicKey :: Maybe SndPublicAuthKey,
+    sndPublicKey :: SndPublicAuthKey,
     sndPrivateKey :: SndPrivateAuthKey,
     -- | DH public key used to negotiate per-queue e2e encryption
     e2ePubKey :: Maybe C.PublicKeyX25519,
@@ -372,7 +377,7 @@ instance StrEncoding AgentCommandTag where
 data InternalCommand
   = ICAck SMP.RecipientId MsgId
   | ICAckDel SMP.RecipientId MsgId InternalId
-  | ICAllowSecure SMP.RecipientId SMP.SndPublicAuthKey
+  | ICAllowSecure SMP.RecipientId (Maybe SMP.SndPublicAuthKey)
   | ICDuplexSecure SMP.RecipientId SMP.SndPublicAuthKey
   | ICDeleteConn
   | ICDeleteRcvQueue SMP.RecipientId
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 434344c89..d4cd99b39 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -102,8 +102,10 @@ module Simplex.Messaging.Agent.Store.SQLite
     -- Messages
     updateRcvIds,
     createRcvMsg,
+    updateRcvMsgHash,
     updateSndIds,
     createSndMsg,
+    updateSndMsgHash,
     createSndMsgDelivery,
     getSndMsgViaRcpt,
     updateSndMsgRcpt,
@@ -811,7 +813,7 @@ setRcvQueueNtfCreds db connId clientNtfCreds =
       Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret} -> (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret)
       Nothing -> (Nothing, Nothing, Nothing, Nothing)
 
-type SMPConfirmationRow = (SndPublicAuthKey, C.PublicKeyX25519, ConnInfo, Maybe [SMPQueueInfo], Maybe VersionSMPC)
+type SMPConfirmationRow = (Maybe SndPublicAuthKey, C.PublicKeyX25519, ConnInfo, Maybe [SMPQueueInfo], Maybe VersionSMPC)
 
 smpConfirmation :: SMPConfirmationRow -> SMPConfirmation
 smpConfirmation (senderKey, e2ePubKey, connInfo, smpReplyQueues_, smpClientVersion_) =
@@ -958,10 +960,10 @@ updateRcvIds db connId = do
   pure (internalId, internalRcvId, lastExternalSndId, lastRcvHash)
 
 createRcvMsg :: DB.Connection -> ConnId -> RcvQueue -> RcvMsgData -> IO ()
-createRcvMsg db connId rq rcvMsgData = do
+createRcvMsg db connId rq rcvMsgData@RcvMsgData {msgMeta = MsgMeta {sndMsgId}, internalRcvId, internalHash} = do
   insertRcvMsgBase_ db connId rcvMsgData
   insertRcvMsgDetails_ db connId rq rcvMsgData
-  updateHashRcv_ db connId rcvMsgData
+  updateRcvMsgHash db connId sndMsgId internalRcvId internalHash
 
 updateSndIds :: DB.Connection -> ConnId -> IO (InternalId, InternalSndId, PrevSndMsgHash)
 updateSndIds db connId = do
@@ -972,10 +974,10 @@ updateSndIds db connId = do
   pure (internalId, internalSndId, prevSndHash)
 
 createSndMsg :: DB.Connection -> ConnId -> SndMsgData -> IO ()
-createSndMsg db connId sndMsgData = do
+createSndMsg db connId sndMsgData@SndMsgData {internalSndId, internalHash} = do
   insertSndMsgBase_ db connId sndMsgData
   insertSndMsgDetails_ db connId sndMsgData
-  updateHashSnd_ db connId sndMsgData
+  updateSndMsgHash db connId internalSndId internalHash
 
 createSndMsgDelivery :: DB.Connection -> ConnId -> SndQueue -> InternalId -> IO ()
 createSndMsgDelivery db connId SndQueue {dbQueueId} msgId =
@@ -1866,28 +1868,34 @@ upsertNtfServer_ db ProtocolServer {host, port, keyHash} = do
 
 insertRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> Maybe C.KeyHash -> IO RcvQueue
 insertRcvQueue_ db connId' rq@RcvQueue {..} serverKeyHash_ = do
-  qId <- newQueueId_ <$> DB.query db "SELECT rcv_queue_id FROM rcv_queues WHERE conn_id = ? ORDER BY rcv_queue_id DESC LIMIT 1" (Only connId')
+  -- to preserve ID if the queue already exists.
+  -- possibly, it can be done in one query.
+  currQId_ <- maybeFirstRow fromOnly $ DB.query db "SELECT rcv_queue_id FROM rcv_queues WHERE conn_id = ? AND host = ? AND port = ? AND snd_id = ?" (connId', host server, port server, sndId)
+  qId <- maybe (newQueueId_ <$> DB.query db "SELECT rcv_queue_id FROM rcv_queues WHERE conn_id = ? ORDER BY rcv_queue_id DESC LIMIT 1" (Only connId')) pure currQId_
   DB.execute
     db
     [sql|
       INSERT INTO rcv_queues
-        (host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status, rcv_queue_id, rcv_primary, replace_rcv_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
+        (host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, snd_secure, status, rcv_queue_id, rcv_primary, replace_rcv_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
     |]
-    ((host server, port server, rcvId, connId', rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret) :. (sndId, status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
+    ((host server, port server, rcvId, connId', rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret) :. (sndId, sndSecure, status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
   pure (rq :: NewRcvQueue) {connId = connId', dbQueueId = qId}
 
 -- * createSndConn helpers
 
 insertSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> Maybe C.KeyHash -> IO SndQueue
 insertSndQueue_ db connId' sq@SndQueue {..} serverKeyHash_ = do
-  qId <- newQueueId_ <$> DB.query db "SELECT snd_queue_id FROM snd_queues WHERE conn_id = ? ORDER BY snd_queue_id DESC LIMIT 1" (Only connId')
+  -- to preserve ID if the queue already exists.
+  -- possibly, it can be done in one query.
+  currQId_ <- maybeFirstRow fromOnly $ DB.query db "SELECT snd_queue_id FROM snd_queues WHERE conn_id = ? AND host = ? AND port = ? AND snd_id = ?" (connId', host server, port server, sndId)
+  qId <- maybe (newQueueId_ <$> DB.query db "SELECT snd_queue_id FROM snd_queues WHERE conn_id = ? ORDER BY snd_queue_id DESC LIMIT 1" (Only connId')) pure currQId_
   DB.execute
     db
     [sql|
       INSERT OR REPLACE INTO snd_queues
-        (host, port, snd_id, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret, status, snd_queue_id, snd_primary, replace_snd_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?);
+        (host, port, snd_id, snd_secure, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret, status, snd_queue_id, snd_primary, replace_snd_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
     |]
-    ((host server, port server, sndId, connId', sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret) :. (status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
+    ((host server, port server, sndId, sndSecure, connId', sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret) :. (status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
   pure (sq :: NewSndQueue) {connId = connId', dbQueueId = qId}
 
 newQueueId_ :: [Only Int64] -> DBQueueId 'QSStored
@@ -2009,7 +2017,7 @@ rcvQueueQuery :: Query
 rcvQueueQuery =
   [sql|
     SELECT c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.rcv_id, q.rcv_private_key, q.rcv_dh_secret,
-      q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.status,
+      q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.snd_secure, q.status,
       q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id, q.switch_status, q.smp_client_version, q.delete_errors,
       q.ntf_public_key, q.ntf_private_key, q.ntf_id, q.rcv_ntf_dh_secret
     FROM rcv_queues q
@@ -2018,17 +2026,17 @@ rcvQueueQuery =
   |]
 
 toRcvQueue ::
-  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SMP.RecipientId, SMP.RcvPrivateAuthKey, SMP.RcvDhSecret, C.PrivateKeyX25519, Maybe C.DhSecretX25519, SMP.SenderId, QueueStatus)
-    :. (DBQueueId 'QSStored, Bool, Maybe Int64, Maybe RcvSwitchStatus, Maybe VersionSMPC, Int)
+  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SMP.RecipientId, SMP.RcvPrivateAuthKey, SMP.RcvDhSecret, C.PrivateKeyX25519, Maybe C.DhSecretX25519, SMP.SenderId, SenderCanSecure)
+    :. (QueueStatus, DBQueueId 'QSStored, Bool, Maybe Int64, Maybe RcvSwitchStatus, Maybe VersionSMPC, Int)
     :. (Maybe SMP.NtfPublicAuthKey, Maybe SMP.NtfPrivateAuthKey, Maybe SMP.NotifierId, Maybe RcvNtfDhSecret) ->
   RcvQueue
-toRcvQueue ((userId, keyHash, connId, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status) :. (dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion_, deleteErrors) :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)) =
+toRcvQueue ((userId, keyHash, connId, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, sndSecure) :. (status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion_, deleteErrors) :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)) =
   let server = SMPServer host port keyHash
       smpClientVersion = fromMaybe initialSMPClientVersion smpClientVersion_
       clientNtfCreds = case (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_) of
         (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret) -> Just $ ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
         _ -> Nothing
-   in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}
+   in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, sndSecure, status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}
 
 getRcvQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError RcvQueue)
 getRcvQueueById db connId dbRcvId =
@@ -2049,7 +2057,7 @@ sndQueueQuery :: Query
 sndQueueQuery =
   [sql|
     SELECT
-      c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.snd_id,
+      c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.snd_id, q.snd_secure,
       q.snd_public_key, q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status,
       q.snd_queue_id, q.snd_primary, q.replace_snd_queue_id, q.switch_status, q.smp_client_version
     FROM snd_queues q
@@ -2058,17 +2066,18 @@ sndQueueQuery =
   |]
 
 toSndQueue ::
-  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SenderId)
+  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SenderId, SenderCanSecure)
     :. (Maybe SndPublicAuthKey, SndPrivateAuthKey, Maybe C.PublicKeyX25519, C.DhSecretX25519, QueueStatus)
     :. (DBQueueId 'QSStored, Bool, Maybe Int64, Maybe SndSwitchStatus, VersionSMPC) ->
   SndQueue
 toSndQueue
-  ( (userId, keyHash, connId, host, port, sndId)
-      :. (sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status)
+  ( (userId, keyHash, connId, host, port, sndId, sndSecure)
+      :. (sndPubKey, sndPrivateKey@(C.APrivateAuthKey a pk), e2ePubKey, e2eDhSecret, status)
       :. (dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion)
     ) =
     let server = SMPServer host port keyHash
-     in SndQueue {userId, connId, server, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion}
+        sndPublicKey = fromMaybe (C.APublicAuthKey a (C.publicKey pk)) sndPubKey
+     in SndQueue {userId, connId, server, sndId, sndSecure, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion}
 
 getSndQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError SndQueue)
 getSndQueueById db connId dbSndId =
@@ -2147,10 +2156,10 @@ insertRcvMsgDetails_ db connId RcvQueue {dbQueueId} RcvMsgData {msgMeta, interna
     ]
   DB.execute db "INSERT INTO encrypted_rcv_message_hashes (conn_id, hash) VALUES (?,?)" (connId, encryptedMsgHash)
 
-updateHashRcv_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
-updateHashRcv_ dbConn connId RcvMsgData {msgMeta = MsgMeta {sndMsgId}, internalHash, internalRcvId} =
+updateRcvMsgHash :: DB.Connection -> ConnId -> AgentMsgId -> InternalRcvId -> MsgHash -> IO ()
+updateRcvMsgHash db connId sndMsgId internalRcvId internalHash =
   DB.executeNamed
-    dbConn
+    db
     -- last_internal_rcv_msg_id equality check prevents race condition in case next id was reserved
     [sql|
       UPDATE connections
@@ -2226,10 +2235,10 @@ insertSndMsgDetails_ dbConn connId SndMsgData {..} =
       ":previous_msg_hash" := prevMsgHash
     ]
 
-updateHashSnd_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
-updateHashSnd_ dbConn connId SndMsgData {..} =
+updateSndMsgHash :: DB.Connection -> ConnId -> InternalSndId -> MsgHash -> IO ()
+updateSndMsgHash db connId internalSndId internalHash =
   DB.executeNamed
-    dbConn
+    db
     -- last_internal_snd_msg_id equality check prevents race condition in case next id was reserved
     [sql|
       UPDATE connections
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
index 340063f5c..1b8990ab8 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
@@ -73,6 +73,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wai
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240518_servers_stats
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -114,7 +115,8 @@ schemaMigrations =
     ("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
     ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
     ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
-    ("m20240518_servers_stats", m20240518_servers_stats, Just down_m20240518_servers_stats)
+    ("m20240518_servers_stats", m20240518_servers_stats, Just down_m20240518_servers_stats),
+    ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240624_snd_secure.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240624_snd_secure.hs
new file mode 100644
index 000000000..7f82d4ecf
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240624_snd_secure.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20240624_snd_secure :: Query
+m20240624_snd_secure =
+    [sql|
+ALTER TABLE rcv_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
+ALTER TABLE snd_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
+
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master
+SET sql = replace(sql, 'sender_key BLOB NOT NULL,', 'sender_key BLOB,')
+WHERE name = 'conn_confirmations' AND type = 'table';
+
+PRAGMA writable_schema=0;
+|]
+
+down_m20240624_snd_secure :: Query
+down_m20240624_snd_secure =
+    [sql|
+ALTER TABLE rcv_queues DROP COLUMN snd_secure;
+ALTER TABLE snd_queues DROP COLUMN snd_secure;
+
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master
+SET sql = replace(sql, 'sender_key BLOB,', 'sender_key BLOB NOT NULL,')
+WHERE name = 'conn_confirmations' AND type = 'table';
+
+PRAGMA writable_schema=0;
+|]
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
index 50cf6d74a..80af08989 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
@@ -55,6 +55,7 @@ CREATE TABLE rcv_queues(
   server_key_hash BLOB,
   switch_status TEXT,
   deleted INTEGER NOT NULL DEFAULT 0,
+  snd_secure INTEGER NOT NULL DEFAULT 0,
   PRIMARY KEY(host, port, rcv_id),
   FOREIGN KEY(host, port) REFERENCES servers
   ON DELETE RESTRICT ON UPDATE CASCADE,
@@ -77,6 +78,7 @@ CREATE TABLE snd_queues(
   replace_snd_queue_id INTEGER NULL,
   server_key_hash BLOB,
   switch_status TEXT,
+  snd_secure INTEGER NOT NULL DEFAULT 0,
   PRIMARY KEY(host, port, snd_id),
   FOREIGN KEY(host, port) REFERENCES servers
   ON DELETE RESTRICT ON UPDATE CASCADE
@@ -132,7 +134,7 @@ CREATE TABLE conn_confirmations(
   confirmation_id BLOB NOT NULL PRIMARY KEY,
   conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
   e2e_snd_pub_key BLOB NOT NULL,
-  sender_key BLOB NOT NULL,
+  sender_key BLOB,
   ratchet_state BLOB NOT NULL,
   sender_conn_info BLOB NOT NULL,
   accepted INTEGER NOT NULL,
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index de178e368..39cf32677 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -47,6 +47,7 @@ module Simplex.Messaging.Client
     subscribeSMPQueueNotifications,
     subscribeSMPQueuesNtfs,
     secureSMPQueue,
+    secureSndSMPQueue,
     enableSMPQueueNotifications,
     disableSMPQueueNotifications,
     enableSMPQueuesNtfs,
@@ -655,9 +656,10 @@ createSMPQueue ::
   RcvPublicDhKey ->
   Maybe BasicAuth ->
   SubscriptionMode ->
+  Bool ->
   ExceptT SMPClientError IO QueueIdsKeys
-createSMPQueue c (rKey, rpKey) dhKey auth subMode =
-  sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey auth subMode) >>= \case
+createSMPQueue c (rKey, rpKey) dhKey auth subMode sndSecure =
+  sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey auth subMode sndSecure) >>= \case
     IDS qik -> pure qik
     r -> throwE $ unexpectedResponse r
 
@@ -729,6 +731,11 @@ secureSMPQueue :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> SndPublicAuth
 secureSMPQueue c rpKey rId senderKey = okSMPCommand (KEY senderKey) c rpKey rId
 {-# INLINE secureSMPQueue #-}
 
+-- | Secure the SMP queue via sender queue ID.
+secureSndSMPQueue :: SMPClient -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO ()
+secureSndSMPQueue c spKey sId senderKey = okSMPCommand (SKEY senderKey) c spKey sId
+{-# INLINE secureSndSMPQueue #-}
+
 -- | Enable notifications for the queue for push notifications server.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index 5edea1719..d1b3f85d6 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -55,6 +55,7 @@ module Simplex.Messaging.Protocol
     ProtocolEncoding (..),
     Command (..),
     SubscriptionMode (..),
+    SenderCanSecure,
     Party (..),
     Cmd (..),
     DirectParty,
@@ -133,6 +134,7 @@ module Simplex.Messaging.Protocol
     FwdTransmission (..),
     MsgFlags (..),
     initialSMPClientVersion,
+    currentSMPClientVersion,
     userProtocol,
     rcvMessageMeta,
     noMsgFlags,
@@ -153,6 +155,7 @@ module Simplex.Messaging.Protocol
     legacyServerP,
     legacyStrEncodeServer,
     srvHostnamesSMPClientVersion,
+    sndAuthKeySMPClientVersion,
     sameSrvAddr,
     sameSrvAddr',
     noAuthSrv,
@@ -240,8 +243,11 @@ initialSMPClientVersion = VersionSMPC 1
 srvHostnamesSMPClientVersion :: VersionSMPC
 srvHostnamesSMPClientVersion = VersionSMPC 2
 
+sndAuthKeySMPClientVersion :: VersionSMPC
+sndAuthKeySMPClientVersion = VersionSMPC 3
+
 currentSMPClientVersion :: VersionSMPC
-currentSMPClientVersion = VersionSMPC 2
+currentSMPClientVersion = VersionSMPC 3
 
 supportedSMPClientVRange :: VersionRangeSMPC
 supportedSMPClientVRange = mkVersionRange initialSMPClientVersion currentSMPClientVersion
@@ -377,7 +383,7 @@ data Command (p :: Party) where
   -- v6 of SMP servers only support signature algorithm for command authorization.
   -- v7 of SMP servers additionally support additional layer of authenticated encryption.
   -- RcvPublicAuthKey is defined as C.APublicKey - it can be either signature or DH public keys.
-  NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> Command Recipient
+  NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> SenderCanSecure -> Command Recipient
   SUB :: Command Recipient
   KEY :: SndPublicAuthKey -> Command Recipient
   NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> Command Recipient
@@ -390,6 +396,7 @@ data Command (p :: Party) where
   DEL :: Command Recipient
   QUE :: Command Recipient
   -- SMP sender commands
+  SKEY :: SndPublicAuthKey -> Command Sender
   -- SEND v1 has to be supported for encoding/decoding
   -- SEND :: MsgBody -> Command Sender
   SEND :: MsgFlags -> MsgBody -> Command Sender
@@ -432,6 +439,8 @@ instance Encoding SubscriptionMode where
       'C' -> pure SMOnlyCreate
       _ -> fail "bad SubscriptionMode"
 
+type SenderCanSecure = Bool
+
 newtype EncTransmission = EncTransmission ByteString
   deriving (Show)
 
@@ -664,6 +673,7 @@ data CommandTag (p :: Party) where
   OFF_ :: CommandTag Recipient
   DEL_ :: CommandTag Recipient
   QUE_ :: CommandTag Recipient
+  SKEY_ :: CommandTag Sender
   SEND_ :: CommandTag Sender
   PING_ :: CommandTag Sender
   PRXY_ :: CommandTag ProxiedClient
@@ -712,6 +722,7 @@ instance PartyI p => Encoding (CommandTag p) where
     OFF_ -> "OFF"
     DEL_ -> "DEL"
     QUE_ -> "QUE"
+    SKEY_ -> "SKEY"
     SEND_ -> "SEND"
     PING_ -> "PING"
     PRXY_ -> "PRXY"
@@ -732,6 +743,7 @@ instance ProtocolMsgTag CmdTag where
     "OFF" -> Just $ CT SRecipient OFF_
     "DEL" -> Just $ CT SRecipient DEL_
     "QUE" -> Just $ CT SRecipient QUE_
+    "SKEY" -> Just $ CT SSender SKEY_
     "SEND" -> Just $ CT SSender SEND_
     "PING" -> Just $ CT SSender PING_
     "PRXY" -> Just $ CT SProxiedClient PRXY_
@@ -1106,7 +1118,8 @@ instance FromJSON CorrId where
 data QueueIdsKeys = QIK
   { rcvId :: RecipientId,
     sndId :: SenderId,
-    rcvPublicDhKey :: RcvPublicDhKey
+    rcvPublicDhKey :: RcvPublicDhKey,
+    sndSecure :: SenderCanSecure
   }
   deriving (Eq, Show)
 
@@ -1277,7 +1290,8 @@ class ProtocolMsgTag (Tag msg) => ProtocolEncoding v err msg | msg -> err, msg -
 instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
   type Tag (Command p) = CommandTag p
   encodeProtocol v = \case
-    NEW rKey dhKey auth_ subMode
+    NEW rKey dhKey auth_ subMode sndSecure
+      | v >= sndAuthKeySMPVersion -> new <> e (auth_, subMode, sndSecure)
       | v >= subModeSMPVersion -> new <> auth <> e subMode
       | v == basicAuthSMPVersion -> new <> auth
       | otherwise -> new
@@ -1293,6 +1307,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
     OFF -> e OFF_
     DEL -> e DEL_
     QUE -> e QUE_
+    SKEY k -> e (SKEY_, ' ', k)
     SEND flags msg -> e (SEND_, ' ', flags, ' ', Tail msg)
     PING -> e PING_
     NSUB -> e NSUB_
@@ -1318,6 +1333,9 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
     SEND {}
       | B.null entId -> Left $ CMD NO_ENTITY
       | otherwise -> Right cmd
+    SKEY _
+      | isNothing auth || B.null entId -> Left $ CMD NO_AUTH
+      | otherwise -> Right cmd
     PING -> noAuthCmd
     PRXY {} -> noAuthCmd
     PFWD {}
@@ -1344,9 +1362,10 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
     CT SRecipient tag ->
       Cmd SRecipient <$> case tag of
         NEW_
-          | v >= subModeSMPVersion -> new <*> auth <*> smpP
-          | v == basicAuthSMPVersion -> new <*> auth <*> pure SMSubscribe
-          | otherwise -> new <*> pure Nothing <*> pure SMSubscribe
+          | v >= sndAuthKeySMPVersion -> new <*> smpP <*> smpP <*> smpP
+          | v >= subModeSMPVersion -> new <*> auth <*> smpP <*> pure False
+          | v == basicAuthSMPVersion -> new <*> auth <*> pure SMSubscribe <*> pure False
+          | otherwise -> new <*> pure Nothing <*> pure SMSubscribe <*> pure False
           where
             new = NEW <$> _smpP <*> smpP
             auth = optional (A.char 'A' *> smpP)
@@ -1361,6 +1380,7 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
         QUE_ -> pure QUE
     CT SSender tag ->
       Cmd SSender <$> case tag of
+        SKEY_ -> SKEY <$> _smpP
         SEND_ -> SEND <$> _smpP <*> (unTail <$> _smpP)
         PING_ -> pure PING
         RFWD_ -> RFWD <$> (EncFwdTransmission . unTail <$> _smpP)
@@ -1377,8 +1397,12 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
 
 instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
   type Tag BrokerMsg = BrokerMsgTag
-  encodeProtocol _v = \case
-    IDS (QIK rcvId sndId srvDh) -> e (IDS_, ' ', rcvId, sndId, srvDh)
+  encodeProtocol v = \case
+    IDS (QIK rcvId sndId srvDh sndSecure)
+      | v >= sndAuthKeySMPVersion -> ids <> e sndSecure
+      | otherwise -> ids
+      where
+        ids = e (IDS_, ' ', rcvId, sndId, srvDh)
     MSG RcvMessage {msgId, msgBody = EncRcvMsgBody body} ->
       e (MSG_, ' ', msgId, Tail body)
     NID nId srvNtfDh -> e (NID_, ' ', nId, srvNtfDh)
@@ -1395,13 +1419,17 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
       e :: Encoding a => a -> ByteString
       e = smpEncode
 
-  protocolP _v = \case
+  protocolP v = \case
     MSG_ -> do
       msgId <- _smpP
       MSG . RcvMessage msgId <$> bodyP
       where
         bodyP = EncRcvMsgBody . unTail <$> smpP
-    IDS_ -> IDS <$> (QIK <$> _smpP <*> smpP <*> smpP)
+    IDS_
+      | v >= sndAuthKeySMPVersion -> ids smpP
+      | otherwise -> ids $ pure False
+      where
+        ids p = IDS <$> (QIK <$> _smpP <*> smpP <*> smpP <*> p)
     NID_ -> NID <$> _smpP <*> smpP
     NMSG_ -> NMSG <$> _smpP <*> smpP
     PKEY_ -> PKEY <$> _smpP <*> smpP <*> ((,) <$> C.certChainP <*> (C.getSignedExact <$> smpP))
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 5c8d13a5e..f673018bf 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -607,9 +607,10 @@ data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
 verifyTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> QueueId -> Cmd -> M VerificationResult
 verifyTransmission auth_ tAuth authorized queueId cmd =
   case cmd of
-    Cmd SRecipient (NEW k _ _ _) -> pure $ Nothing `verifiedWith` k
+    Cmd SRecipient (NEW k _ _ _ _) -> pure $ Nothing `verifiedWith` k
     Cmd SRecipient _ -> verifyQueue (\q -> Just q `verifiedWith` recipientKey q) <$> get SRecipient
-    -- SEND will be accepted without authorization before the queue is secured with KEY command
+    -- SEND will be accepted without authorization before the queue is secured with KEY or SKEY command
+    Cmd SSender (SKEY k) -> verifyQueue (\q -> Just q `verifiedWith` k) <$> get SSender
     Cmd SSender SEND {} -> verifyQueue (\q -> Just q `verified` maybe (isNothing tAuth) verify (senderKey q)) <$> get SSender
     Cmd SSender PING -> pure $ VRVerified Nothing
     Cmd SSender RFWD {} -> pure $ VRVerified Nothing
@@ -768,13 +769,18 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
     transportErr :: TransportError -> ErrorType
     transportErr = PROXY . BROKER . TRANSPORT
     mkIncProxyStats :: MonadIO m => ProxyStats -> ProxyStats -> OwnServer -> (ProxyStats -> TVar Int) -> m ()
-    mkIncProxyStats ps psOwn = \own sel -> do
+    mkIncProxyStats ps psOwn own sel = do
       atomically $ modifyTVar' (sel ps) (+ 1)
       when own $ atomically $ modifyTVar' (sel psOwn) (+ 1)
     processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
     processCommand (qr_, (corrId, queueId, cmd)) = case cmd of
       Cmd SProxiedClient command -> processProxiedCmd (corrId, queueId, command)
       Cmd SSender command -> Just <$> case command of
+        SKEY sKey -> (corrId,queueId,) <$> case qr_ of
+          Just QueueRec {sndSecure, recipientId}
+            | sndSecure -> secureQueue_ "SKEY" recipientId sKey
+            | otherwise -> pure $ ERR AUTH
+          Nothing -> pure $ ERR INTERNAL
         SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
         PING -> pure (corrId, "", PONG)
         RFWD encBlock -> (corrId, "",) <$> processForwardedCommand encBlock
@@ -782,10 +788,10 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
       Cmd SRecipient command -> do
         st <- asks queueStore
         Just <$> case command of
-          NEW rKey dhKey auth subMode ->
+          NEW rKey dhKey auth subMode sndSecure ->
             ifM
               allowNew
-              (createQueue st rKey dhKey subMode)
+              (createQueue st rKey dhKey subMode sndSecure)
               (pure (corrId, queueId, ERR AUTH))
             where
               allowNew = do
@@ -794,18 +800,20 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           SUB -> withQueue (`subscribeQueue` queueId)
           GET -> withQueue getMessage
           ACK msgId -> withQueue (`acknowledgeMsg` msgId)
-          KEY sKey -> secureQueue_ st sKey
+          KEY sKey -> (corrId,queueId,) <$> case qr_ of
+            Just QueueRec {recipientId} -> secureQueue_ "KEY" recipientId sKey
+            Nothing -> pure $ ERR INTERNAL
           NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
           NDEL -> deleteQueueNotifier_ st
           OFF -> suspendQueue_ st
           DEL -> delQueueAndMsgs st
           QUE -> withQueue getQueueInfo
       where
-        createQueue :: QueueStore -> RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> M (Transmission BrokerMsg)
-        createQueue st recipientKey dhKey subMode = time "NEW" $ do
+        createQueue :: QueueStore -> RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> SenderCanSecure -> M (Transmission BrokerMsg)
+        createQueue st recipientKey dhKey subMode sndSecure = time "NEW" $ do
           (rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
           let rcvDhSecret = C.dh' dhKey privDhKey
-              qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDhKey}
+              qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}
               qRec (recipientId, senderId) =
                 QueueRec
                   { recipientId,
@@ -814,7 +822,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                     rcvDhSecret,
                     senderKey = Nothing,
                     notifier = Nothing,
-                    status = QueueActive
+                    status = QueueActive,
+                    sndSecure
                   }
           (corrId,queueId,) <$> addQueueRetry 3 qik qRec
           where
@@ -849,12 +858,13 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
               n <- asks $ queueIdBytes . config
               liftM2 (,) (randomId n) (randomId n)
 
-        secureQueue_ :: QueueStore -> SndPublicAuthKey -> M (Transmission BrokerMsg)
-        secureQueue_ st sKey = time "KEY" $ do
-          withLog $ \s -> logSecureQueue s queueId sKey
+        secureQueue_ :: T.Text -> RecipientId -> SndPublicAuthKey -> M BrokerMsg
+        secureQueue_ name rId sKey = time name $ do
+          withLog $ \s -> logSecureQueue s rId sKey
+          st <- asks queueStore
           stats <- asks serverStats
           atomically $ modifyTVar' (qSecured stats) (+ 1)
-          atomically $ (corrId,queueId,) . either ERR (const OK) <$> secureQueue st queueId sKey
+          atomically $ either ERR (const OK) <$> secureQueue st rId sKey
 
         addQueueNotifier_ :: QueueStore -> NtfPublicAuthKey -> RcvNtfPublicDhKey -> M (Transmission BrokerMsg)
         addQueueNotifier_ st notifierKey dhKey = time "NKEY" $ do
diff --git a/src/Simplex/Messaging/Server/QueueStore.hs b/src/Simplex/Messaging/Server/QueueStore.hs
index cd1b94215..8d5bd8fff 100644
--- a/src/Simplex/Messaging/Server/QueueStore.hs
+++ b/src/Simplex/Messaging/Server/QueueStore.hs
@@ -14,6 +14,7 @@ data QueueRec = QueueRec
     rcvDhSecret :: !RcvDhSecret,
     senderId :: !SenderId,
     senderKey :: !(Maybe SndPublicAuthKey),
+    sndSecure :: !SenderCanSecure,
     notifier :: !(Maybe NtfCreds),
     status :: !ServerQueueStatus
   }
diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs
index b1011c404..d1ce15ed6 100644
--- a/src/Simplex/Messaging/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Server/StoreLog.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
@@ -53,7 +54,7 @@ data StoreLogRecord
   | DeleteNotifier QueueId
 
 instance StrEncoding QueueRec where
-  strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier} =
+  strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier} =
     B.unwords
       [ "rid=" <> strEncode recipientId,
         "rk=" <> strEncode recipientKey,
@@ -61,6 +62,7 @@ instance StrEncoding QueueRec where
         "sid=" <> strEncode senderId,
         "sk=" <> strEncode senderKey
       ]
+      <> if sndSecure then " sndSecure=" <> strEncode sndSecure else ""
       <> maybe "" notifierStr notifier
     where
       notifierStr ntfCreds = " notifier=" <> strEncode ntfCreds
@@ -71,8 +73,9 @@ instance StrEncoding QueueRec where
     rcvDhSecret <- "rdh=" *> strP_
     senderId <- "sid=" *> strP_
     senderKey <- "sk=" *> strP
+    sndSecure <- (" sndSecure=" *> strP) <|> pure False
     notifier <- optional $ " notifier=" *> strP
-    pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier, status = QueueActive}
+    pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, status = QueueActive}
 
 instance StrEncoding StoreLogRecord where
   strEncode = \case
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index 7088480f5..d7f81f563 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -46,6 +46,7 @@ module Simplex.Messaging.Transport
     subModeSMPVersion,
     authCmdsSMPVersion,
     sendingProxySMPVersion,
+    sndAuthKeySMPVersion,
     simplexMQVersion,
     smpBlockSize,
     TransportConfig (..),
@@ -156,14 +157,17 @@ authCmdsSMPVersion = VersionSMP 7
 sendingProxySMPVersion :: VersionSMP
 sendingProxySMPVersion = VersionSMP 8
 
+sndAuthKeySMPVersion :: VersionSMP
+sndAuthKeySMPVersion = VersionSMP 9
+
 currentClientSMPRelayVersion :: VersionSMP
-currentClientSMPRelayVersion = VersionSMP 8
+currentClientSMPRelayVersion = VersionSMP 9
 
 legacyServerSMPRelayVersion :: VersionSMP
 legacyServerSMPRelayVersion = VersionSMP 6
 
 currentServerSMPRelayVersion :: VersionSMP
-currentServerSMPRelayVersion = VersionSMP 8
+currentServerSMPRelayVersion = VersionSMP 9
 
 -- Max SMP protocol version to be used in e2e encrypted
 -- connection between client and server, as defined by SMP proxy.
@@ -171,7 +175,7 @@ currentServerSMPRelayVersion = VersionSMP 8
 -- to prevent client version fingerprinting by the
 -- destination relays when clients upgrade at different times.
 proxiedSMPRelayVersion :: VersionSMP
-proxiedSMPRelayVersion = VersionSMP 8
+proxiedSMPRelayVersion = VersionSMP 9
 
 -- minimal supported protocol version is 4
 -- TODO remove code that supports sending commands without batching
diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs
index 20480f84c..8684c787c 100644
--- a/tests/AgentTests/ConnectionRequestTests.hs
+++ b/tests/AgentTests/ConnectionRequestTests.hs
@@ -7,7 +7,12 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
-module AgentTests.ConnectionRequestTests where
+module AgentTests.ConnectionRequestTests
+  ( connectionRequestTests,
+    connReqData,
+    queueAddr,
+    testE2ERatchetParams12,
+  ) where
 
 import Data.ByteString (ByteString)
 import Network.HTTP.Types (urlEncode)
@@ -15,179 +20,228 @@ import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (ProtocolServer (..), pattern VersionSMPC, supportedSMPClientVRange)
+import Simplex.Messaging.Protocol (ProtocolServer (..), currentSMPClientVersion, supportedSMPClientVRange, pattern VersionSMPC)
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import Simplex.Messaging.Version
 import Test.Hspec
 
-uri :: String
-uri = "smp.simplex.im"
-
 srv :: SMPServer
-srv = SMPServer "smp.simplex.im" "5223" (C.KeyHash "\215m\248\251")
+srv = SMPServer "smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion" "5223" (C.KeyHash "\215m\248\251")
+
+srv1 :: SMPServer
+srv1 = SMPServer "smp.simplex.im" "5223" (C.KeyHash "\215m\248\251")
 
 queueAddr :: SMPQueueAddress
 queueAddr =
   SMPQueueAddress
     { smpServer = srv,
       senderId = "\223\142z\251",
-      dhPublicKey = testDhKey
+      dhPublicKey = testDhKey,
+      sndSecure = False
     }
 
+queueAddrSK :: SMPQueueAddress
+queueAddrSK = queueAddr {sndSecure = True}
+
+queueAddr1 :: SMPQueueAddress
+queueAddr1 = queueAddr {smpServer = srv1}
+
 queueAddrNoPort :: SMPQueueAddress
 queueAddrNoPort = queueAddr {smpServer = srv {port = ""}}
 
+queueAddrNoPort1 :: SMPQueueAddress
+queueAddrNoPort1 = queueAddr {smpServer = srv1 {port = ""}}
+
+-- current version range includes version 1 and it uses legacy encoding
 queue :: SMPQueueUri
 queue = SMPQueueUri supportedSMPClientVRange queueAddr
 
+queueSK :: SMPQueueUri
+queueSK = SMPQueueUri supportedSMPClientVRange queueAddrSK
+
+queueStr :: ByteString
+queueStr = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-3&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion"
+
+queueStrSK :: ByteString
+queueStrSK = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-3&dh=" <> url testDhKeyStr <> "&k=s" <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion"
+
+queue1 :: SMPQueueUri
+queue1 = SMPQueueUri supportedSMPClientVRange queueAddr1
+
+queue1Str :: ByteString
+queue1Str = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-3&dh=" <> url testDhKeyStr
+
 queueV1 :: SMPQueueUri
 queueV1 = SMPQueueUri (mkVersionRange (VersionSMPC 1) (VersionSMPC 1)) queueAddr
 
+queueV1NoPort :: SMPQueueUri
+queueV1NoPort = (queueV1 :: SMPQueueUri) {queueAddress = queueAddrNoPort}
+
+-- version range 2-3 uses new encoding
+-- it is fixed/changed in v5.8.2.
+queueNew :: SMPQueueUri
+queueNew = SMPQueueUri (mkVersionRange (VersionSMPC 2) currentSMPClientVersion) queueAddr
+
+queueNewStr :: ByteString
+queueNewStr = "smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion:5223/3456-w==#/?v=2-3&dh=" <> url testDhKeyStr
+
+queueNewStr' :: ByteString
+queueNewStr' = "smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion:5223/3456-w==#/?v=2-3&dh=" <> testDhKeyStr
+
+queueNewNoPort :: SMPQueueUri
+queueNewNoPort = (queueNew :: SMPQueueUri) {queueAddress = queueAddrNoPort}
+
+queueNew1 :: SMPQueueUri
+queueNew1 = SMPQueueUri (mkVersionRange (VersionSMPC 2) currentSMPClientVersion) queueAddr1
+
+queueNew1Str :: ByteString
+queueNew1Str = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=2-3&dh=" <> url testDhKeyStr
+
+queueNew1NoPort :: SMPQueueUri
+queueNew1NoPort = (queueNew1 :: SMPQueueUri) {queueAddress = queueAddrNoPort1}
+
 testDhKey :: C.PublicKeyX25519
 testDhKey = "MCowBQYDK2VuAyEAjiswwI3O/NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
 
 testDhKeyStr :: ByteString
 testDhKeyStr = strEncode testDhKey
 
-testDhKeyStrUri :: ByteString
-testDhKeyStrUri = urlEncode True testDhKeyStr
-
 connReqData :: ConnReqUriData
 connReqData =
   ConnReqUriData
     { crScheme = SSSimplex,
-      crAgentVRange = mkVersionRange (VersionSMPA 2) (VersionSMPA 2),
-      crSmpQueues = [queueV1],
+      crAgentVRange = supportedSMPAgentVRange,
+      crSmpQueues = [queue],
       crClientData = Nothing
     }
 
+connReqDataSK :: ConnReqUriData
+connReqDataSK = connReqData {crSmpQueues = [queueSK]}
+
+connReqData1 :: ConnReqUriData
+connReqData1 = connReqData {crSmpQueues = [queue1]}
+
+connReqDataV1 :: ConnReqUriData
+connReqDataV1 = connReqData {crAgentVRange = mkVersionRange (VersionSMPA 1) (VersionSMPA 1)}
+
+connReqDataV2 :: ConnReqUriData
+connReqDataV2 = connReqData {crAgentVRange = mkVersionRange (VersionSMPA 2) (VersionSMPA 2)}
+
+connReqDataNew :: ConnReqUriData
+connReqDataNew = connReqData {crSmpQueues = [queueNew]}
+
+connReqDataNew1 :: ConnReqUriData
+connReqDataNew1 = connReqData {crSmpQueues = [queueNew1]}
+
 testDhPubKey :: C.PublicKeyX448
 testDhPubKey = "MEIwBQYDK2VvAzkAmKuSYeQ/m0SixPDS8Wq8VBaTS1cW+Lp0n0h4Diu+kUpR+qXx4SDJ32YGEFoGFGSbGPry5Ychr6U="
 
 testE2ERatchetParams :: RcvE2ERatchetParamsUri 'C.X448
 testE2ERatchetParams = E2ERatchetParamsUri (mkVersionRange (VersionE2E 1) (VersionE2E 1)) testDhPubKey testDhPubKey Nothing
 
+testE2ERatchetParamsStrUri :: ByteString
+testE2ERatchetParamsStrUri = "v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
+
 testE2ERatchetParams12 :: RcvE2ERatchetParamsUri 'C.X448
 testE2ERatchetParams12 = E2ERatchetParamsUri supportedE2EEncryptVRange testDhPubKey testDhPubKey Nothing
 
 connectionRequest :: AConnectionRequestUri
-connectionRequest =
-  ACR SCMInvitation $
-    CRInvitationUri connReqData testE2ERatchetParams
+connectionRequest = ACR SCMInvitation $ CRInvitationUri connReqData testE2ERatchetParams
+
+connectionRequestSK :: AConnectionRequestUri
+connectionRequestSK = ACR SCMInvitation $ CRInvitationUri connReqDataSK testE2ERatchetParams
+
+connectionRequestV1 :: AConnectionRequestUri
+connectionRequestV1 = ACR SCMInvitation $ CRInvitationUri connReqDataV1 testE2ERatchetParams
+
+connectionRequest1 :: AConnectionRequestUri
+connectionRequest1 = ACR SCMInvitation $ CRInvitationUri connReqData1 testE2ERatchetParams
+
+connectionRequestNew :: AConnectionRequestUri
+connectionRequestNew = ACR SCMInvitation $ CRInvitationUri connReqDataNew testE2ERatchetParams
+
+connectionRequestNew1 :: AConnectionRequestUri
+connectionRequestNew1 = ACR SCMInvitation $ CRInvitationUri connReqDataNew1 testE2ERatchetParams
 
 contactAddress :: AConnectionRequestUri
 contactAddress = ACR SCMContact $ CRContactUri connReqData
 
-connectionRequestCurrentRange :: AConnectionRequestUri
-connectionRequestCurrentRange =
-  ACR SCMInvitation $
-    CRInvitationUri
-      connReqData {crAgentVRange = supportedSMPAgentVRange, crSmpQueues = [queueV1, queueV1]}
-      testE2ERatchetParams12
+contactAddressV2 :: AConnectionRequestUri
+contactAddressV2 = ACR SCMContact $ CRContactUri connReqDataV2
+
+contactAddressNew :: AConnectionRequestUri
+contactAddressNew = ACR SCMContact $ CRContactUri connReqDataNew
+
+connectionRequest2queues :: AConnectionRequestUri
+connectionRequest2queues = ACR SCMInvitation $ CRInvitationUri connReqData {crSmpQueues = [queue, queue]} testE2ERatchetParams
+
+connectionRequest2queuesNew :: AConnectionRequestUri
+connectionRequest2queuesNew = ACR SCMInvitation $ CRInvitationUri connReqDataNew {crSmpQueues = [queueNew, queueNew]} testE2ERatchetParams
+
+contactAddress2queues :: AConnectionRequestUri
+contactAddress2queues = ACR SCMContact $ CRContactUri connReqData {crSmpQueues = [queue, queue]}
+
+contactAddress2queuesNew :: AConnectionRequestUri
+contactAddress2queuesNew = ACR SCMContact $ CRContactUri connReqDataNew {crSmpQueues = [queueNew, queueNew]}
 
 connectionRequestClientDataEmpty :: AConnectionRequestUri
-connectionRequestClientDataEmpty =
-  ACR SCMInvitation $
-    CRInvitationUri connReqData {crClientData = Just "{}"} testE2ERatchetParams
+connectionRequestClientDataEmpty = ACR SCMInvitation $ CRInvitationUri connReqData {crClientData = Just "{}"} testE2ERatchetParams
 
-connectionRequestClientData :: AConnectionRequestUri
-connectionRequestClientData =
-  ACR SCMInvitation $
-    CRInvitationUri connReqData {crClientData = Just "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}"} testE2ERatchetParams
+contactAddressClientData :: AConnectionRequestUri
+contactAddressClientData = ACR SCMContact $ CRContactUri connReqData {crClientData = Just "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}"}
+
+url :: ByteString -> ByteString
+url = urlEncode True
+
+(==#) :: (StrEncoding a, HasCallStack) => a -> ByteString -> Expectation
+a ==# s = strEncode a `shouldBe` s
+
+(#==) :: (StrEncoding a, Eq a, Show a, HasCallStack) => a -> ByteString -> Expectation
+a #== s = strDecode s `shouldBe` Right a
+
+(#==#) :: (StrEncoding a, Eq a, Show a, HasCallStack) => a -> ByteString -> Expectation
+a #==# s = do
+  a ==# s
+  a #== s
 
 connectionRequestTests :: Spec
 connectionRequestTests =
   describe "connection request parsing / serializing" $ do
-    it "should serialize SMP queue URIs" $ do
-      strEncode (queue :: SMPQueueUri) {queueAddress = queueAddrNoPort}
-        `shouldBe` "smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-2&dh=" <> testDhKeyStrUri
-      strEncode queue {clientVRange = mkVersionRange (VersionSMPC 1) (VersionSMPC 2)}
-        `shouldBe` "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-2&dh=" <> testDhKeyStrUri
-    it "should parse SMP queue URIs" $ do
-      strDecode ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-2&dh=" <> testDhKeyStr)
-        `shouldBe` Right (queue :: SMPQueueUri) {queueAddress = queueAddrNoPort}
-      strDecode ("smp://1234-w==@smp.simplex.im/3456-w==#" <> testDhKeyStr)
-        `shouldBe` Right (queueV1 :: SMPQueueUri) {queueAddress = queueAddrNoPort}
-      strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr)
-        `shouldBe` Right queueV1
-      strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1-2&extra_param=abc")
-        `shouldBe` Right queue
-      strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#/?extra_param=abc&v=1&dh=" <> testDhKeyStr)
-        `shouldBe` Right queueV1
-      strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1&extra_param=abc")
-        `shouldBe` Right queueV1
-    it "should serialize connection requests" $ do
-      strEncode connectionRequest
-        `shouldBe` "simplex:/invitation#/?v=2&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 connectionRequestCurrentRange
-        `shouldBe` "simplex:/invitation#/?v=2-5&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
-          <> "&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
-      strEncode connectionRequestClientDataEmpty
-        `shouldBe` "simplex:/invitation#/?v=2&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"
-          <> "&data=%7B%7D"
-      strEncode connectionRequestClientData
-        `shouldBe` "simplex:/invitation#/?v=2&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"
-          <> "&data=%7B%22type%22%3A%22group_link%22%2C%20%22group_link_id%22%3A%22abc%22%7D"
-    it "should parse connection requests" $ do
-      strDecode
-        ( "https://simplex.chat/contact#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
-            <> testDhKeyStrUri
-            <> "&v=1" -- adjusted to v2
-        )
-        `shouldBe` Right contactAddress
-      strDecode
-        ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
-            <> testDhKeyStrUri
-            <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
-            <> "&v=2"
-        )
-        `shouldBe` Right connectionRequest
-      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
-            <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
-            <> "&v=2"
-        )
-        `shouldBe` Right connectionRequest
-      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
-            <> "&e2e=v%3D1-1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
-            <> "&v=2-2"
-        )
-        `shouldBe` Right connectionRequest
-      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%26extra_param%3Dabc%26dh%3D"
-            <> testDhKeyStrUri
-            <> "%2Csmp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
-            <> testDhKeyStrUri
-            <> "&e2e=extra_key%3Dnew%26v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
-            <> "&some_new_param=abc"
-            <> "&v=2-5"
-        )
-        `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
-            <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
-            <> "&data=%7B%7D"
-            <> "&v=2-2"
-        )
-        `shouldBe` Right connectionRequestClientDataEmpty
-      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
-            <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
-            <> "&data=%7B%22type%22%3A%22group_link%22%2C%20%22group_link_id%22%3A%22abc%22%7D"
-            <> "&v=2"
-        )
-        `shouldBe` Right connectionRequestClientData
+    it "should serialize and parse SMP queue URIs" $ do
+      queue #==# queueStr
+      queue #== ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1-3&extra_param=abc&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
+      queueSK #==# queueStrSK
+      queue1 #==# queue1Str
+      queueNew #==# queueNewStr
+      queueNew #== queueNewStr'
+      queueNew1 #==# queueNew1Str
+      queueNewNoPort #==# ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#/?v=2-3&dh=" <> url testDhKeyStr)
+      queueNew1NoPort #==# ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=2-3&dh=" <> url testDhKeyStr)
+      queueV1 #==# ("smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
+      queueV1 #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion:5223/3456-w==#" <> testDhKeyStr)
+      queueV1 #== ("smp://1234-w==@smp.simplex.im:5223/3456-w==#/?extra_param=abc&v=1&dh=" <> testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
+      queueV1 #== ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1&extra_param=abc&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
+      queueV1NoPort #==# ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
+      queueV1NoPort #== ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
+      queueV1NoPort #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#" <> testDhKeyStr)
+    it "should serialize and parse connection invitations and contact addresses" $ do
+      connectionRequest #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest #== ("https://simplex.chat/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestSK #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStrSK <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest1 #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queue1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest2queues #==# ("simplex:/invitation#/?v=2-6&smp=" <> url (queueStr <> ";" <> queueStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestNew #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueNewStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-6&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestV1 #== ("https://simplex.chat/invitation#/?v=1&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}")
+      contactAddress #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueStr)
+      contactAddress #== ("https://simplex.chat/contact#/?v=2-6&smp=" <> url queueStr)
+      contactAddress2queues #==# ("simplex:/contact#/?v=2-6&smp=" <> url (queueStr <> ";" <> queueStr))
+      contactAddressNew #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueNewStr)
+      contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-6&smp=" <> url (queueNewStr <> ";" <> queueNewStr))
+      contactAddressV2 #==# ("simplex:/contact#/?v=2&smp=" <> url queueStr)
+      contactAddressV2 #== ("https://simplex.chat/contact#/?v=1&smp=" <> url queueStr) -- adjusted to v2
+      contactAddressV2 #== ("https://simplex.chat/contact#/?v=1-2&smp=" <> url queueStr) -- adjusted to v2
+      contactAddressV2 #== ("https://simplex.chat/contact#/?v=2-2&smp=" <> url queueStr)
+      contactAddressClientData #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}")
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index d52c12877..9f133ebf5 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -25,7 +25,7 @@ module AgentTests.FunctionalAPITests
     withAgentClients2,
     withAgentClients3,
     makeConnection,
-    exchangeGreetingsMsgId,
+    exchangeGreetings,
     switchComplete,
     createConnection,
     joinConnection,
@@ -47,7 +47,7 @@ module AgentTests.FunctionalAPITests
     pattern Msg,
     pattern Msg',
     pattern SENT,
-    agentCfgV7,
+    agentCfgVPrevPQ,
   )
 where
 
@@ -75,7 +75,7 @@ import Data.Word (Word16)
 import qualified Database.SQLite.Simple as SQL
 import GHC.Stack (withFrozenCallStack)
 import SMPAgentClient
-import SMPClient (cfg, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerOn, withSmpServerProxy, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn, withSmpServerV7)
+import SMPClient (cfg, prevRange, prevVersion, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerOn, withSmpServerProxy, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import qualified Simplex.Messaging.Agent as A
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), UserNetworkInfo (..), UserNetworkType (..), waitForUserNetwork)
@@ -89,13 +89,13 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Notifications.Transport (NTFVersion, authBatchCmdsNTFVersion, pattern VersionNTF)
+import Simplex.Messaging.Notifications.Transport (NTFVersion, pattern VersionNTF)
 import Simplex.Messaging.Protocol (BasicAuth, ErrorType (..), MsgBody, ProtocolServer (..), SubscriptionMode (..), supportedSMPClientVRange)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.QueueStore.QueueInfo
-import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, basicAuthSMPVersion, batchCmdsSMPVersion, currentServerSMPRelayVersion, supportedSMPHandshakes)
+import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, basicAuthSMPVersion, batchCmdsSMPVersion, currentServerSMPRelayVersion, sndAuthKeySMPVersion, supportedSMPHandshakes)
 import Simplex.Messaging.Util (bshow, diffToMicroseconds)
 import Simplex.Messaging.Version (VersionRange (..))
 import qualified Simplex.Messaging.Version as V
@@ -195,46 +195,25 @@ pattern Rcvd agentMsgId <- RCVD MsgMeta {integrity = MsgOk} [MsgReceipt {agentMs
 smpCfgVPrev :: ProtocolClientConfig SMPVersion
 smpCfgVPrev = (smpCfg agentCfg) {clientALPN = Nothing, serverVRange = prevRange $ serverVRange $ smpCfg agentCfg}
 
-smpCfgV7 :: ProtocolClientConfig SMPVersion
-smpCfgV7 = (smpCfg agentCfg) {serverVRange = V.mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion}
-
 ntfCfgVPrev :: ProtocolClientConfig NTFVersion
 ntfCfgVPrev = (ntfCfg agentCfg) {clientALPN = Nothing, serverVRange = V.mkVersionRange (VersionNTF 1) (VersionNTF 1)}
 
-ntfCfgV2 :: ProtocolClientConfig NTFVersion
-ntfCfgV2 = (ntfCfg agentCfg) {serverVRange = V.mkVersionRange (VersionNTF 1) authBatchCmdsNTFVersion}
-
 agentCfgVPrev :: AgentConfig
-agentCfgVPrev =
+agentCfgVPrev = agentCfgVPrevPQ {e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg}
+
+agentCfgVPrevPQ :: AgentConfig
+agentCfgVPrevPQ =
   agentCfg
     { sndAuthAlg = C.AuthAlg C.SEd25519,
       smpAgentVRange = prevRange $ smpAgentVRange agentCfg,
       smpClientVRange = prevRange $ smpClientVRange agentCfg,
-      e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg,
       smpCfg = smpCfgVPrev,
       ntfCfg = ntfCfgVPrev
     }
 
--- agent config for the next client version
-agentCfgV7 :: AgentConfig
-agentCfgV7 =
-  agentCfg
-    { sndAuthAlg = C.AuthAlg C.SX25519,
-      smpAgentVRange = V.mkVersionRange duplexHandshakeSMPAgentVersion $ max pqdrSMPAgentVersion currentSMPAgentVersion,
-      e2eEncryptVRange = V.mkVersionRange CR.kdfX3DHE2EEncryptVersion $ max CR.pqRatchetE2EEncryptVersion CR.currentE2EEncryptVersion,
-      smpCfg = smpCfgV7,
-      ntfCfg = ntfCfgV2
-    }
-
 agentCfgRatchetVPrev :: AgentConfig
 agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg}
 
-prevRange :: VersionRange v -> VersionRange v
-prevRange vr = vr {maxVersion = max (minVersion vr) (prevVersion $ maxVersion vr)}
-
-prevVersion :: Version v -> Version v
-prevVersion (Version v) = Version (v - 1)
-
 mkVersionRange :: Word16 -> Word16 -> VersionRange v
 mkVersionRange v1 v2 = V.mkVersionRange (Version v1) (Version v2)
 
@@ -345,6 +324,8 @@ functionalAPITests t = do
       it "should synchronize ratchets when clients start synchronization simultaneously" $
         testRatchetSyncSimultaneous t
     describe "Subscription mode OnlyCreate" $ do
+      it "messages delivered only when polled (v8 - slow handshake)" $
+        withSmpServer t testOnlyCreatePullSlowHandshake
       it "messages delivered only when polled" $
         withSmpServer t testOnlyCreatePull
   describe "Inactive client disconnection" $ do
@@ -371,14 +352,16 @@ functionalAPITests t = do
       withSmpServer t $
         testBatchedPendingMessages 10 5
   describe "Async agent commands" $ do
-    it "should connect using async agent commands" $
-      withSmpServer t testAsyncCommands
+    describe "connect using async agent commands" $
+      testBasicMatrix2 t testAsyncCommands
     it "should restore and complete async commands on restart" $
       testAsyncCommandsRestore t
-    it "should accept connection using async command" $
-      withSmpServer t testAcceptContactAsync
+    describe "accept connection using async command" $
+      testBasicMatrix2 t testAcceptContactAsync
     it "should delete connections using async command when server connection fails" $
       testDeleteConnectionAsync t
+    it "join connection when reply queue creation fails (v8 - slow handshake)" $
+      testJoinConnectionAsyncReplyErrorV8 t
     it "join connection when reply queue creation fails" $
       testJoinConnectionAsyncReplyError t
     describe "delete connection waiting for delivery" $ do
@@ -421,29 +404,30 @@ functionalAPITests t = do
   describe "SMP basic auth" $ do
     let v4 = prevVersion basicAuthSMPVersion
     forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, currentServerSMPRelayVersion]) $ \v -> do
+      let baseId = if v >= sndAuthKeySMPVersion then 1 else 3
       describe ("v" <> show v <> ": with server auth") $ do
         --                                       allow NEW | server auth, v | clnt1 auth, v  | clnt2 auth, v    |  2 - success, 1 - JOIN fail, 0 - NEW fail
-        it "success                " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) `shouldReturn` 2
-        it "disabled               " $ testBasicAuth t False (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) `shouldReturn` 0
-        it "NEW fail, no auth      " $ testBasicAuth t True (Just "abcd", v) (Nothing, v) (Just "abcd", v) `shouldReturn` 0
-        it "NEW fail, bad auth     " $ testBasicAuth t True (Just "abcd", v) (Just "wrong", v) (Just "abcd", v) `shouldReturn` 0
-        it "NEW fail, version      " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v4) (Just "abcd", v) `shouldReturn` 0
-        it "JOIN fail, no auth     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Nothing, v) `shouldReturn` 1
-        it "JOIN fail, bad auth    " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "wrong", v) `shouldReturn` 1
-        it "JOIN fail, version     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v4) `shouldReturn` 1
+        it "success                " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 2
+        it "disabled               " $ testBasicAuth t False (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 0
+        it "NEW fail, no auth      " $ testBasicAuth t True (Just "abcd", v) (Nothing, v) (Just "abcd", v) baseId `shouldReturn` 0
+        it "NEW fail, bad auth     " $ testBasicAuth t True (Just "abcd", v) (Just "wrong", v) (Just "abcd", v) baseId `shouldReturn` 0
+        it "NEW fail, version      " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v4) (Just "abcd", v) baseId `shouldReturn` 0
+        it "JOIN fail, no auth     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Nothing, v) baseId `shouldReturn` 1
+        it "JOIN fail, bad auth    " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "wrong", v) baseId `shouldReturn` 1
+        it "JOIN fail, version     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v4) baseId `shouldReturn` 1
       describe ("v" <> show v <> ": no server auth") $ do
-        it "success     " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v) `shouldReturn` 2
-        it "srv disabled" $ testBasicAuth t False (Nothing, v) (Nothing, v) (Nothing, v) `shouldReturn` 0
-        it "version srv " $ testBasicAuth t True (Nothing, v4) (Nothing, v) (Nothing, v) `shouldReturn` 2
-        it "version fst " $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v) `shouldReturn` 2
-        it "version snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v4) `shouldReturn` 2
-        it "version both" $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v4) `shouldReturn` 2
-        it "version all " $ testBasicAuth t True (Nothing, v4) (Nothing, v4) (Nothing, v4) `shouldReturn` 2
-        it "auth fst    " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Nothing, v) `shouldReturn` 2
-        it "auth fst 2  " $ testBasicAuth t True (Nothing, v4) (Just "abcd", v) (Nothing, v) `shouldReturn` 2
-        it "auth snd    " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Just "abcd", v) `shouldReturn` 2
-        it "auth both   " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Just "abcd", v) `shouldReturn` 2
-        it "auth, disabled" $ testBasicAuth t False (Nothing, v) (Just "abcd", v) (Just "abcd", v) `shouldReturn` 0
+        it "success     " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v) baseId `shouldReturn` 2
+        it "srv disabled" $ testBasicAuth t False (Nothing, v) (Nothing, v) (Nothing, v) baseId `shouldReturn` 0
+        it "version srv " $ testBasicAuth t True (Nothing, v4) (Nothing, v) (Nothing, v) 3 `shouldReturn` 2
+        it "version fst " $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v) baseId `shouldReturn` 2
+        it "version snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v4) 3 `shouldReturn` 2
+        it "version both" $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v4) 3 `shouldReturn` 2
+        it "version all " $ testBasicAuth t True (Nothing, v4) (Nothing, v4) (Nothing, v4) 3 `shouldReturn` 2
+        it "auth fst    " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Nothing, v) baseId `shouldReturn` 2
+        it "auth fst 2  " $ testBasicAuth t True (Nothing, v4) (Just "abcd", v) (Nothing, v) 3 `shouldReturn` 2
+        it "auth snd    " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Just "abcd", v) baseId `shouldReturn` 2
+        it "auth both   " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 2
+        it "auth, disabled" $ testBasicAuth t False (Nothing, v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 0
   describe "SMP server test via agent API" $ do
     it "should pass without basic auth" $ testSMPServerConnectionTest t Nothing (noAuthSrv testSMPServer2) `shouldReturn` Nothing
     let srv1 = testSMPServer2 {keyHash = "1234"}
@@ -471,8 +455,8 @@ functionalAPITests t = do
     it "server should respond with queue and subscription information" $
       withSmpServer t testServerQueueInfo
 
-testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> IO Int
-testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 = do
+testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> AgentMsgId -> IO Int
+testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 baseId = do
   let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = V.mkVersionRange batchCmdsSMPVersion srvVersion}
       canCreate1 = canCreateQueue allowNewQueues srv clnt1
       canCreate2 = canCreateQueue allowNewQueues srv clnt2
@@ -480,7 +464,7 @@ testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 = do
         | canCreate1 && canCreate2 = 2
         | canCreate1 = 1
         | otherwise = 0
-  created <- withSmpServerConfigOn t testCfg testPort $ \_ -> testCreateQueueAuth srvVersion clnt1 clnt2
+  created <- withSmpServerConfigOn t testCfg testPort $ \_ -> testCreateQueueAuth srvVersion clnt1 clnt2 baseId
   created `shouldBe` expected
   pure created
 
@@ -491,26 +475,28 @@ canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =
 
 testMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2 t runTest = do
-  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfg agentProxyCfg (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
-  it "v7" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfgV7 3 $ runTest PQSupportOn False
-  it "v7 to current" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfg 3 $ runTest PQSupportOn False
-  it "current to v7" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfgV7 3 $ runTest PQSupportOn False
-  it "current with v7 server" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfg 3 $ runTest PQSupportOn False
-  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 $ runTest PQSupportOn False
+  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
+  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
+  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
   it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 $ runTest PQSupportOff False
   it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff False
   it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff False
 
+testBasicMatrix2 :: HasCallStack => ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testBasicMatrix2 t runTest = do
+  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest
+  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 3 $ runTest
+  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfg 3 $ runTest
+  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrevPQ 3 $ runTest
+
 testRatchetMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testRatchetMatrix2 t runTest = do
-  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfg agentProxyCfg (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
-  it "ratchet next" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfgV7 3 $ runTest PQSupportOn False
-  it "ratchet next to current" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfg 3 $ runTest PQSupportOn False
-  it "ratchet current to next" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfgV7 3 $ runTest PQSupportOn False
-  it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 $ runTest PQSupportOn False
-  it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 3 $ runTest PQSupportOff False
-  it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 3 $ runTest PQSupportOff False
-  it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 3 $ runTest PQSupportOff False
+  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
+  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
+  it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
+  it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
+  it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff False
+  it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
 
 testServerMatrix2 :: HasCallStack => ATransport -> (InitialAgentServers -> IO ()) -> Spec
 testServerMatrix2 t runTest = do
@@ -533,7 +519,7 @@ pqMatrix2_ pqInv t test = do
     it "pq-inv/dh handshake" $ runTest $ \a b -> test (a, IKUsePQ) (b, PQSupportOff)
     it "pq-inv/pq handshake" $ runTest $ \a b -> test (a, IKUsePQ) (b, PQSupportOn)
   where
-    runTest = withSmpServerProxy t . runTestCfgServers2 agentProxyCfg agentProxyCfg (initAgentServersProxy SPMAlways SPFProhibit) 3
+    runTest = withSmpServerProxy t . runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3
 
 testPQMatrix3 ::
   HasCallStack =>
@@ -552,8 +538,8 @@ testPQMatrix3 t test = do
   where
     runTest test' =
       withSmpServerProxy t $
-        runTestCfgServers2 agentProxyCfg agentProxyCfg servers 3 $ \a b baseMsgId ->
-          withAgent 3 agentProxyCfg servers testDB3 $ \c -> test' a b c baseMsgId
+        runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 servers 3 $ \a b baseMsgId ->
+          withAgent 3 agentProxyCfgV8 servers testDB3 $ \c -> test' a b c baseMsgId
     servers = initAgentServersProxy SPMAlways SPFProhibit
 
 runTestCfg2 :: HasCallStack => AgentConfig -> AgentConfig -> AgentMsgId -> (HasCallStack => AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> IO ()
@@ -637,48 +623,48 @@ testEnablePQEncryption =
     (aId, bId) <- makeConnection_ PQSupportOff ca cb
     let a = (ca, aId)
         b = (cb, bId)
-    (a, 4, "msg 1") \#>\ b
-    (b, 5, "msg 2") \#>\ a
+    (a, 2, "msg 1") \#>\ b
+    (b, 3, "msg 2") \#>\ a
     -- 45 bytes is used by agent message envelope inside double ratchet message envelope
     let largeMsg g' pqEnc = atomically $ C.randomBytes (e2eEncAgentMsgLength pqdrSMPAgentVersion pqEnc - 45) g'
     lrg <- largeMsg g PQSupportOff
-    (a, 6, lrg) \#>\ b
-    (b, 7, lrg) \#>\ a
+    (a, 4, lrg) \#>\ b
+    (b, 5, lrg) \#>\ a
     -- switched to smaller envelopes (before reporting PQ encryption enabled)
     sml <- largeMsg g PQSupportOn
     -- fail because of message size
     Left (A.CMD LARGE _) <- tryError $ A.sendMessage ca bId PQEncOn SMP.noMsgFlags lrg
-    (9, PQEncOff) <- A.sendMessage ca bId PQEncOn SMP.noMsgFlags sml
-    get ca =##> \case ("", connId, SENT 9) -> connId == bId; _ -> False
-    get cb =##> \case ("", connId, MsgErr' 8 MsgSkipped {} PQEncOff msg') -> connId == aId && msg' == sml; _ -> False
-    ackMessage cb aId 8 Nothing
+    (7, PQEncOff) <- A.sendMessage ca bId PQEncOn SMP.noMsgFlags sml
+    get ca =##> \case ("", connId, SENT 7) -> connId == bId; _ -> False
+    get cb =##> \case ("", connId, MsgErr' 6 MsgSkipped {} PQEncOff msg') -> connId == aId && msg' == sml; _ -> False
+    ackMessage cb aId 6 Nothing
     -- -- fail in reply to sync IDss
     Left (A.CMD LARGE _) <- tryError $ A.sendMessage cb aId PQEncOn SMP.noMsgFlags lrg
-    (10, PQEncOff) <- A.sendMessage cb aId PQEncOn SMP.noMsgFlags sml
-    get cb =##> \case ("", connId, SENT 10) -> connId == aId; _ -> False
-    get ca =##> \case ("", connId, MsgErr' 10 MsgSkipped {} PQEncOff msg') -> connId == bId && msg' == sml; _ -> False
-    ackMessage ca bId 10 Nothing
-    (a, 11, sml) \#>! b
+    (8, PQEncOff) <- A.sendMessage cb aId PQEncOn SMP.noMsgFlags sml
+    get cb =##> \case ("", connId, SENT 8) -> connId == aId; _ -> False
+    get ca =##> \case ("", connId, MsgErr' 8 MsgSkipped {} PQEncOff msg') -> connId == bId && msg' == sml; _ -> False
+    ackMessage ca bId 8 Nothing
+    (a, 9, sml) \#>! b
     -- PQ encryption now enabled
+    (b, 10, sml) !#>! a
+    (a, 11, sml) !#>! b
     (b, 12, sml) !#>! a
-    (a, 13, sml) !#>! b
-    (b, 14, sml) !#>! a
     -- disabling PQ encryption
-    (a, 15, sml) !#>\ b
-    (b, 16, sml) !#>\ a
-    (a, 17, sml) \#>\ b
-    (b, 18, sml) \#>\ a
+    (a, 13, sml) !#>\ b
+    (b, 14, sml) !#>\ a
+    (a, 15, sml) \#>\ b
+    (b, 16, sml) \#>\ a
     -- enabling PQ encryption again
+    (a, 17, sml) \#>! b
+    (b, 18, sml) \#>! a
     (a, 19, sml) \#>! b
-    (b, 20, sml) \#>! a
-    (a, 21, sml) \#>! b
-    (b, 22, sml) !#>! a
-    (a, 23, sml) !#>! b
+    (b, 20, sml) !#>! a
+    (a, 21, sml) !#>! b
     -- disabling PQ encryption again
-    (b, 24, sml) !#>\ a
-    (a, 25, sml) !#>\ b
-    (b, 26, sml) \#>\ a
-    (a, 27, sml) \#>\ b
+    (b, 22, sml) !#>\ a
+    (a, 23, sml) !#>\ b
+    (b, 24, sml) \#>\ a
+    (a, 25, sml) \#>\ b
     -- PQ encryption is now disabled, but support remained enabled, so we still cannot send larger messages
     Left (A.CMD LARGE _) <- tryError $ A.sendMessage ca bId PQEncOff SMP.noMsgFlags (sml <> "123456")
     Left (A.CMD LARGE _) <- tryError $ A.sendMessage cb aId PQEncOff SMP.noMsgFlags (sml <> "123456")
@@ -703,22 +689,22 @@ testAgentClient3 =
     (aIdForB, bId) <- makeConnection a b
     (aIdForC, cId) <- makeConnection a c
 
-    4 <- sendMessage a bId SMP.noMsgFlags "b4"
-    4 <- sendMessage a cId SMP.noMsgFlags "c4"
-    5 <- sendMessage a bId SMP.noMsgFlags "b5"
-    5 <- sendMessage a cId SMP.noMsgFlags "c5"
-    get a =##> \case ("", connId, SENT 4) -> connId == bId || connId == cId; _ -> False
-    get a =##> \case ("", connId, SENT 4) -> connId == bId || connId == cId; _ -> False
-    get a =##> \case ("", connId, SENT 5) -> connId == bId || connId == cId; _ -> False
-    get a =##> \case ("", connId, SENT 5) -> connId == bId || connId == cId; _ -> False
+    2 <- sendMessage a bId SMP.noMsgFlags "b4"
+    2 <- sendMessage a cId SMP.noMsgFlags "c4"
+    3 <- sendMessage a bId SMP.noMsgFlags "b5"
+    3 <- sendMessage a cId SMP.noMsgFlags "c5"
+    get a =##> \case ("", connId, SENT 2) -> connId == bId || connId == cId; _ -> False
+    get a =##> \case ("", connId, SENT 2) -> connId == bId || connId == cId; _ -> False
+    get a =##> \case ("", connId, SENT 3) -> connId == bId || connId == cId; _ -> False
+    get a =##> \case ("", connId, SENT 3) -> connId == bId || connId == cId; _ -> False
     get b =##> \case ("", connId, Msg "b4") -> connId == aIdForB; _ -> False
-    ackMessage b aIdForB 4 Nothing
+    ackMessage b aIdForB 2 Nothing
     get b =##> \case ("", connId, Msg "b5") -> connId == aIdForB; _ -> False
-    ackMessage b aIdForB 5 Nothing
+    ackMessage b aIdForB 3 Nothing
     get c =##> \case ("", connId, Msg "c4") -> connId == aIdForC; _ -> False
-    ackMessage c aIdForC 4 Nothing
+    ackMessage c aIdForC 2 Nothing
     get c =##> \case ("", connId, Msg "c5") -> connId == aIdForC; _ -> False
-    ackMessage c aIdForC 5 Nothing
+    ackMessage c aIdForC 3 Nothing
 
 runAgentClientContactTest :: HasCallStack => PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 runAgentClientContactTest pqSupport viaProxy alice bob baseId =
@@ -920,7 +906,7 @@ testAllowConnectionClientRestart t = do
 
     runRight_ $ do
       allowConnectionAsync alice "1" bobId confId "alice's connInfo"
-      get alice =##> \case ("1", _, OK) -> True; _ -> False
+      get alice ##> ("1", bobId, OK)
       pure ()
 
     threadDelay 100000 -- give time to enqueue confirmation (enqueueConfirmation)
@@ -937,8 +923,7 @@ testAllowConnectionClientRestart t = do
         get alice2 ##> ("", bobId, CON)
         get bob ##> ("", aliceId, INFO "alice's connInfo")
         get bob ##> ("", aliceId, CON)
-
-        exchangeGreetingsMsgId 4 alice2 bobId bob aliceId
+        exchangeGreetings alice2 bobId bob aliceId
     disposeAgentClient alice2
     disposeAgentClient bob
 
@@ -949,7 +934,7 @@ testIncreaseConnAgentVersion t = do
   withSmpServerStoreMsgLogOn t testPort $ \_ -> do
     (aliceId, bobId) <- runRight $ do
       (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
-      exchangeGreetingsMsgId_ PQEncOff 4 alice bobId bob aliceId
+      exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
       checkVersion alice bobId 2
       checkVersion bob aliceId 2
       pure (aliceId, bobId)
@@ -961,7 +946,7 @@ testIncreaseConnAgentVersion t = do
 
     runRight_ $ do
       subscribeConnection alice2 bobId
-      exchangeGreetingsMsgId_ PQEncOff 6 alice2 bobId bob aliceId
+      exchangeGreetingsMsgId_ PQEncOff 4 alice2 bobId bob aliceId
       checkVersion alice2 bobId 2
       checkVersion bob aliceId 2
 
@@ -972,7 +957,7 @@ testIncreaseConnAgentVersion t = do
 
     runRight_ $ do
       subscribeConnection bob2 aliceId
-      exchangeGreetingsMsgId_ PQEncOff 8 alice2 bobId bob2 aliceId
+      exchangeGreetingsMsgId_ PQEncOff 6 alice2 bobId bob2 aliceId
       checkVersion alice2 bobId 3
       checkVersion bob2 aliceId 3
 
@@ -983,7 +968,7 @@ testIncreaseConnAgentVersion t = do
 
     runRight_ $ do
       subscribeConnection alice3 bobId
-      exchangeGreetingsMsgId_ PQEncOff 10 alice3 bobId bob2 aliceId
+      exchangeGreetingsMsgId_ PQEncOff 8 alice3 bobId bob2 aliceId
       checkVersion alice3 bobId 3
       checkVersion bob2 aliceId 3
 
@@ -992,7 +977,7 @@ testIncreaseConnAgentVersion t = do
 
     runRight_ $ do
       subscribeConnection bob3 aliceId
-      exchangeGreetingsMsgId_ PQEncOff 12 alice3 bobId bob3 aliceId
+      exchangeGreetingsMsgId_ PQEncOff 10 alice3 bobId bob3 aliceId
       checkVersion alice3 bobId 3
       checkVersion bob3 aliceId 3
     disposeAgentClient alice3
@@ -1010,7 +995,7 @@ testIncreaseConnAgentVersionMaxCompatible t = do
   withSmpServerStoreMsgLogOn t testPort $ \_ -> do
     (aliceId, bobId) <- runRight $ do
       (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
-      exchangeGreetingsMsgId_ PQEncOff 4 alice bobId bob aliceId
+      exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
       checkVersion alice bobId 2
       checkVersion bob aliceId 2
       pure (aliceId, bobId)
@@ -1025,7 +1010,7 @@ testIncreaseConnAgentVersionMaxCompatible t = do
     runRight_ $ do
       subscribeConnection alice2 bobId
       subscribeConnection bob2 aliceId
-      exchangeGreetingsMsgId_ PQEncOff 6 alice2 bobId bob2 aliceId
+      exchangeGreetingsMsgId_ PQEncOff 4 alice2 bobId bob2 aliceId
       checkVersion alice2 bobId 3
       checkVersion bob2 aliceId 3
     disposeAgentClient alice2
@@ -1038,7 +1023,7 @@ testIncreaseConnAgentVersionStartDifferentVersion t = do
   withSmpServerStoreMsgLogOn t testPort $ \_ -> do
     (aliceId, bobId) <- runRight $ do
       (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
-      exchangeGreetingsMsgId_ PQEncOff 4 alice bobId bob aliceId
+      exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
       checkVersion alice bobId 2
       checkVersion bob aliceId 2
       pure (aliceId, bobId)
@@ -1050,7 +1035,7 @@ testIncreaseConnAgentVersionStartDifferentVersion t = do
 
     runRight_ $ do
       subscribeConnection alice2 bobId
-      exchangeGreetingsMsgId_ PQEncOff 6 alice2 bobId bob aliceId
+      exchangeGreetingsMsgId_ PQEncOff 4 alice2 bobId bob aliceId
       checkVersion alice2 bobId 3
       checkVersion bob aliceId 3
     disposeAgentClient alice2
@@ -1064,13 +1049,13 @@ testDeliverClientRestart t = do
   (aliceId, bobId) <- withSmpServerStoreMsgLogOn t testPort $ \_ -> do
     runRight $ do
       (aliceId, bobId) <- makeConnection alice bob
-      exchangeGreetingsMsgId 4 alice bobId bob aliceId
+      exchangeGreetings alice bobId bob aliceId
       pure (aliceId, bobId)
 
   ("", "", DOWN _ _) <- nGet alice
   ("", "", DOWN _ _) <- nGet bob
 
-  6 <- runRight $ sendMessage bob aliceId SMP.noMsgFlags "hello"
+  4 <- runRight $ sendMessage bob aliceId SMP.noMsgFlags "hello"
 
   disposeAgentClient bob
 
@@ -1082,7 +1067,7 @@ testDeliverClientRestart t = do
 
       subscribeConnection bob2 aliceId
 
-      get bob2 ##> ("", aliceId, SENT 6)
+      get bob2 ##> ("", aliceId, SENT 4)
       get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
   disposeAgentClient alice
   disposeAgentClient bob2
@@ -1094,8 +1079,8 @@ testDuplicateMessage t = do
   (aliceId, bobId, bob1) <- withSmpServerStoreMsgLogOn t testPort $ \_ -> do
     (aliceId, bobId) <- runRight $ makeConnection alice bob
     runRight_ $ do
-      4 <- sendMessage alice bobId SMP.noMsgFlags "hello"
-      get alice ##> ("", bobId, SENT 4)
+      2 <- sendMessage alice bobId SMP.noMsgFlags "hello"
+      get alice ##> ("", bobId, SENT 2)
       get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
     disposeAgentClient bob
 
@@ -1104,9 +1089,9 @@ testDuplicateMessage t = do
     runRight_ $ do
       subscribeConnection bob1 aliceId
       get bob1 =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
-      ackMessage bob1 aliceId 4 Nothing
-      5 <- sendMessage alice bobId SMP.noMsgFlags "hello 2"
-      get alice ##> ("", bobId, SENT 5)
+      ackMessage bob1 aliceId 2 Nothing
+      3 <- sendMessage alice bobId SMP.noMsgFlags "hello 2"
+      get alice ##> ("", bobId, SENT 3)
       get bob1 =##> \case ("", c, Msg "hello 2") -> c == aliceId; _ -> False
 
     pure (aliceId, bobId, bob1)
@@ -1116,7 +1101,7 @@ testDuplicateMessage t = do
   -- commenting two lines below and uncommenting further two lines would also runRight_,
   -- it is the scenario tested above, when the message was not acknowledged by the user
   threadDelay 200000
-  Left (BROKER _ NETWORK) <- runExceptT $ ackMessage bob1 aliceId 5 Nothing
+  Left (BROKER _ NETWORK) <- runExceptT $ ackMessage bob1 aliceId 3 Nothing
 
   disposeAgentClient alice
   disposeAgentClient bob1
@@ -1131,8 +1116,8 @@ testDuplicateMessage t = do
       -- get bob2 =##> \case ("", c, Msg "hello 2") -> c == aliceId; _ -> False
       -- ackMessage bob2 aliceId 5 Nothing
       -- message 2 is not delivered again, even though it was delivered to the agent
-      6 <- sendMessage alice2 bobId SMP.noMsgFlags "hello 3"
-      get alice2 ##> ("", bobId, SENT 6)
+      4 <- sendMessage alice2 bobId SMP.noMsgFlags "hello 3"
+      get alice2 ##> ("", bobId, SENT 4)
       get bob2 =##> \case ("", c, Msg "hello 3") -> c == aliceId; _ -> False
   disposeAgentClient alice2
   disposeAgentClient bob2
@@ -1144,20 +1129,20 @@ testSkippedMessages t = do
   (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \_ -> do
     (aliceId, bobId) <- runRight $ makeConnection alice bob
     runRight_ $ do
-      4 <- sendMessage alice bobId SMP.noMsgFlags "hello"
-      get alice ##> ("", bobId, SENT 4)
+      2 <- sendMessage alice bobId SMP.noMsgFlags "hello"
+      get alice ##> ("", bobId, SENT 2)
       get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
-      ackMessage bob aliceId 4 Nothing
+      ackMessage bob aliceId 2 Nothing
 
     disposeAgentClient bob
 
     runRight_ $ do
-      5 <- sendMessage alice bobId SMP.noMsgFlags "hello 2"
+      3 <- sendMessage alice bobId SMP.noMsgFlags "hello 2"
+      get alice ##> ("", bobId, SENT 3)
+      4 <- sendMessage alice bobId SMP.noMsgFlags "hello 3"
+      get alice ##> ("", bobId, SENT 4)
+      5 <- sendMessage alice bobId SMP.noMsgFlags "hello 4"
       get alice ##> ("", bobId, SENT 5)
-      6 <- sendMessage alice bobId SMP.noMsgFlags "hello 3"
-      get alice ##> ("", bobId, SENT 6)
-      7 <- sendMessage alice bobId SMP.noMsgFlags "hello 4"
-      get alice ##> ("", bobId, SENT 7)
 
     pure (aliceId, bobId)
 
@@ -1174,15 +1159,15 @@ testSkippedMessages t = do
       subscribeConnection bob2 aliceId
       subscribeConnection alice2 bobId
 
-      8 <- sendMessage alice2 bobId SMP.noMsgFlags "hello 5"
-      get alice2 ##> ("", bobId, SENT 8)
-      get bob2 =##> \case ("", c, MSG MsgMeta {integrity = MsgError {errorInfo = MsgSkipped {fromMsgId = 4, toMsgId = 6}}} _ "hello 5") -> c == aliceId; _ -> False
-      ackMessage bob2 aliceId 5 Nothing
+      6 <- sendMessage alice2 bobId SMP.noMsgFlags "hello 5"
+      get alice2 ##> ("", bobId, SENT 6)
+      get bob2 =##> \case ("", c, MSG MsgMeta {integrity = MsgError {errorInfo = MsgSkipped {fromMsgId = 3, toMsgId = 5}}} _ "hello 5") -> c == aliceId; _ -> False
+      ackMessage bob2 aliceId 3 Nothing
 
-      9 <- sendMessage alice2 bobId SMP.noMsgFlags "hello 6"
-      get alice2 ##> ("", bobId, SENT 9)
+      7 <- sendMessage alice2 bobId SMP.noMsgFlags "hello 6"
+      get alice2 ##> ("", bobId, SENT 7)
       get bob2 =##> \case ("", c, Msg "hello 6") -> c == aliceId; _ -> False
-      ackMessage bob2 aliceId 6 Nothing
+      ackMessage bob2 aliceId 4 Nothing
   disposeAgentClient alice2
   disposeAgentClient bob2
 
@@ -1192,7 +1177,7 @@ testDeliveryAfterSubscriptionError t = do
     (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ makeConnection a b
     nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
     nGet b =##> \case ("", "", DOWN _ [c]) -> c == aId; _ -> False
-    4 <- runRight $ sendMessage a bId SMP.noMsgFlags "hello"
+    2 <- runRight $ sendMessage a bId SMP.noMsgFlags "hello"
     liftIO $ noMessages b "not delivered"
     pure (aId, bId)
 
@@ -1201,9 +1186,9 @@ testDeliveryAfterSubscriptionError t = do
     Left (BROKER _ NETWORK) <- runExceptT $ subscribeConnection b aId
     pure ()
     withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
-      withUP a bId $ \case ("", c, SENT 4) -> c == bId; _ -> False
+      withUP a bId $ \case ("", c, SENT 2) -> c == bId; _ -> False
       withUP b aId $ \case ("", c, Msg "hello") -> c == aId; _ -> False
-      ackMessage b aId 4 Nothing
+      ackMessage b aId 2 Nothing
 
 testMsgDeliveryQuotaExceeded :: HasCallStack => ATransport -> IO ()
 testMsgDeliveryQuotaExceeded t =
@@ -1213,24 +1198,24 @@ testMsgDeliveryQuotaExceeded t =
     forM_ ([1 .. 4] :: [Int]) $ \i -> do
       mId <- sendMessage a bId SMP.noMsgFlags $ "message " <> bshow i
       get a =##> \case ("", c, SENT mId') -> bId == c && mId == mId'; _ -> False
-    8 <- sendMessage a bId SMP.noMsgFlags "over quota"
-    pGet' a False =##> \case ("", c, AEvt _ (MWARN 8 (SMP _ QUOTA))) -> bId == c; _ -> False
-    4 <- sendMessage a bId' SMP.noMsgFlags "hello"
-    get a =##> \case ("", c, SENT 4) -> bId' == c; _ -> False
+    6 <- sendMessage a bId SMP.noMsgFlags "over quota"
+    pGet' a False =##> \case ("", c, AEvt _ (MWARN 6 (SMP _ QUOTA))) -> bId == c; _ -> False
+    2 <- sendMessage a bId' SMP.noMsgFlags "hello"
+    get a =##> \case ("", c, SENT 2) -> bId' == c; _ -> False
     get b =##> \case ("", c, Msg "message 1") -> aId == c; _ -> False
     get b =##> \case ("", c, Msg "hello") -> aId' == c; _ -> False
-    ackMessage b aId' 4 Nothing
-    ackMessage b aId 4 Nothing
+    ackMessage b aId' 2 Nothing
+    ackMessage b aId 2 Nothing
     get b =##> \case ("", c, Msg "message 2") -> aId == c; _ -> False
-    ackMessage b aId 5 Nothing
+    ackMessage b aId 3 Nothing
     get b =##> \case ("", c, Msg "message 3") -> aId == c; _ -> False
-    ackMessage b aId 6 Nothing
+    ackMessage b aId 4 Nothing
     get b =##> \case ("", c, Msg "message 4") -> aId == c; _ -> False
-    ackMessage b aId 7 Nothing
+    ackMessage b aId 5 Nothing
     get a =##> \case ("", c, QCONT) -> bId == c; _ -> False
     get b =##> \case ("", c, Msg "over quota") -> aId == c; _ -> False
-    ackMessage b aId 9 Nothing -- msg 8 was QCONT
-    get a =##> \case ("", c, SENT 8) -> bId == c; _ -> False
+    ackMessage b aId 7 Nothing -- msg 8 was QCONT
+    get a =##> \case ("", c, SENT 6) -> bId == c; _ -> False
     liftIO $ concurrently_ (noMessages a "no more events") (noMessages b "no more events")
 
 testExpireMessage :: HasCallStack => ATransport -> IO ()
@@ -1240,14 +1225,14 @@ testExpireMessage t =
       (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ makeConnection a b
       nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
       nGet b =##> \case ("", "", DOWN _ [c]) -> c == aId; _ -> False
-      4 <- runRight $ sendMessage a bId SMP.noMsgFlags "1"
+      2 <- runRight $ sendMessage a bId SMP.noMsgFlags "1"
       threadDelay 1000000
-      5 <- runRight $ sendMessage a bId SMP.noMsgFlags "2" -- this won't expire
-      get a =##> \case ("", c, MERR 4 (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
+      3 <- runRight $ sendMessage a bId SMP.noMsgFlags "2" -- this won't expire
+      get a =##> \case ("", c, MERR 2 (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
       withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
-        withUP a bId $ \case ("", _, SENT 5) -> True; _ -> False
-        withUP b aId $ \case ("", _, MsgErr 4 (MsgSkipped 3 3) "2") -> True; _ -> False
-        ackMessage b aId 4 Nothing
+        withUP a bId $ \case ("", _, SENT 3) -> True; _ -> False
+        withUP b aId $ \case ("", _, MsgErr 2 (MsgSkipped 2 2) "2") -> True; _ -> False
+        ackMessage b aId 2 Nothing
 
 testExpireManyMessages :: HasCallStack => ATransport -> IO ()
 testExpireManyMessages t =
@@ -1257,28 +1242,28 @@ testExpireManyMessages t =
       runRight_ $ do
         nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
         nGet b =##> \case ("", "", DOWN _ [c]) -> c == aId; _ -> False
-        4 <- sendMessage a bId SMP.noMsgFlags "1"
-        5 <- sendMessage a bId SMP.noMsgFlags "2"
-        6 <- sendMessage a bId SMP.noMsgFlags "3"
+        2 <- sendMessage a bId SMP.noMsgFlags "1"
+        3 <- sendMessage a bId SMP.noMsgFlags "2"
+        4 <- sendMessage a bId SMP.noMsgFlags "3"
         liftIO $ threadDelay 1000000
-        7 <- sendMessage a bId SMP.noMsgFlags "4" -- this won't expire
-        get a =##> \case ("", c, MERR 4 (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
+        5 <- sendMessage a bId SMP.noMsgFlags "4" -- this won't expire
+        get a =##> \case ("", c, MERR 2 (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
         -- get a =##> \case ("", c, MERRS [5, 6] (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
         let expected c e = bId == c && (e == TIMEOUT || e == NETWORK)
         get a >>= \case
-          ("", c, MERR 5 (BROKER _ e)) -> do
+          ("", c, MERR 3 (BROKER _ e)) -> do
             liftIO $ expected c e `shouldBe` True
-            get a =##> \case ("", c', MERR 6 (BROKER _ e')) -> expected c' e'; ("", c', MERRS [6] (BROKER _ e')) -> expected c' e'; _ -> False
-          ("", c, MERRS [5] (BROKER _ e)) -> do
+            get a =##> \case ("", c', MERR 4 (BROKER _ e')) -> expected c' e'; ("", c', MERRS [6] (BROKER _ e')) -> expected c' e'; _ -> False
+          ("", c, MERRS [3] (BROKER _ e)) -> do
             liftIO $ expected c e `shouldBe` True
-            get a =##> \case ("", c', MERR 6 (BROKER _ e')) -> expected c' e'; _ -> False
-          ("", c, MERRS [5, 6] (BROKER _ e)) ->
+            get a =##> \case ("", c', MERR 4 (BROKER _ e')) -> expected c' e'; _ -> False
+          ("", c, MERRS [3, 4] (BROKER _ e)) ->
             liftIO $ expected c e `shouldBe` True
           r -> error $ show r
       withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
-        withUP a bId $ \case ("", _, SENT 7) -> True; _ -> False
-        withUP b aId $ \case ("", _, MsgErr 4 (MsgSkipped 3 5) "4") -> True; _ -> False
-        ackMessage b aId 4 Nothing
+        withUP a bId $ \case ("", _, SENT 5) -> True; _ -> False
+        withUP b aId $ \case ("", _, MsgErr 2 (MsgSkipped 2 4) "4") -> True; _ -> False
+        ackMessage b aId 2 Nothing
 
 withUP :: AgentClient -> ConnId -> (AEntityTransmission 'AEConn -> Bool) -> ExceptT AgentErrorType IO ()
 withUP a bId p =
@@ -1296,23 +1281,23 @@ testExpireMessageQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1} testP
   (aId, bId) <- runRight $ do
     (aId, bId) <- makeConnection a b
     liftIO $ threadDelay 500000 >> disposeAgentClient b
-    4 <- sendMessage a bId SMP.noMsgFlags "1"
-    get a ##> ("", bId, SENT 4)
-    5 <- sendMessage a bId SMP.noMsgFlags "2"
+    2 <- sendMessage a bId SMP.noMsgFlags "1"
+    get a ##> ("", bId, SENT 2)
+    3 <- sendMessage a bId SMP.noMsgFlags "2"
     liftIO $ threadDelay 1000000
-    6 <- sendMessage a bId SMP.noMsgFlags "3" -- this won't expire
-    get a =##> \case ("", c, MERR 5 (SMP _ QUOTA)) -> bId == c; _ -> False
+    4 <- sendMessage a bId SMP.noMsgFlags "3" -- this won't expire
+    get a =##> \case ("", c, MERR 3 (SMP _ QUOTA)) -> bId == c; _ -> False
     pure (aId, bId)
   withAgent 3 agentCfg initAgentServers testDB2 $ \b' -> runRight_ $ do
     subscribeConnection b' aId
     get b' =##> \case ("", c, Msg "1") -> c == aId; _ -> False
-    ackMessage b' aId 4 Nothing
+    ackMessage b' aId 2 Nothing
     liftIO . getInAnyOrder a $
-      [ \case ("", c, AEvt SAEConn (SENT 6)) -> c == bId; _ -> False,
+      [ \case ("", c, AEvt SAEConn (SENT 4)) -> c == bId; _ -> False,
         \case ("", c, AEvt SAEConn QCONT) -> c == bId; _ -> False
       ]
-    get b' =##> \case ("", c, MsgErr 6 (MsgSkipped 4 4) "3") -> c == aId; _ -> False
-    ackMessage b' aId 6 Nothing
+    get b' =##> \case ("", c, MsgErr 4 (MsgSkipped 3 3) "3") -> c == aId; _ -> False
+    ackMessage b' aId 4 Nothing
   disposeAgentClient a
 
 testExpireManyMessagesQuota :: ATransport -> IO ()
@@ -1322,34 +1307,34 @@ testExpireManyMessagesQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1}
   (aId, bId) <- runRight $ do
     (aId, bId) <- makeConnection a b
     liftIO $ threadDelay 500000 >> disposeAgentClient b
-    4 <- sendMessage a bId SMP.noMsgFlags "1"
-    get a ##> ("", bId, SENT 4)
-    5 <- sendMessage a bId SMP.noMsgFlags "2"
-    6 <- sendMessage a bId SMP.noMsgFlags "3"
-    7 <- sendMessage a bId SMP.noMsgFlags "4"
+    2 <- sendMessage a bId SMP.noMsgFlags "1"
+    get a ##> ("", bId, SENT 2)
+    3 <- sendMessage a bId SMP.noMsgFlags "2"
+    4 <- sendMessage a bId SMP.noMsgFlags "3"
+    5 <- sendMessage a bId SMP.noMsgFlags "4"
     liftIO $ threadDelay 1000000
-    8 <- sendMessage a bId SMP.noMsgFlags "5" -- this won't expire
-    get a =##> \case ("", c, MERR 5 (SMP _ QUOTA)) -> bId == c; _ -> False
+    6 <- sendMessage a bId SMP.noMsgFlags "5" -- this won't expire
+    get a =##> \case ("", c, MERR 3 (SMP _ QUOTA)) -> bId == c; _ -> False
     get a >>= \case
-      ("", c, MERR 6 (SMP _ QUOTA)) -> do
+      ("", c, MERR 4 (SMP _ QUOTA)) -> do
         liftIO $ bId `shouldBe` c
-        get a =##> \case ("", c', MERR 7 (SMP _ QUOTA)) -> bId == c'; ("", c', MERRS [7] (SMP _ QUOTA)) -> bId == c'; _ -> False
-      ("", c, MERRS [6] (SMP _ QUOTA)) -> do
+        get a =##> \case ("", c', MERR 5 (SMP _ QUOTA)) -> bId == c'; ("", c', MERRS [5] (SMP _ QUOTA)) -> bId == c'; _ -> False
+      ("", c, MERRS [4] (SMP _ QUOTA)) -> do
         liftIO $ bId `shouldBe` c
-        get a =##> \case ("", c', MERR 7 (SMP _ QUOTA)) -> bId == c'; _ -> False
-      ("", c, MERRS [6, 7] (SMP _ QUOTA)) -> liftIO $ bId `shouldBe` c
+        get a =##> \case ("", c', MERR 5 (SMP _ QUOTA)) -> bId == c'; _ -> False
+      ("", c, MERRS [4, 5] (SMP _ QUOTA)) -> liftIO $ bId `shouldBe` c
       r -> error $ show r
     pure (aId, bId)
   withAgent 3 agentCfg initAgentServers testDB2 $ \b' -> runRight_ $ do
     subscribeConnection b' aId
     get b' =##> \case ("", c, Msg "1") -> c == aId; _ -> False
-    ackMessage b' aId 4 Nothing
+    ackMessage b' aId 2 Nothing
     liftIO . getInAnyOrder a $
-      [ \case ("", c, AEvt SAEConn (SENT 8)) -> c == bId; _ -> False,
+      [ \case ("", c, AEvt SAEConn (SENT 6)) -> c == bId; _ -> False,
         \case ("", c, AEvt SAEConn QCONT) -> c == bId; _ -> False
       ]
-    get b' =##> \case ("", c, MsgErr 6 (MsgSkipped 4 6) "5") -> c == aId; _ -> False
-    ackMessage b' aId 6 Nothing
+    get b' =##> \case ("", c, MsgErr 4 (MsgSkipped 3 5) "5") -> c == aId; _ -> False
+    ackMessage b' aId 4 Nothing
   disposeAgentClient a
 
 testRatchetSync :: HasCallStack => ATransport -> IO ()
@@ -1363,34 +1348,34 @@ testRatchetSync t = withAgentClients2 $ \alice bob ->
       get bob2 =##> ratchetSyncP aliceId RSAgreed
       get alice =##> ratchetSyncP bobId RSOk
       get bob2 =##> ratchetSyncP aliceId RSOk
-      exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9
+      exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
     disposeAgentClient bob2
 
 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)
+    2 <- sendMessage alice bobId SMP.noMsgFlags "hello"
+    get alice ##> ("", bobId, SENT 2)
     get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
-    ackMessage bob aliceId 4 Nothing
+    ackMessage bob aliceId 2 Nothing
 
-    5 <- sendMessage bob aliceId SMP.noMsgFlags "hello 2"
-    get bob ##> ("", aliceId, SENT 5)
+    3 <- sendMessage bob aliceId SMP.noMsgFlags "hello 2"
+    get bob ##> ("", aliceId, SENT 3)
     get alice =##> \case ("", c, Msg "hello 2") -> c == bobId; _ -> False
-    ackMessage alice bobId 5 Nothing
+    ackMessage alice bobId 3 Nothing
 
     liftIO $ copyFile testDB2 (testDB2 <> ".bak")
 
-    6 <- sendMessage alice bobId SMP.noMsgFlags "hello 3"
-    get alice ##> ("", bobId, SENT 6)
+    4 <- sendMessage alice bobId SMP.noMsgFlags "hello 3"
+    get alice ##> ("", bobId, SENT 4)
     get bob =##> \case ("", c, Msg "hello 3") -> c == aliceId; _ -> False
-    ackMessage bob aliceId 6 Nothing
+    ackMessage bob aliceId 4 Nothing
 
-    7 <- sendMessage bob aliceId SMP.noMsgFlags "hello 4"
-    get bob ##> ("", aliceId, SENT 7)
+    5 <- sendMessage bob aliceId SMP.noMsgFlags "hello 4"
+    get bob ##> ("", aliceId, SENT 5)
     get alice =##> \case ("", c, Msg "hello 4") -> c == bobId; _ -> False
-    ackMessage alice bobId 7 Nothing
+    ackMessage alice bobId 5 Nothing
 
   disposeAgentClient bob
 
@@ -1404,8 +1389,8 @@ setupDesynchronizedRatchet alice bob = do
 
     Left A.CMD {cmdErr = PROHIBITED} <- liftIO . runExceptT $ synchronizeRatchet bob2 aliceId PQSupportOn False
 
-    8 <- sendMessage alice bobId SMP.noMsgFlags "hello 5"
-    get alice ##> ("", bobId, SENT 8)
+    6 <- sendMessage alice bobId SMP.noMsgFlags "hello 5"
+    get alice ##> ("", bobId, SENT 6)
     get bob2 =##> ratchetSyncP aliceId RSRequired
 
     Left A.CMD {cmdErr = PROHIBITED} <- liftIO . runExceptT $ sendMessage bob2 aliceId SMP.noMsgFlags "hello 6"
@@ -1443,7 +1428,7 @@ testRatchetSyncServerOffline t = withAgentClients2 $ \alice bob -> do
     runRight_ $ do
       get alice =##> ratchetSyncP bobId RSOk
       get bob2 =##> ratchetSyncP aliceId RSOk
-      exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9
+      exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
   disposeAgentClient bob2
 
 serverUpP :: ATransmission -> Bool
@@ -1471,7 +1456,7 @@ testRatchetSyncClientRestart t = do
       get bob3 =##> ratchetSyncP aliceId RSAgreed
       get alice =##> ratchetSyncP bobId RSOk
       get bob3 =##> ratchetSyncP aliceId RSOk
-      exchangeGreetingsMsgIds alice bobId 12 bob3 aliceId 9
+      exchangeGreetingsMsgIds alice bobId 10 bob3 aliceId 7
   disposeAgentClient alice
   disposeAgentClient bob
   disposeAgentClient bob3
@@ -1500,7 +1485,7 @@ testRatchetSyncSuspendForeground t = do
     runRight_ $ do
       get alice =##> ratchetSyncP bobId RSOk
       get bob2 =##> ratchetSyncP aliceId RSOk
-      exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9
+      exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
   disposeAgentClient alice
   disposeAgentClient bob
   disposeAgentClient bob2
@@ -1528,13 +1513,13 @@ testRatchetSyncSimultaneous t = do
     runRight_ $ do
       get alice =##> ratchetSyncP bobId RSOk
       get bob2 =##> ratchetSyncP aliceId RSOk
-      exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9
+      exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
   disposeAgentClient alice
   disposeAgentClient bob
   disposeAgentClient bob2
 
-testOnlyCreatePull :: IO ()
-testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
+testOnlyCreatePullSlowHandshake :: IO ()
+testOnlyCreatePullSlowHandshake = withAgentClientsCfg2 agentProxyCfgV8 agentProxyCfgV8 $ \alice bob -> runRight_ $ do
   (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate
   aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
   Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
@@ -1558,14 +1543,38 @@ testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
   getMsg alice bobId $
     get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
   ackMessage alice bobId 5 Nothing
-  where
-    getMsg :: AgentClient -> ConnId -> ExceptT AgentErrorType IO a -> ExceptT AgentErrorType IO a
-    getMsg c cId action = do
-      liftIO $ noMessages c "nothing should be delivered before GET"
-      Just _ <- getConnectionMessage c cId
-      r <- action
-      get c =##> \case ("", cId', MSGNTF _) -> cId == cId'; _ -> False
-      pure r
+
+getMsg :: AgentClient -> ConnId -> ExceptT AgentErrorType IO a -> ExceptT AgentErrorType IO a
+getMsg c cId action = do
+  liftIO $ noMessages c "nothing should be delivered before GET"
+  Just _ <- getConnectionMessage c cId
+  r <- action
+  get c =##> \case ("", cId', MSGNTF _) -> cId == cId'; _ -> False
+  pure r
+
+testOnlyCreatePull :: IO ()
+testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
+  (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate
+  aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
+  Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
+  allowConnection alice bobId confId "alice's connInfo"
+  liftIO $ threadDelay 1_000000
+  getMsg bob aliceId $ do
+    get bob ##> ("", aliceId, INFO "alice's connInfo")
+    get bob ##> ("", aliceId, CON)
+  liftIO $ threadDelay 1_000000
+  get alice ##> ("", bobId, CON) -- sent to initiating party after sending confirmation
+  -- exchange messages
+  2 <- sendMessage alice bobId SMP.noMsgFlags "hello"
+  get alice ##> ("", bobId, SENT 2)
+  getMsg bob aliceId $
+    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+  ackMessage bob aliceId 2 Nothing
+  3 <- sendMessage bob aliceId SMP.noMsgFlags "hello too"
+  get bob ##> ("", aliceId, SENT 3)
+  getMsg alice bobId $
+    get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
+  ackMessage alice bobId 3 Nothing
 
 makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
 makeConnection = makeConnection_ PQSupportOn
@@ -1643,14 +1652,14 @@ testSuspendingAgent :: IO ()
 testSuspendingAgent =
   withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
-    4 <- sendMessage a bId SMP.noMsgFlags "hello"
-    get a ##> ("", bId, SENT 4)
+    2 <- sendMessage a bId SMP.noMsgFlags "hello"
+    get a ##> ("", bId, SENT 2)
     get b =##> \case ("", c, Msg "hello") -> c == aId; _ -> False
-    ackMessage b aId 4 Nothing
+    ackMessage b aId 2 Nothing
     liftIO $ suspendAgent b 1000000
     get' b ##> ("", "", SUSPENDED)
-    5 <- sendMessage a bId SMP.noMsgFlags "hello 2"
-    get a ##> ("", bId, SENT 5)
+    3 <- sendMessage a bId SMP.noMsgFlags "hello 2"
+    get a ##> ("", bId, SENT 3)
     Nothing <- 100000 `timeout` get b
     liftIO $ foregroundAgent b
     get b =##> \case ("", c, Msg "hello 2") -> c == aId; _ -> False
@@ -1659,47 +1668,47 @@ testSuspendingAgentCompleteSending :: ATransport -> IO ()
 testSuspendingAgentCompleteSending t = withAgentClients2 $ \a b -> do
   (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
     (aId, bId) <- makeConnection a b
-    4 <- sendMessage a bId SMP.noMsgFlags "hello"
-    get a ##> ("", bId, SENT 4)
+    2 <- sendMessage a bId SMP.noMsgFlags "hello"
+    get a ##> ("", bId, SENT 2)
     get b =##> \case ("", c, Msg "hello") -> c == aId; _ -> False
-    ackMessage b aId 4 Nothing
+    ackMessage b aId 2 Nothing
     pure (aId, bId)
 
   runRight_ $ do
     ("", "", DOWN {}) <- nGet a
     ("", "", DOWN {}) <- nGet b
-    5 <- sendMessage b aId SMP.noMsgFlags "hello too"
-    6 <- sendMessage b aId SMP.noMsgFlags "how are you?"
+    3 <- sendMessage b aId SMP.noMsgFlags "hello too"
+    4 <- sendMessage b aId SMP.noMsgFlags "how are you?"
     liftIO $ threadDelay 100000
     liftIO $ suspendAgent b 5000000
 
   withSmpServerStoreLogOn t testPort $ \_ -> runRight_ @AgentErrorType $ do
-    pGet b =##> \case ("", c, AEvt SAEConn (SENT 5)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
-    pGet b =##> \case ("", c, AEvt SAEConn (SENT 5)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
-    pGet b =##> \case ("", c, AEvt SAEConn (SENT 6)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
+    pGet b =##> \case ("", c, AEvt SAEConn (SENT 3)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
+    pGet b =##> \case ("", c, AEvt SAEConn (SENT 3)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
+    pGet b =##> \case ("", c, AEvt SAEConn (SENT 4)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
     ("", "", SUSPENDED) <- nGet b
 
     pGet a =##> \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; ("", "", AEvt _ UP {}) -> True; _ -> False
     pGet a =##> \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; ("", "", AEvt _ UP {}) -> True; _ -> False
-    ackMessage a bId 5 Nothing
+    ackMessage a bId 3 Nothing
     get a =##> \case ("", c, Msg "how are you?") -> c == bId; _ -> False
-    ackMessage a bId 6 Nothing
+    ackMessage a bId 4 Nothing
 
 testSuspendingAgentTimeout :: ATransport -> IO ()
 testSuspendingAgentTimeout t = withAgentClients2 $ \a b -> do
   (aId, _) <- withSmpServer t . runRight $ do
     (aId, bId) <- makeConnection a b
-    4 <- sendMessage a bId SMP.noMsgFlags "hello"
-    get a ##> ("", bId, SENT 4)
+    2 <- sendMessage a bId SMP.noMsgFlags "hello"
+    get a ##> ("", bId, SENT 2)
     get b =##> \case ("", c, Msg "hello") -> c == aId; _ -> False
-    ackMessage b aId 4 Nothing
+    ackMessage b aId 2 Nothing
     pure (aId, bId)
 
   runRight_ $ do
     ("", "", DOWN {}) <- nGet a
     ("", "", DOWN {}) <- nGet b
-    5 <- sendMessage b aId SMP.noMsgFlags "hello too"
-    6 <- sendMessage b aId SMP.noMsgFlags "how are you?"
+    3 <- sendMessage b aId SMP.noMsgFlags "hello too"
+    4 <- sendMessage b aId SMP.noMsgFlags "how are you?"
     liftIO $ suspendAgent b 100000
     ("", "", SUSPENDED) <- nGet b
     pure ()
@@ -1730,10 +1739,10 @@ testBatchedSubscriptions nCreate nDel t =
           (aIds', bIds') = unzip conns'
       subscribe a bIds
       subscribe b aIds
-      forM_ conns' $ \(aId, bId) -> exchangeGreetingsMsgId_ PQEncOff 6 a bId b aId
+      forM_ conns' $ \(aId, bId) -> exchangeGreetingsMsgId_ PQEncOff 4 a bId b aId
       void $ resubscribeConnections a bIds
       void $ resubscribeConnections b aIds
-      forM_ conns' $ \(aId, bId) -> exchangeGreetingsMsgId_ PQEncOff 8 a bId b aId
+      forM_ conns' $ \(aId, bId) -> exchangeGreetingsMsgId_ PQEncOff 6 a bId b aId
       delete a bIds'
       delete b aIds'
       deleteFail a bIds'
@@ -1786,9 +1795,9 @@ testBatchedPendingMessages nCreate nMsgs =
     withA = withAgent 1 agentCfg initAgentServers testDB
     withB = withAgent 2 agentCfg initAgentServers testDB2
 
-testAsyncCommands :: IO ()
-testAsyncCommands =
-  withAgentClients2 $ \alice bob -> runRight_ $ do
+testAsyncCommands :: AgentClient -> AgentClient -> AgentMsgId -> IO ()
+testAsyncCommands alice bob baseId =
+  runRight_ $ do
     bobId <- createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
     ("1", bobId', INV (ACR _ qInfo)) <- get alice
     liftIO $ bobId' `shouldBe` bobId
@@ -1833,7 +1842,6 @@ testAsyncCommands =
     get alice =##> \case ("", c, DEL_CONN) -> c == bobId; _ -> False
     liftIO $ noMessages alice "nothing else should be delivered to alice"
   where
-    baseId = 3
     msgId = subtract baseId
 
 testAsyncCommandsRestore :: ATransport -> IO ()
@@ -1848,9 +1856,9 @@ testAsyncCommandsRestore t = do
       get alice' =##> \case ("1", _, INV _) -> True; _ -> False
       pure ()
 
-testAcceptContactAsync :: IO ()
-testAcceptContactAsync =
-  withAgentClients2 $ \alice bob -> runRight_ $ do
+testAcceptContactAsync :: AgentClient -> AgentClient -> AgentMsgId -> IO ()
+testAcceptContactAsync alice bob baseId =
+  runRight_ $ do
     (_, qInfo) <- createConnection alice 1 True SCMContact Nothing SMSubscribe
     aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
     ("", _, REQ invId _ "bob's connInfo") <- get alice
@@ -1884,7 +1892,6 @@ testAcceptContactAsync =
     deleteConnection alice bobId
     liftIO $ noMessages alice "nothing else should be delivered to alice"
   where
-    baseId = 3
     msgId = subtract baseId
 
 testDeleteConnectionAsync :: ATransport -> IO ()
@@ -1931,7 +1938,7 @@ testWaitDeliveryNoPending t = withAgentClients2 $ \alice bob ->
     liftIO $ noMessages alice "nothing else should be delivered to alice"
     liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testWaitDelivery :: ATransport -> IO ()
@@ -1985,7 +1992,7 @@ testWaitDelivery t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testWaitDeliveryAUTHErr :: ATransport -> IO ()
@@ -2028,7 +2035,7 @@ testWaitDeliveryAUTHErr t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testWaitDeliveryTimeout :: ATransport -> IO ()
@@ -2068,7 +2075,7 @@ testWaitDeliveryTimeout t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testWaitDeliveryTimeout2 :: ATransport -> IO ()
@@ -2114,14 +2121,14 @@ testWaitDeliveryTimeout2 t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
-testJoinConnectionAsyncReplyError :: HasCallStack => ATransport -> IO ()
-testJoinConnectionAsyncReplyError t = do
+testJoinConnectionAsyncReplyErrorV8 :: HasCallStack => ATransport -> IO ()
+testJoinConnectionAsyncReplyErrorV8 t = do
   let initAgentServersSrv2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer2]}
-  withAgent 1 agentCfg initAgentServers testDB $ \a ->
-    withAgent 2 agentCfg initAgentServersSrv2 testDB2 $ \b -> do
+  withAgent 1 agentCfgVPrevPQ initAgentServers testDB $ \a ->
+    withAgent 2 agentCfgVPrevPQ initAgentServersSrv2 testDB2 $ \b -> do
       (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
         bId <- createConnectionAsync a 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
         ("1", bId', INV (ACR _ qInfo)) <- get a
@@ -2145,52 +2152,92 @@ testJoinConnectionAsyncReplyError t = do
         nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
         runRight_ $ do
           allowConnectionAsync a "3" bId confId "alice's connInfo"
+          get a ##> ("3", bId, OK)
           liftIO $ threadDelay 500000
           ConnectionStats {rcvQueuesInfo = [RcvQueueInfo {}], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
           pure ()
         withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
-          pGet a =##> \case ("3", c, AEvt _ OK) -> c == bId; ("", "", AEvt _ (UP _ [c])) -> c == bId; _ -> False
-          pGet a =##> \case ("3", c, AEvt _ OK) -> c == bId; ("", "", AEvt _ (UP _ [c])) -> c == bId; _ -> False
+          nGet a =##> \case ("", "", UP _ [c]) -> c == bId; _ -> False
           get a ##> ("", bId, CON)
           get b ##> ("", aId, INFO "alice's connInfo")
           get b ##> ("", aId, CON)
+          exchangeGreetingsMsgId 4 a bId b aId
+
+testJoinConnectionAsyncReplyError :: HasCallStack => ATransport -> IO ()
+testJoinConnectionAsyncReplyError t = do
+  let initAgentServersSrv2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer2]}
+  withAgent 1 agentCfg initAgentServers testDB $ \a ->
+    withAgent 2 agentCfg initAgentServersSrv2 testDB2 $ \b -> do
+      (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
+        bId <- createConnectionAsync a 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
+        ("1", bId', INV (ACR _ qInfo)) <- get a
+        liftIO $ bId' `shouldBe` bId
+        aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+        liftIO $ threadDelay 500000
+        ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
+        pure (aId, bId)
+      nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
+      withSmpServerOn t testPort2 $ do
+        confId <- withSmpServerStoreLogOn t testPort $ \_ -> do
+          -- both servers need to be online for connection to progress because of SKEY
+          get b =##> \case ("2", c, OK) -> c == aId; _ -> False
+          pGet a >>= \case
+            ("", "", AEvt _ (UP _ [_])) -> do
+              ("", _, CONF confId _ "bob's connInfo") <- get a
+              pure confId
+            ("", _, AEvt _ (CONF confId _ "bob's connInfo")) -> do
+              ("", "", UP _ [_]) <- nGet a
+              pure confId
+            r -> error $ "unexpected response " <> show r
+        nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
+        runRight_ $ do
+          allowConnectionAsync a "3" bId confId "alice's connInfo"
+          get a ##> ("3", bId, OK)
+          get a ##> ("", bId, CON)
+          liftIO $ threadDelay 500000
+          ConnectionStats {rcvQueuesInfo = [RcvQueueInfo {}], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
+          pure ()
+        withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
+          nGet a =##> \case ("", "", UP _ [c]) -> c == bId; _ -> False
+          get b ##> ("", aId, INFO "alice's connInfo")
+          get b ##> ("", aId, CON)
           exchangeGreetings a bId b aId
 
 testUsers :: IO ()
 testUsers =
   withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId b aId
+    exchangeGreetings a bId b aId
     auId <- createUser a [noAuthSrv testSMPServer] [noAuthSrv testXFTPServer]
     (aId', bId') <- makeConnectionForUsers a auId b 1
-    exchangeGreetingsMsgId 4 a bId' b aId'
+    exchangeGreetings a bId' b aId'
     deleteUser a auId True
     get a =##> \case ("", c, DEL_RCVQ _ _ Nothing) -> c == bId'; _ -> False
     get a =##> \case ("", c, DEL_CONN) -> c == bId'; _ -> False
     nGet a =##> \case ("", "", DEL_USER u) -> u == auId; _ -> False
-    exchangeGreetingsMsgId 6 a bId b aId
+    exchangeGreetingsMsgId 4 a bId b aId
     liftIO $ noMessages a "nothing else should be delivered to alice"
 
 testDeleteUserQuietly :: IO ()
 testDeleteUserQuietly =
   withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId b aId
+    exchangeGreetings a bId b aId
     auId <- createUser a [noAuthSrv testSMPServer] [noAuthSrv testXFTPServer]
     (aId', bId') <- makeConnectionForUsers a auId b 1
-    exchangeGreetingsMsgId 4 a bId' b aId'
+    exchangeGreetings a bId' b aId'
     deleteUser a auId False
-    exchangeGreetingsMsgId 6 a bId b aId
+    exchangeGreetingsMsgId 4 a bId b aId
     liftIO $ noMessages a "nothing else should be delivered to alice"
 
 testUsersNoServer :: HasCallStack => ATransport -> IO ()
 testUsersNoServer t = withAgentClientsCfg2 aCfg agentCfg $ \a b -> do
   (aId, bId, auId, _aId', bId') <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
     (aId, bId) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId b aId
+    exchangeGreetings a bId b aId
     auId <- createUser a [noAuthSrv testSMPServer] [noAuthSrv testXFTPServer]
     (aId', bId') <- makeConnectionForUsers a auId b 1
-    exchangeGreetingsMsgId 4 a bId' b aId'
+    exchangeGreetings a bId' b aId'
     pure (aId, bId, auId, aId', bId')
   nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId || c == bId'; _ -> False
   nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId || c == bId'; _ -> False
@@ -2204,7 +2251,7 @@ testUsersNoServer t = withAgentClientsCfg2 aCfg agentCfg $ \a b -> do
   withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
     nGet a =##> \case ("", "", UP _ [c]) -> c == bId; _ -> False
     nGet b =##> \case ("", "", UP _ cs) -> length cs == 2; _ -> False
-    exchangeGreetingsMsgId 6 a bId b aId
+    exchangeGreetingsMsgId 4 a bId b aId
   where
     aCfg = agentCfg {initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3}
 
@@ -2212,9 +2259,9 @@ testSwitchConnection :: InitialAgentServers -> IO ()
 testSwitchConnection servers =
   withAgentClientsCfgServers2 agentCfg agentCfg servers $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId b aId
-    testFullSwitch a bId b aId 10
-    testFullSwitch a bId b aId 16
+    exchangeGreetings a bId b aId
+    testFullSwitch a bId b aId 8
+    testFullSwitch a bId b aId 14
 
 testFullSwitch :: AgentClient -> ByteString -> AgentClient -> ByteString -> Int64 -> ExceptT AgentErrorType IO ()
 testFullSwitch a bId b aId msgId = do
@@ -2265,7 +2312,7 @@ testSwitchAsync :: HasCallStack => InitialAgentServers -> IO ()
 testSwitchAsync servers = do
   (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId, bId) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId b aId
+    exchangeGreetings a bId b aId
     pure (aId, bId)
   let withA' = sessionSubscribe withA [bId]
       withB' = sessionSubscribe withB [aId]
@@ -2286,8 +2333,8 @@ testSwitchAsync servers = do
   withA $ \a -> withB $ \b -> runRight_ $ do
     subscribeConnection a bId
     subscribeConnection b aId
-    exchangeGreetingsMsgId 10 a bId b aId
-    testFullSwitch a bId b aId 16
+    exchangeGreetingsMsgId 8 a bId b aId
+    testFullSwitch a bId b aId 14
   where
     withA :: (AgentClient -> IO a) -> IO a
     withA = withAgent 1 agentCfg servers testDB
@@ -2310,7 +2357,7 @@ testSwitchDelete :: InitialAgentServers -> IO ()
 testSwitchDelete servers =
   withAgentClientsCfgServers2 agentCfg agentCfg servers $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId b aId
+    exchangeGreetings a bId b aId
     liftIO $ disposeAgentClient b
     stats <- switchConnectionAsync a "" bId
     liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
@@ -2325,7 +2372,7 @@ testAbortSwitchStarted :: HasCallStack => InitialAgentServers -> IO ()
 testAbortSwitchStarted servers = do
   (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId, bId) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId b aId
+    exchangeGreetings a bId b aId
     pure (aId, bId)
   let withA' = sessionSubscribe withA [bId]
       withB' = sessionSubscribe withB [aId]
@@ -2362,9 +2409,9 @@ testAbortSwitchStarted servers = do
 
     phaseRcv a bId SPCompleted [Nothing]
 
-    exchangeGreetingsMsgId 12 a bId b aId
+    exchangeGreetingsMsgId 10 a bId b aId
 
-    testFullSwitch a bId b aId 18
+    testFullSwitch a bId b aId 16
   where
     withA :: (AgentClient -> IO a) -> IO a
     withA = withAgent 1 agentCfg servers testDB
@@ -2375,7 +2422,7 @@ testAbortSwitchStartedReinitiate :: HasCallStack => InitialAgentServers -> IO ()
 testAbortSwitchStartedReinitiate servers = do
   (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId, bId) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId b aId
+    exchangeGreetings a bId b aId
     pure (aId, bId)
   let withA' = sessionSubscribe withA [bId]
       withB' = sessionSubscribe withB [aId]
@@ -2413,9 +2460,9 @@ testAbortSwitchStartedReinitiate servers = do
 
     phaseRcv a bId SPCompleted [Nothing]
 
-    exchangeGreetingsMsgId 12 a bId b aId
+    exchangeGreetingsMsgId 10 a bId b aId
 
-    testFullSwitch a bId b aId 18
+    testFullSwitch a bId b aId 16
   where
     withA :: (AgentClient -> IO a) -> IO a
     withA = withAgent 1 agentCfg servers testDB
@@ -2442,7 +2489,7 @@ testCannotAbortSwitchSecured :: HasCallStack => InitialAgentServers -> IO ()
 testCannotAbortSwitchSecured servers = do
   (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId, bId) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId b aId
+    exchangeGreetings a bId b aId
     pure (aId, bId)
   let withA' = sessionSubscribe withA [bId]
       withB' = sessionSubscribe withB [aId]
@@ -2467,9 +2514,9 @@ testCannotAbortSwitchSecured servers = do
 
     phaseRcv a bId SPCompleted [Nothing]
 
-    exchangeGreetingsMsgId 10 a bId b aId
+    exchangeGreetingsMsgId 8 a bId b aId
 
-    testFullSwitch a bId b aId 16
+    testFullSwitch a bId b aId 14
   where
     withA :: (AgentClient -> IO a) -> IO a
     withA = withAgent 1 agentCfg servers testDB
@@ -2480,9 +2527,9 @@ testSwitch2Connections :: HasCallStack => InitialAgentServers -> IO ()
 testSwitch2Connections servers = do
   (aId1, bId1, aId2, bId2) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId1, bId1) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId1 b aId1
+    exchangeGreetings a bId1 b aId1
     (aId2, bId2) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId2 b aId2
+    exchangeGreetings a bId2 b aId2
     pure (aId1, bId1, aId2, bId2)
   let withA' = sessionSubscribe withA [bId1, bId2]
       withB' = sessionSubscribe withB [aId1, aId2]
@@ -2523,11 +2570,11 @@ testSwitch2Connections servers = do
     void $ subscribeConnections a [bId1, bId2]
     void $ subscribeConnections b [aId1, aId2]
 
-    exchangeGreetingsMsgId 10 a bId1 b aId1
-    exchangeGreetingsMsgId 10 a bId2 b aId2
+    exchangeGreetingsMsgId 8 a bId1 b aId1
+    exchangeGreetingsMsgId 8 a bId2 b aId2
 
-    testFullSwitch a bId1 b aId1 16
-    testFullSwitch a bId2 b aId2 16
+    testFullSwitch a bId1 b aId1 14
+    testFullSwitch a bId2 b aId2 14
   where
     withA :: (AgentClient -> IO a) -> IO a
     withA = withAgent 1 agentCfg servers testDB
@@ -2538,9 +2585,9 @@ testSwitch2ConnectionsAbort1 :: HasCallStack => InitialAgentServers -> IO ()
 testSwitch2ConnectionsAbort1 servers = do
   (aId1, bId1, aId2, bId2) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId1, bId1) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId1 b aId1
+    exchangeGreetings a bId1 b aId1
     (aId2, bId2) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId2 b aId2
+    exchangeGreetings a bId2 b aId2
     pure (aId1, bId1, aId2, bId2)
   let withA' = sessionSubscribe withA [bId1, bId2]
       withB' = sessionSubscribe withB [aId1, aId2]
@@ -2576,19 +2623,19 @@ testSwitch2ConnectionsAbort1 servers = do
 
     phaseRcv a bId1 SPCompleted [Nothing]
 
-    exchangeGreetingsMsgId 10 a bId1 b aId1
-    exchangeGreetingsMsgId 8 a bId2 b aId2
+    exchangeGreetingsMsgId 8 a bId1 b aId1
+    exchangeGreetingsMsgId 6 a bId2 b aId2
 
-    testFullSwitch a bId1 b aId1 16
-    testFullSwitch a bId2 b aId2 14
+    testFullSwitch a bId1 b aId1 14
+    testFullSwitch a bId2 b aId2 12
   where
     withA :: (AgentClient -> IO a) -> IO a
     withA = withAgent 1 agentCfg servers testDB
     withB :: (AgentClient -> IO a) -> IO a
     withB = withAgent 2 agentCfg servers testDB2
 
-testCreateQueueAuth :: HasCallStack => VersionSMP -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> IO Int
-testCreateQueueAuth srvVersion clnt1 clnt2 = do
+testCreateQueueAuth :: HasCallStack => VersionSMP -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> AgentMsgId -> IO Int
+testCreateQueueAuth srvVersion clnt1 clnt2 baseId = do
   a <- getClient 1 clnt1 testDB
   b <- getClient 2 clnt2 testDB2
   r <- runRight $ do
@@ -2605,7 +2652,7 @@ testCreateQueueAuth srvVersion clnt1 clnt2 = do
             get a ##> ("", bId, CON)
             get b ##> ("", aId, INFO "alice's connInfo")
             get b ##> ("", aId, CON)
-            exchangeGreetings a bId b aId
+            exchangeGreetingsMsgId (baseId + 1) a bId b aId
             pure 2
   disposeAgentClient a
   disposeAgentClient b
@@ -2638,20 +2685,20 @@ testDeliveryReceipts =
   withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
     -- a sends, b receives and sends delivery receipt
-    4 <- sendMessage a bId SMP.noMsgFlags "hello"
-    get a ##> ("", bId, SENT 4)
+    2 <- sendMessage a bId SMP.noMsgFlags "hello"
+    get a ##> ("", bId, SENT 2)
     get b =##> \case ("", c, Msg "hello") -> c == aId; _ -> False
-    ackMessage b aId 4 $ Just ""
-    get a =##> \case ("", c, Rcvd 4) -> c == bId; _ -> False
-    ackMessage a bId 5 Nothing
+    ackMessage b aId 2 $ Just ""
+    get a =##> \case ("", c, Rcvd 2) -> c == bId; _ -> False
+    ackMessage a bId 3 Nothing
     -- b sends, a receives and sends delivery receipt
-    6 <- sendMessage b aId SMP.noMsgFlags "hello too"
-    get b ##> ("", aId, SENT 6)
+    4 <- sendMessage b aId SMP.noMsgFlags "hello too"
+    get b ##> ("", aId, SENT 4)
     get a =##> \case ("", c, Msg "hello too") -> c == bId; _ -> False
-    ackMessage a bId 6 $ Just ""
-    get b =##> \case ("", c, Rcvd 6) -> c == aId; _ -> False
-    ackMessage b aId 7 (Just "") `catchError` \case (A.CMD PROHIBITED _) -> pure (); e -> liftIO $ expectationFailure ("unexpected error " <> show e)
-    ackMessage b aId 7 Nothing
+    ackMessage a bId 4 $ Just ""
+    get b =##> \case ("", c, Rcvd 4) -> c == aId; _ -> False
+    ackMessage b aId 5 (Just "") `catchError` \case (A.CMD PROHIBITED _) -> pure (); e -> liftIO $ expectationFailure ("unexpected error " <> show e)
+    ackMessage b aId 5 Nothing
 
 testDeliveryReceiptsVersion :: HasCallStack => ATransport -> IO ()
 testDeliveryReceiptsVersion t = do
@@ -2662,15 +2709,15 @@ testDeliveryReceiptsVersion t = do
       (aId, bId) <- makeConnection_ PQSupportOff a b
       checkVersion a bId 3
       checkVersion b aId 3
-      (4, _) <- A.sendMessage a bId PQEncOff SMP.noMsgFlags "hello"
-      get a ##> ("", bId, SENT 4)
-      get b =##> \case ("", c, Msg' 4 PQEncOff "hello") -> c == aId; _ -> False
-      ackMessage b aId 4 $ Just ""
+      (2, _) <- A.sendMessage a bId PQEncOff SMP.noMsgFlags "hello"
+      get a ##> ("", bId, SENT 2)
+      get b =##> \case ("", c, Msg' 2 PQEncOff "hello") -> c == aId; _ -> False
+      ackMessage b aId 2 $ Just ""
       liftIO $ noMessages a "no delivery receipt (unsupported version)"
-      (5, _) <- A.sendMessage b aId PQEncOff SMP.noMsgFlags "hello too"
-      get b ##> ("", aId, SENT 5)
-      get a =##> \case ("", c, Msg' 5 PQEncOff "hello too") -> c == bId; _ -> False
-      ackMessage a bId 5 $ Just ""
+      (3, _) <- A.sendMessage b aId PQEncOff SMP.noMsgFlags "hello too"
+      get b ##> ("", aId, SENT 3)
+      get a =##> \case ("", c, Msg' 3 PQEncOff "hello too") -> c == bId; _ -> False
+      ackMessage a bId 3 $ Just ""
       liftIO $ noMessages b "no delivery receipt (unsupported version)"
       pure (aId, bId)
 
@@ -2682,27 +2729,27 @@ testDeliveryReceiptsVersion t = do
     runRight_ $ do
       subscribeConnection a' bId
       subscribeConnection b' aId
-      exchangeGreetingsMsgId_ PQEncOff 6 a' bId b' aId
-      checkVersion a' bId 5
-      checkVersion b' aId 5
-      (8, PQEncOff) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello"
-      get a' ##> ("", bId, SENT 8)
-      get b' =##> \case ("", c, Msg' 8 PQEncOff "hello") -> c == aId; _ -> False
-      ackMessage b' aId 8 $ Just ""
-      get a' =##> \case ("", c, Rcvd 8) -> c == bId; _ -> False
-      ackMessage a' bId 9 Nothing
-      (10, PQEncOff) <- A.sendMessage b' aId PQEncOn SMP.noMsgFlags "hello too"
-      get b' ##> ("", aId, SENT 10)
-      get a' =##> \case ("", c, Msg' 10 PQEncOff "hello too") -> c == bId; _ -> False
-      ackMessage a' bId 10 $ Just ""
-      get b' =##> \case ("", c, Rcvd 10) -> c == aId; _ -> False
-      ackMessage b' aId 11 Nothing
-      (12, _) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello 2"
-      get a' ##> ("", bId, SENT 12)
-      get b' =##> \case ("", c, Msg' 12 PQEncOff "hello 2") -> c == aId; _ -> False
-      ackMessage b' aId 12 $ Just ""
-      get a' =##> \case ("", c, Rcvd 12) -> c == bId; _ -> False
-      ackMessage a' bId 13 Nothing
+      exchangeGreetingsMsgId_ PQEncOff 4 a' bId b' aId
+      checkVersion a' bId 6
+      checkVersion b' aId 6
+      (6, PQEncOff) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello"
+      get a' ##> ("", bId, SENT 6)
+      get b' =##> \case ("", c, Msg' 6 PQEncOff "hello") -> c == aId; _ -> False
+      ackMessage b' aId 6 $ Just ""
+      get a' =##> \case ("", c, Rcvd 6) -> c == bId; _ -> False
+      ackMessage a' bId 7 Nothing
+      (8, PQEncOff) <- A.sendMessage b' aId PQEncOn SMP.noMsgFlags "hello too"
+      get b' ##> ("", aId, SENT 8)
+      get a' =##> \case ("", c, Msg' 8 PQEncOff "hello too") -> c == bId; _ -> False
+      ackMessage a' bId 8 $ Just ""
+      get b' =##> \case ("", c, Rcvd 8) -> c == aId; _ -> False
+      ackMessage b' aId 9 Nothing
+      (10, _) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello 2"
+      get a' ##> ("", bId, SENT 10)
+      get b' =##> \case ("", c, Msg' 10 PQEncOff "hello 2") -> c == aId; _ -> False
+      ackMessage b' aId 10 $ Just ""
+      get a' =##> \case ("", c, Rcvd 10) -> c == bId; _ -> False
+      ackMessage a' bId 11 Nothing
     disposeAgentClient a'
     disposeAgentClient b'
 
@@ -2773,8 +2820,8 @@ testTwoUsers = withAgentClients2 $ \a b -> do
     ("", "", UP _ _) <- nGet a
     a `hasClients` 2
 
-    exchangeGreetingsMsgId 6 a bId1 b aId1
-    exchangeGreetingsMsgId 6 a bId1' b aId1'
+    exchangeGreetingsMsgId 4 a bId1 b aId1
+    exchangeGreetingsMsgId 4 a bId1' b aId1'
     liftIO $ threadDelay 250000
     liftIO $ setNetworkConfig a nc {sessionMode = TSMUser}
     liftIO $ threadDelay 250000
@@ -2798,10 +2845,10 @@ testTwoUsers = withAgentClients2 $ \a b -> do
     ("", "", UP _ _) <- nGet a
     ("", "", UP _ _) <- nGet a
     a `hasClients` 4
-    exchangeGreetingsMsgId 8 a bId1 b aId1
-    exchangeGreetingsMsgId 8 a bId1' b aId1'
-    exchangeGreetingsMsgId 6 a bId2 b aId2
-    exchangeGreetingsMsgId 6 a bId2' b aId2'
+    exchangeGreetingsMsgId 6 a bId1 b aId1
+    exchangeGreetingsMsgId 6 a bId1' b aId1'
+    exchangeGreetingsMsgId 4 a bId2 b aId2
+    exchangeGreetingsMsgId 4 a bId2' b aId2'
     liftIO $ threadDelay 250000
     liftIO $ setNetworkConfig a nc {sessionMode = TSMUser}
     liftIO $ threadDelay 250000
@@ -2814,10 +2861,10 @@ testTwoUsers = withAgentClients2 $ \a b -> do
     ("", "", UP _ _) <- nGet a
     ("", "", UP _ _) <- nGet a
     a `hasClients` 2
-    exchangeGreetingsMsgId 10 a bId1 b aId1
-    exchangeGreetingsMsgId 10 a bId1' b aId1'
-    exchangeGreetingsMsgId 8 a bId2 b aId2
-    exchangeGreetingsMsgId 8 a bId2' b aId2'
+    exchangeGreetingsMsgId 8 a bId1 b aId1
+    exchangeGreetingsMsgId 8 a bId1' b aId1'
+    exchangeGreetingsMsgId 6 a bId2 b aId2
+    exchangeGreetingsMsgId 6 a bId2' b aId2'
   where
     hasClients :: HasCallStack => AgentClient -> Int -> ExceptT AgentErrorType IO ()
     hasClients c n = liftIO $ M.size <$> readTVarIO (smpClients c) `shouldReturn` n
@@ -2846,7 +2893,7 @@ testServerMultipleIdentities =
       disposeAgentClient bob
       getSMPAgentClient' 3 agentCfg initAgentServers testDB2
     subscribeConnection bob' aliceId
-    exchangeGreetingsMsgId 6 alice bobId bob' aliceId
+    exchangeGreetingsMsgId 4 alice bobId bob' aliceId
     liftIO $ disposeAgentClient bob'
   where
     secondIdentityCReq :: ConnectionRequestUri 'CMInvitation
@@ -2934,7 +2981,7 @@ testServerQueueInfo = do
     aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     liftIO $ threadDelay 200000
-    checkEmptyQ alice bobId False
+    checkEmptyQ alice bobId True -- secured by sender
     allowConnection alice bobId confId "alice's connInfo"
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, INFO "alice's connInfo")
@@ -2942,7 +2989,7 @@ testServerQueueInfo = do
     liftIO $ threadDelay 200000
     checkEmptyQ alice bobId True
     checkEmptyQ bob aliceId True
-    let msgId = 4
+    let msgId = 2
     (msgId', PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello"
     liftIO $ msgId' `shouldBe` msgId
     get alice ##> ("", bobId, SENT msgId)
@@ -3031,7 +3078,7 @@ exchangeGreetings :: HasCallStack => AgentClient -> ConnId -> AgentClient -> Con
 exchangeGreetings = exchangeGreetings_ PQEncOn
 
 exchangeGreetings_ :: HasCallStack => PQEncryption -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
-exchangeGreetings_ pqEnc = exchangeGreetingsMsgId_ pqEnc 4
+exchangeGreetings_ pqEnc = exchangeGreetingsMsgId_ pqEnc 2
 
 exchangeGreetingsMsgId :: HasCallStack => Int64 -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 exchangeGreetingsMsgId = exchangeGreetingsMsgId_ PQEncOn
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 01eab9555..ab9d8453c 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -12,9 +12,9 @@ module AgentTests.NotificationTests where
 
 -- import Control.Logger.Simple (LogConfig (..), LogLevel (..), setLogLevel, withGlobalLogging)
 import AgentTests.FunctionalAPITests
-  ( agentCfgV7,
+  ( agentCfgVPrevPQ,
     createConnection,
-    exchangeGreetingsMsgId,
+    exchangeGreetings,
     get,
     joinConnection,
     makeConnection,
@@ -51,7 +51,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.Text.Encoding (encodeUtf8)
 import NtfClient
 import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testNtfServer, testNtfServer2)
-import SMPClient (cfg, cfgV7, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn)
+import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore')
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, Env (..), InitialAgentServers)
@@ -70,7 +70,6 @@ import Simplex.Messaging.Transport (ATransport)
 import System.Directory (doesFileExist, removeFile)
 import Test.Hspec
 import UnliftIO
-import Util
 
 removeFileIfExists :: FilePath -> IO ()
 removeFileIfExists filePath = do
@@ -144,28 +143,26 @@ notificationTests t = do
         withNtfServerOn t ntfTestPort2 . withNtfServerThreadOn t ntfTestPort $ \ntf ->
           testNotificationsNewToken apns ntf
 
-testNtfMatrix :: ATransport -> (APNSMockServer -> AgentClient -> AgentClient -> IO ()) -> Spec
+testNtfMatrix :: HasCallStack => ATransport -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> Spec
 testNtfMatrix t runTest = do
   describe "next and current" $ do
-    it "next servers: SMP v7, NTF v2; next clients: v7/v2" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfgV7 agentCfgV7 runTest
-    it "next servers: SMP v7, NTF v2; curr clients: v6/v1" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfg agentCfg runTest
-    it "curr servers: SMP v6, NTF v1; curr clients: v6/v1" $ runNtfTestCfg t cfg ntfServerCfg agentCfg agentCfg runTest
-    skip "this case cannot be supported - see RFC" $
-      it "servers: SMP v6, NTF v1; clients: v7/v2 (not supported)" $
-        runNtfTestCfg t cfg ntfServerCfg agentCfgV7 agentCfgV7 runTest
-    -- servers can be migrated in any order
-    it "servers: next SMP v7, curr NTF v1; curr clients: v6/v1" $ runNtfTestCfg t cfgV7 ntfServerCfg agentCfg agentCfg runTest
-    it "servers: curr SMP v6, next NTF v2; curr clients: v6/v1" $ runNtfTestCfg t cfg ntfServerCfgV2 agentCfg agentCfg runTest
-    -- clients can be partially migrated
-    it "servers: next SMP v7, curr NTF v2; clients: next/curr" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfgV7 agentCfg runTest
-    it "servers: next SMP v7, curr NTF v2; clients: curr/new" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfg agentCfgV7 runTest
+    it "curr servers; curr clients" $ runNtfTestCfg t 1 cfg ntfServerCfg agentCfg agentCfg runTest
+    it "curr servers; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
+    it "prev servers; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
+    it "prev servers; curr clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest
+    -- servers can be upgraded in any order
+    it "servers: curr SMP, prev NTF; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
+    it "servers: prev SMP, curr NTF; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
+    -- one of two clients can be upgraded
+    it "servers: curr SMP, curr NTF; clients: curr/prev" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfg agentCfgVPrevPQ runTest
+    it "servers: curr SMP, curr NTF; clients: prev/curr" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfgVPrevPQ agentCfg runTest
 
-runNtfTestCfg :: ATransport -> ServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentClient -> AgentClient -> IO ()) -> IO ()
-runNtfTestCfg t smpCfg ntfCfg aCfg bCfg runTest = do
+runNtfTestCfg :: HasCallStack => ATransport -> AgentMsgId -> ServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> IO ()
+runNtfTestCfg t baseId smpCfg ntfCfg aCfg bCfg runTest = do
   withSmpServerConfigOn t smpCfg testPort $ \_ ->
     withAPNSMockServer $ \apns ->
       withNtfServerCfg ntfCfg {transports = [(ntfTestPort, t)]} $ \_ ->
-        withAgentClientsCfg2 aCfg bCfg $ runTest apns
+        withAgentClientsCfg2 aCfg bCfg $ runTest apns baseId
   threadDelay 100000
 
 testNotificationToken :: APNSMockServer -> IO ()
@@ -345,8 +342,8 @@ testRunNTFServerTests t srv =
     withAgent 1 agentCfg initAgentServers testDB $ \a ->
       testProtocolServer a 1 $ ProtoServerWithAuth srv Nothing
 
-testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentClient -> AgentClient -> IO ()
-testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
+testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
+testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
   (bobId, aliceId, nonce, message) <- runRight $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -404,11 +401,10 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} alice@Agen
     -- no notifications should follow
     noNotification apnsQ
   where
-    baseId = 3
     msgId = subtract baseId
 
-testNotificationSubscriptionNewConnection :: APNSMockServer -> AgentClient -> AgentClient -> IO ()
-testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} alice bob =
+testNotificationSubscriptionNewConnection :: HasCallStack => APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
+testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} baseId alice bob =
   runRight_ $ do
     -- alice registers notification token
     DeviceToken {} <- registerTestToken alice "abcd" NMInstant apnsQ
@@ -426,9 +422,9 @@ testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} alice bob =
     allowConnection alice bobId confId "alice's connInfo"
     void $ messageNotificationData bob apnsQ
     get bob ##> ("", aliceId, INFO "alice's connInfo")
-    void $ messageNotificationData alice apnsQ
+    when (baseId == 3) $ void $ messageNotificationData alice apnsQ
     get alice ##> ("", bobId, CON)
-    void $ messageNotificationData bob apnsQ
+    when (baseId == 3) $ void $ messageNotificationData bob apnsQ
     get bob ##> ("", aliceId, CON)
     -- bob sends message
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
@@ -445,7 +441,6 @@ testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} alice bob =
     -- no unexpected notifications should follow
     noNotification apnsQ
   where
-    baseId = 3
     msgId = subtract baseId
 
 registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO DeviceToken
@@ -520,7 +515,7 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
     -- no notifications should follow
     noNotification apnsQ
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testChangeToken :: APNSMockServer -> IO ()
@@ -559,7 +554,7 @@ testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers t
     -- no notifications should follow
     noNotification apnsQ
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testNotificationsStoreLog :: ATransport -> APNSMockServer -> IO ()
@@ -568,11 +563,11 @@ testNotificationsStoreLog t APNSMockServer {apnsQ} = withAgentClients2 $ \alice
     (aliceId, bobId) <- makeConnection alice bob
     _ <- registerTestToken alice "abcd" NMInstant apnsQ
     liftIO $ threadDelay 250000
-    4 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
-    get bob ##> ("", aliceId, SENT 4)
+    2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
+    get bob ##> ("", aliceId, SENT 2)
     void $ messageNotificationData alice apnsQ
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
-    ackMessage alice bobId 4 Nothing
+    ackMessage alice bobId 2 Nothing
     liftIO $ killThread threadId
     pure (aliceId, bobId)
 
@@ -580,8 +575,8 @@ testNotificationsStoreLog t APNSMockServer {apnsQ} = withAgentClients2 $ \alice
 
   withNtfServerStoreLog t $ \threadId -> runRight_ $ do
     liftIO $ threadDelay 250000
-    5 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
-    get bob ##> ("", aliceId, SENT 5)
+    3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
+    get bob ##> ("", aliceId, SENT 3)
     void $ messageNotificationData alice apnsQ
     get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
     liftIO $ killThread threadId
@@ -592,11 +587,11 @@ testNotificationsSMPRestart t APNSMockServer {apnsQ} = withAgentClients2 $ \alic
     (aliceId, bobId) <- makeConnection alice bob
     _ <- registerTestToken alice "abcd" NMInstant apnsQ
     liftIO $ threadDelay 250000
-    4 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
-    get bob ##> ("", aliceId, SENT 4)
+    2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
+    get bob ##> ("", aliceId, SENT 2)
     void $ messageNotificationData alice apnsQ
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
-    ackMessage alice bobId 4 Nothing
+    ackMessage alice bobId 2 Nothing
     liftIO $ killThread threadId
     pure (aliceId, bobId)
 
@@ -608,8 +603,8 @@ testNotificationsSMPRestart t APNSMockServer {apnsQ} = withAgentClients2 $ \alic
     nGet alice =##> \case ("", "", UP _ [c]) -> c == bobId; _ -> False
     nGet bob =##> \case ("", "", UP _ [c]) -> c == aliceId; _ -> False
     liftIO $ threadDelay 1000000
-    5 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
-    get bob ##> ("", aliceId, SENT 5)
+    3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
+    get bob ##> ("", aliceId, SENT 3)
     _ <- messageNotificationData alice apnsQ
     get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
     liftIO $ killThread threadId
@@ -664,7 +659,7 @@ testSwitchNotifications :: InitialAgentServers -> APNSMockServer -> IO ()
 testSwitchNotifications servers APNSMockServer {apnsQ} =
   withAgentClientsCfgServers2 agentCfg agentCfg servers $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
-    exchangeGreetingsMsgId 4 a bId b aId
+    exchangeGreetings a bId b aId
     _ <- registerTestToken a "abcd" NMInstant apnsQ
     liftIO $ threadDelay 250000
     let testMessage msg = do
@@ -739,7 +734,7 @@ messageNotification apnsQ = do
       pure (nonce, message)
     _ -> error "bad notification"
 
-messageNotificationData :: AgentClient -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO PNMessageData
+messageNotificationData :: HasCallStack => AgentClient -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO PNMessageData
 messageNotificationData c apnsQ = do
   (nonce, message) <- messageNotification apnsQ
   NtfToken {ntfDhSecret = Just dhSecret} <- getNtfTokenData c
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index 039e26090..39a4b1b95 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -197,6 +197,9 @@ cData1 =
 testPrivateAuthKey :: C.APrivateAuthKey
 testPrivateAuthKey = C.APrivateAuthKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe"
 
+testPublicAuthKey :: C.APublicAuthKey
+testPublicAuthKey = C.APublicAuthKey C.SEd25519 (C.publicKey "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe")
+
 testPrivDhKey :: C.PrivateKeyX25519
 testPrivDhKey = "MC4CAQAwBQYDK2VuBCIEINCzbVFaCiYHoYncxNY8tSIfn0pXcIAhLBfFc0m+gOpk"
 
@@ -218,6 +221,7 @@ rcvQueue1 =
       e2ePrivKey = testPrivDhKey,
       e2eDhSecret = Nothing,
       sndId = "2345",
+      sndSecure = True,
       status = New,
       dbQueueId = DBNewQueue,
       primary = True,
@@ -235,7 +239,8 @@ sndQueue1 =
       connId = "conn1",
       server = smpServer1,
       sndId = "3456",
-      sndPublicKey = Nothing,
+      sndSecure = True,
+      sndPublicKey = testPublicAuthKey,
       sndPrivateKey = testPrivateAuthKey,
       e2ePubKey = Nothing,
       e2eDhSecret = testDhSecret,
@@ -379,7 +384,8 @@ testUpgradeRcvConnToDuplex =
               connId = "conn1",
               server = SMPServer "smp.simplex.im" "5223" testKeyHash,
               sndId = "2345",
-              sndPublicKey = Nothing,
+              sndSecure = True,
+              sndPublicKey = testPublicAuthKey,
               sndPrivateKey = testPrivateAuthKey,
               e2ePubKey = Nothing,
               e2eDhSecret = testDhSecret,
@@ -412,6 +418,7 @@ testUpgradeSndConnToDuplex =
               e2ePrivKey = testPrivDhKey,
               e2eDhSecret = Nothing,
               sndId = "4567",
+              sndSecure = True,
               status = New,
               dbQueueId = DBNewQueue,
               rcvSwchStatus = Nothing,
diff --git a/tests/CoreTests/TRcvQueuesTests.hs b/tests/CoreTests/TRcvQueuesTests.hs
index 2b0009344..9f7c4932e 100644
--- a/tests/CoreTests/TRcvQueuesTests.hs
+++ b/tests/CoreTests/TRcvQueuesTests.hs
@@ -183,6 +183,7 @@ dummyRQ userId server connId =
       e2ePrivKey = "MC4CAQAwBQYDK2VuBCIEINCzbVFaCiYHoYncxNY8tSIfn0pXcIAhLBfFc0m+gOpk",
       e2eDhSecret = Nothing,
       sndId = "",
+      sndSecure = True,
       status = New,
       dbQueueId = DBQueueId 0,
       primary = True,
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index bd8cee771..9bd124e55 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -28,7 +28,7 @@ import Network.HTTP.Types (Status)
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Server as H
 import Network.Socket
-import SMPClient (serverBracket)
+import SMPClient (prevRange, serverBracket)
 import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost, defaultNetworkConfig)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
@@ -36,7 +36,6 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol (NtfResponse)
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
 import Simplex.Messaging.Notifications.Server.Env
-import qualified Simplex.Messaging.Notifications.Server.Env as Env
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
 import Simplex.Messaging.Notifications.Transport
@@ -47,7 +46,6 @@ import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), http2TLSParams)
 import Simplex.Messaging.Transport.HTTP2.Server
 import Simplex.Messaging.Transport.Server
 import qualified Simplex.Messaging.Transport.Server as Server
-import Simplex.Messaging.Version (mkVersionRange)
 import Test.Hspec
 import UnliftIO.Async
 import UnliftIO.Concurrent
@@ -108,18 +106,19 @@ ntfServerCfg =
       serverStatsLogFile = "tests/ntf-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
       ntfServerVRange = supportedServerNTFVRange,
-      transportConfig = defaultTransportServerConfig
+      transportConfig = defaultTransportServerConfig {Server.alpn = Just supportedNTFHandshakes}
     }
 
-ntfServerCfgV2 :: NtfServerConfig
-ntfServerCfgV2 =
+ntfServerCfgVPrev :: NtfServerConfig
+ntfServerCfgVPrev =
   ntfServerCfg
-    { ntfServerVRange = mkVersionRange initialNTFVersion authBatchCmdsNTFVersion,
-      smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {serverVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion}},
-      Env.transportConfig = defaultTransportServerConfig {Server.alpn = Just supportedNTFHandshakes}
+    { ntfServerVRange = prevRange $ ntfServerVRange ntfServerCfg,
+      smpAgentCfg = smpAgentCfg' {smpCfg = smpCfg' {serverVRange = prevRange serverVRange'}}
     }
   where
     smpAgentCfg' = smpAgentCfg ntfServerCfg
+    smpCfg' = smpCfg smpAgentCfg'
+    serverVRange' = serverVRange smpCfg'
 
 withNtfServerStoreLog :: ATransport -> (ThreadId -> IO a) -> IO a
 withNtfServerStoreLog t = withNtfServerCfg ntfServerCfg {storeLogFile = Just ntfTestStoreLogFile, transports = [(ntfTestPort, t)]}
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index 3c9907c48..7cb2a88c5 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -14,7 +14,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import NtfClient (ntfTestPort)
-import SMPClient (proxyVRange, testPort)
+import SMPClient (proxyVRangeV8, testPort)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
@@ -80,8 +80,8 @@ agentCfg =
   where
     networkConfig = defaultNetworkConfig {tcpConnectTimeout = 1_000_000, tcpTimeout = 2_000_000}
 
-agentProxyCfg :: AgentConfig
-agentProxyCfg = agentCfg {smpCfg = (smpCfg agentCfg) {serverVRange = proxyVRange}}
+agentProxyCfgV8 :: AgentConfig
+agentProxyCfgV8 = agentCfg {smpCfg = (smpCfg agentCfg) {serverVRange = proxyVRangeV8}}
 
 fastRetryInterval :: RetryInterval
 fastRetryInterval = defaultReconnectInterval {initialInterval = 50_000}
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 6bc36c29a..144ad8b10 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -29,6 +29,7 @@ import qualified Simplex.Messaging.Transport.Client as Client
 import Simplex.Messaging.Transport.Server
 import qualified Simplex.Messaging.Transport.Server as Server
 import Simplex.Messaging.Version
+import Simplex.Messaging.Version.Internal
 import System.Environment (lookupEnv)
 import System.Info (os)
 import Test.Hspec
@@ -133,18 +134,26 @@ cfgV7 = cfg {smpServerVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVer
 cfgV8 :: ServerConfig
 cfgV8 = cfg {smpServerVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion}
 
+cfgVPrev :: ServerConfig
+cfgVPrev = cfg {smpServerVRange = prevRange $ smpServerVRange cfg}
+
+prevRange :: VersionRange v -> VersionRange v
+prevRange vr = vr {maxVersion = max (minVersion vr) (prevVersion $ maxVersion vr)}
+
+prevVersion :: Version v -> Version v
+prevVersion (Version v) = Version (v - 1)
+
 proxyCfg :: ServerConfig
 proxyCfg =
-  cfgV7
+  cfg
     { allowSMPProxy = True,
-      smpServerVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion,
-      smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {serverVRange = proxyVRange, agreeSecret = True}}
+      smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {agreeSecret = True}}
     }
   where
-    smpAgentCfg' = smpAgentCfg cfgV7
+    smpAgentCfg' = smpAgentCfg cfg
 
-proxyVRange :: VersionRangeSMP
-proxyVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion
+proxyVRangeV8 :: VersionRangeSMP
+proxyVRangeV8 = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion
 
 withSmpServerStoreMsgLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, serverStatsBackupFile = Just testServerStatsBackupFile}
@@ -180,9 +189,6 @@ withSmpServerOn t port' = withSmpServerThreadOn t port' . const
 withSmpServer :: HasCallStack => ATransport -> IO a -> IO a
 withSmpServer t = withSmpServerOn t testPort
 
-withSmpServerV7 :: HasCallStack => ATransport -> IO a -> IO a
-withSmpServerV7 t = withSmpServerConfigOn t cfgV7 testPort . const
-
 withSmpServerProxy :: HasCallStack => ATransport -> IO a -> IO a
 withSmpServerProxy t = withSmpServerConfigOn t proxyCfg testPort . const
 
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index d71208db9..6452d2677 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -102,22 +102,22 @@ smpProxyTests = do
     describe "agent API" $ do
       describe "one server" $ do
         it "always via proxy" . oneServer $
-          agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv1], SPMAlways, True) C.SEd448 "hello 1" "hello 2"
+          agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv1], SPMAlways, True) C.SEd448 "hello 1" "hello 2" 1
         it "without proxy" . oneServer $
-          agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv1], SPMNever, False) C.SEd448 "hello 1" "hello 2"
+          agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv1], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
       describe "two servers" $ do
         it "always via proxy" . twoServers $
-          agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv2], SPMAlways, True) C.SEd448 "hello 1" "hello 2"
+          agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv2], SPMAlways, True) C.SEd448 "hello 1" "hello 2" 1
         it "both via proxy" . twoServers $
-          agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMUnknown, True) C.SEd448 "hello 1" "hello 2"
+          agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMUnknown, True) C.SEd448 "hello 1" "hello 2" 1
         it "first via proxy" . twoServers $
-          agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2"
+          agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
         it "without proxy" . twoServers $
-          agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2"
+          agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
         it "first via proxy for unknown" . twoServers $
-          agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv1, srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2"
+          agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv1, srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2" 1
         it "without proxy with fallback" . twoServers_ proxyCfg cfgV7 $
-          agentDeliverMessageViaProxy ([srv1], SPMUnknown, False) ([srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2"
+          agentDeliverMessageViaProxy ([srv1], SPMUnknown, False) ([srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2" 3
         it "fails when fallback is prohibited" . twoServers_ proxyCfg cfgV7 $
           agentViaProxyVersionError
         it "retries sending when destination or proxy relay is offline" $
@@ -157,7 +157,7 @@ deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do
   -- prepare receiving queue
   (rPub, rPriv) <- atomically $ C.generateAuthKeyPair alg g
   (rdhPub, rdhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-  QIK {rcvId, sndId, rcvPublicDhKey = srvDh} <- runExceptT' $ createSMPQueue rc (rPub, rPriv) rdhPub (Just "correct") SMSubscribe
+  QIK {rcvId, sndId, rcvPublicDhKey = srvDh} <- runExceptT' $ createSMPQueue rc (rPub, rPriv) rdhPub (Just "correct") SMSubscribe False
   let dec = decryptMsgV3 $ C.dh' srvDh rdhPriv
   -- get proxy session
   sess0 <- runExceptT' $ connectSMPProxiedRelay pc relayServ (Just "correct")
@@ -199,8 +199,8 @@ proxyConnectDeadRelay n d proxyServ = do
       Right !_noWay -> error "got unexpected client"
       Left !_err -> threadDelay d
 
-agentDeliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => (NonEmpty SMPServer, SMPProxyMode, Bool) -> (NonEmpty SMPServer, SMPProxyMode, Bool) -> C.SAlgorithm a -> ByteString -> ByteString -> IO ()
-agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, bViaProxy) alg msg1 msg2 =
+agentDeliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => (NonEmpty SMPServer, SMPProxyMode, Bool) -> (NonEmpty SMPServer, SMPProxyMode, Bool) -> C.SAlgorithm a -> ByteString -> ByteString -> AgentMsgId -> IO ()
+agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, bViaProxy) alg msg1 msg2 baseId =
   withAgent 1 aCfg (servers aTestCfg) testDB $ \alice ->
     withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do
       (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
@@ -232,9 +232,8 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b
       get alice =##> \case ("", c, Msg' _ pq msg2') -> c == bobId && pq == pqEnc && msg2 == msg2'; _ -> False
       ackMessage alice bobId (baseId + 4) Nothing
   where
-    baseId = 3
     msgId = subtract baseId . fst
-    aCfg = agentProxyCfg {sndAuthAlg = C.AuthAlg alg, rcvAuthAlg = C.AuthAlg alg}
+    aCfg = agentCfg {sndAuthAlg = C.AuthAlg alg, rcvAuthAlg = C.AuthAlg alg}
     servers (srvs, smpProxyMode, _) = (initAgentServersProxy smpProxyMode SPFAllow) {smp = userServers $ L.map noAuthSrv srvs}
 
 agentDeliverMessagesViaProxyConc :: [NonEmpty SMPServer] -> [MsgBody] -> IO ()
@@ -299,14 +298,14 @@ agentDeliverMessagesViaProxyConc agentServers msgs =
         Left (Left e) -> cancel aSender >> throwIO e
       logDebug "run finished"
     pqEnc = CR.PQEncOn
-    aCfg = agentProxyCfg {sndAuthAlg = C.AuthAlg C.SEd448, rcvAuthAlg = C.AuthAlg C.SEd448}
+    aCfg = agentCfg {sndAuthAlg = C.AuthAlg C.SEd448, rcvAuthAlg = C.AuthAlg C.SEd448}
     servers srvs = (initAgentServersProxy SPMAlways SPFAllow) {smp = userServers $ L.map noAuthSrv srvs}
 
 agentViaProxyVersionError :: IO ()
 agentViaProxyVersionError =
-  withAgent 1 agentProxyCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do
+  withAgent 1 agentCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do
     Left (A.BROKER _ (TRANSPORT TEVersion)) <-
-      withAgent 2 agentProxyCfg (servers [SMPServer testHost testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do
+      withAgent 2 agentCfg (servers [SMPServer testHost testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do
         (_bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
         A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
     pure ()
@@ -370,22 +369,22 @@ agentViaProxyRetryOffline = do
       withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just storeLog, storeMsgsFile = Just storeMsgs} port
     a `up` cId = nGet a =##> \case ("", "", UP _ [c]) -> c == cId; _ -> False
     a `down` cId = nGet a =##> \case ("", "", DOWN _ [c]) -> c == cId; _ -> False
-    aCfg = agentProxyCfg {messageRetryInterval = fastMessageRetryInterval}
-    baseId = 3
+    aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
+    baseId = 1
     msgId = subtract baseId . fst
     servers srv = (initAgentServersProxy SPMAlways SPFProhibit) {smp = userServers $ L.map noAuthSrv [srv]}
 
 testNoProxy :: IO ()
 testNoProxy = do
   withSmpServerConfigOn (transport @TLS) cfg testPort2 $ \_ -> do
-    testSMPClient_ "127.0.0.1" testPort2 proxyVRange $ \(th :: THandleSMP TLS 'TClient) -> do
+    testSMPClient_ "127.0.0.1" testPort2 proxyVRangeV8 $ \(th :: THandleSMP TLS 'TClient) -> do
       (_, _, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", PRXY testSMPServer Nothing)
       reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
 
 testProxyAuth :: IO ()
 testProxyAuth = do
   withSmpServerConfigOn (transport @TLS) proxyCfgAuth testPort $ \_ -> do
-    testSMPClient_ "127.0.0.1" testPort proxyVRange $ \(th :: THandleSMP TLS 'TClient) -> do
+    testSMPClient_ "127.0.0.1" testPort proxyVRangeV8 $ \(th :: THandleSMP TLS 'TClient) -> do
       (_, _s, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", PRXY testSMPServer2 $ Just "wrong")
       reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
   where
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index a124a42e4..1fa76dfaa 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -73,7 +73,7 @@ pattern Resp :: CorrId -> QueueId -> BrokerMsg -> SignedTransmission ErrorType B
 pattern Resp corrId queueId command <- (_, _, (corrId, queueId, Right command))
 
 pattern Ids :: RecipientId -> SenderId -> RcvPublicDhKey -> BrokerMsg
-pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh)
+pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh _sndSecure)
 
 pattern Msg :: MsgId -> MsgBody -> BrokerMsg
 pattern Msg msgId body <- MSG RcvMessage {msgId, msgBody = EncRcvMsgBody body}
@@ -134,7 +134,7 @@ testCreateSecure (ATransport t) =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv r rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv r rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       (rId1, "") #== "creates queue"
 
@@ -199,7 +199,7 @@ testCreateDelete (ATransport t) =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       (rId1, "") #== "creates queue"
 
@@ -271,7 +271,7 @@ stressTest (ATransport t) =
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
       rIds <- forM ([1 .. 50] :: [Int]) . const $ do
-        Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub Nothing SMSubscribe)
+        Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub Nothing SMSubscribe False)
         pure rId
       let subscribeQueues h = forM_ rIds $ \rId -> do
             Resp "" rId' OK <- signSendRecv h rKey ("", rId, SUB)
@@ -289,7 +289,7 @@ testAllowNewQueues t =
         g <- C.newRandom
         (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
         (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-        Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
+        Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
         pure ()
 
 testDuplex :: ATransport -> Spec
@@ -299,7 +299,7 @@ testDuplex (ATransport t) =
       g <- C.newRandom
       (arPub, arKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (aDhPub, aDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub Nothing SMSubscribe)
+      Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub Nothing SMSubscribe False)
       let aDec = decryptMsgV3 $ C.dh' aSrvDh aDhPriv
       -- aSnd ID is passed to Bob out-of-band
 
@@ -315,7 +315,7 @@ testDuplex (ATransport t) =
 
       (brPub, brKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (bDhPub, bDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub Nothing SMSubscribe)
+      Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub Nothing SMSubscribe False)
       let bDec = decryptMsgV3 $ C.dh' bSrvDh bDhPriv
       Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, _SEND $ "reply_id " <> encode bSnd)
       -- "reply_id ..." is ad-hoc, not a part of SMP protocol
@@ -354,7 +354,7 @@ testSwitchSub (ATransport t) =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
+      Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, _SEND "test1")
       (ok1, OK) #== "sent test message 1"
@@ -740,7 +740,7 @@ createAndSecureQueue h sPub = do
   g <- C.newRandom
   (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
   (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-  Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
+  Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
   let dhShared = C.dh' srvDh dhPriv
   Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, KEY sPub)
   (rId', rId) #== "same queue ID"
@@ -751,7 +751,7 @@ testTiming (ATransport t) =
   describe "should have similar time for auth error, whether queue exists or not, for all key types" $
     forM_ timingTests $ \tst ->
       it (testName tst) $
-        smpTest2Cfg cfgV7 (mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion) t $ \rh sh ->
+        smpTest2Cfg cfg (mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion) t $ \rh sh ->
           testSameTiming rh sh tst
   where
     testName :: (C.AuthAlg, C.AuthAlg, Int) -> String
@@ -775,7 +775,7 @@ testTiming (ATransport t) =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe)
+      Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, SUB)
 
@@ -937,8 +937,8 @@ syntaxTests (ATransport t) = do
   describe "NEW" $ do
     it "no parameters" $ (sampleSig, "bcda", "", NEW_) >#> ("", "bcda", "", ERR $ CMD SYNTAX)
     it "many parameters" $ (sampleSig, "cdab", "", (NEW_, ' ', ('\x01', 'A'), samplePubKey, sampleDhPubKey)) >#> ("", "cdab", "", ERR $ CMD SYNTAX)
-    it "no signature" $ ("", "dabc", "", (NEW_, ' ', samplePubKey, sampleDhPubKey, SMSubscribe)) >#> ("", "dabc", "", ERR $ CMD NO_AUTH)
-    it "queue ID" $ (sampleSig, "abcd", "12345678", (NEW_, ' ', samplePubKey, sampleDhPubKey, SMSubscribe)) >#> ("", "abcd", "12345678", ERR $ CMD HAS_AUTH)
+    it "no signature" $ ("", "dabc", "", (NEW_, ' ', samplePubKey, sampleDhPubKey, '0', SMSubscribe, False)) >#> ("", "dabc", "", ERR $ CMD NO_AUTH)
+    it "queue ID" $ (sampleSig, "abcd", "12345678", (NEW_, ' ', samplePubKey, sampleDhPubKey, '0', SMSubscribe, False)) >#> ("", "abcd", "12345678", ERR $ CMD HAS_AUTH)
   describe "KEY" $ do
     it "valid syntax" $ (sampleSig, "bcda", "12345678", (KEY_, ' ', samplePubKey)) >#> ("", "bcda", "12345678", ERR AUTH)
     it "no parameters" $ (sampleSig, "cdab", "12345678", KEY_) >#> ("", "cdab", "12345678", ERR $ CMD SYNTAX)
diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index 37ec00199..8de86eff1 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -398,7 +398,7 @@ testXFTPAgentReceiveCleanup = withGlobalLogging logCfgNoLogs $ do
     -- receive file - should fail with AUTH error
     withAgent 3 agentCfg initAgentServers testDB2 $ \rcp' -> do
       runRight_ $ xftpStartWorkers rcp' (Just recipientFiles)
-      ("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <- rfGet rcp'
+      ("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <- rfGet rcp'
       rfId' `shouldBe` rfId
 
   -- tmp path should be removed after permanent error
@@ -477,7 +477,7 @@ testXFTPAgentSendCleanup = withGlobalLogging logCfgNoLogs $ do
     -- send file - should fail with AUTH error
     withAgent 2 agentCfg initAgentServers testDB $ \sndr' -> do
       runRight_ $ xftpStartWorkers sndr' (Just senderFiles)
-      ("", sfId', SFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <-
+      ("", sfId', SFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <-
         sfGet sndr'
       sfId' `shouldBe` sfId
 
@@ -513,7 +513,7 @@ testXFTPAgentDelete = withGlobalLogging logCfgNoLogs $
       withAgent 3 agentCfg initAgentServers testDB2 $ \rcp2 -> runRight $ do
         xftpStartWorkers rcp2 (Just recipientFiles)
         rfId <- xftpReceiveFile rcp2 1 rfd2 Nothing True
-        ("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <-
+        ("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <-
           rfGet rcp2
         liftIO $ rfId' `shouldBe` rfId
 
@@ -551,7 +551,7 @@ testXFTPAgentDeleteRestore = withGlobalLogging logCfgNoLogs $ do
       withAgent 5 agentCfg initAgentServers testDB3 $ \rcp2 -> runRight $ do
         xftpStartWorkers rcp2 (Just recipientFiles)
         rfId <- xftpReceiveFile rcp2 1 rfd2 Nothing True
-        ("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <-
+        ("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <-
           rfGet rcp2
         liftIO $ rfId' `shouldBe` rfId
 
@@ -586,7 +586,7 @@ testXFTPAgentDeleteOnServer = withGlobalLogging logCfgNoLogs $
         runRight_ . void $ do
           -- receive file 1 again
           rfId1 <- xftpReceiveFile rcp 1 rfd1_2 Nothing True
-          ("", rfId1', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <-
+          ("", rfId1', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <-
             rfGet rcp
           liftIO $ rfId1 `shouldBe` rfId1'
 
@@ -619,7 +619,7 @@ testXFTPAgentExpiredOnServer = withGlobalLogging logCfgNoLogs $ do
         -- receive file 1 again - should fail with AUTH error
         runRight $ do
           rfId <- xftpReceiveFile rcp 1 rfd1_2 Nothing True
-          ("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" AUTH)) <-
+          ("", rfId', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <-
             rfGet rcp
           liftIO $ rfId' `shouldBe` rfId
 
diff --git a/tests/XFTPClient.hs b/tests/XFTPClient.hs
index 208b54dc5..72c843f32 100644
--- a/tests/XFTPClient.hs
+++ b/tests/XFTPClient.hs
@@ -67,10 +67,10 @@ withXFTPServer2 :: HasCallStack => IO a -> IO a
 withXFTPServer2 = withXFTPServerCfg testXFTPServerConfig {xftpPort = xftpTestPort2, filesPath = xftpServerFiles2} . const
 
 xftpTestPort :: ServiceName
-xftpTestPort = "7000"
+xftpTestPort = "8000"
 
 xftpTestPort2 :: ServiceName
-xftpTestPort2 = "7001"
+xftpTestPort2 = "8001"
 
 testXFTPServer :: XFTPServer
 testXFTPServer = fromString testXFTPServerStr
@@ -79,10 +79,10 @@ testXFTPServer2 :: XFTPServer
 testXFTPServer2 = fromString testXFTPServerStr2
 
 testXFTPServerStr :: String
-testXFTPServerStr = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000"
+testXFTPServerStr = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000"
 
 testXFTPServerStr2 :: String
-testXFTPServerStr2 = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7001"
+testXFTPServerStr2 = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8001"
 
 xftpServerFiles :: FilePath
 xftpServerFiles = "tests/tmp/xftp-server-files"

From 6a54a58a0d47aeca9d5482b0d27e451731b692f1 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 30 Jun 2024 12:50:42 +0100
Subject: [PATCH 017/195] agent: remove legacy statistics (#1211)

* agent: remove legacy statistics

* delays after disposeAgent

* delays

* enable all tests

* more delays
---
 src/Simplex/FileTransfer/Client.hs     |   4 -
 src/Simplex/Messaging/Agent.hs         |  31 +------
 src/Simplex/Messaging/Agent/Client.hs  | 116 ++++++-------------------
 tests/AgentTests/FunctionalAPITests.hs |  11 ++-
 4 files changed, 36 insertions(+), 126 deletions(-)

diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs
index 445def724..1404fd434 100644
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -22,7 +22,6 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
-import Data.Time (UTCTime)
 import Data.Word (Word32)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
@@ -168,9 +167,6 @@ xftpClientServer = B.unpack . strEncode . snd3 . transportSession
 xftpTransportHost :: XFTPClient -> TransportHost
 xftpTransportHost XFTPClient {http2Client = HTTP2Client {client_ = HClient {host}}} = host
 
-xftpSessionTs :: XFTPClient -> UTCTime
-xftpSessionTs = sessionTs . http2Client
-
 xftpHTTP2Config :: TransportClientConfig -> XFTPClientConfig -> HTTP2ClientConfig
 xftpHTTP2Config transportConfig XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpConnectTimeout}} =
   defaultHTTP2ClientConfig
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 0c433cfed..c4f62702e 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -111,9 +111,6 @@ module Simplex.Messaging.Agent
     execAgentStoreSQL,
     getAgentMigrations,
     debugAgentLocks,
-    getAgentStats,
-    resetAgentStats,
-    getMsgCounts,
     getAgentSubscriptions,
     logConnection,
   )
@@ -126,7 +123,7 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
-import Data.Bifunctor (bimap, first, second)
+import Data.Bifunctor (bimap, first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Composition ((.:), (.:.), (.::), (.::.))
@@ -591,16 +588,6 @@ resetAgentServersStats :: AgentClient -> AE ()
 resetAgentServersStats c = withAgentEnv c $ resetAgentServersStats' c
 {-# INLINE resetAgentServersStats #-}
 
-getAgentStats :: AgentClient -> IO [(AgentStatsKey, Int)]
-getAgentStats c = readTVarIO (agentStats c) >>= mapM (\(k, cnt) -> (k,) <$> readTVarIO cnt) . M.assocs
-
-resetAgentStats :: AgentClient -> IO ()
-resetAgentStats = atomically . TM.clear . agentStats
-{-# INLINE resetAgentStats #-}
-
-getMsgCounts :: AgentClient -> IO [(ConnId, (Int, Int))] -- (total, duplicates)
-getMsgCounts c = readTVarIO (msgCounts c) >>= mapM (\(connId, cnt) -> (connId,) <$> readTVarIO cnt) . M.assocs
-
 withAgentEnv' :: AgentClient -> AM' a -> IO a
 withAgentEnv' c = (`runReaderT` agentEnv c)
 {-# INLINE withAgentEnv' #-}
@@ -2246,7 +2233,6 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                           _ -> pure ()
                         let encryptedMsgHash = C.sha256Hash encAgentMessage
                         g <- asks random
-                        atomically updateTotalMsgCount
                         tryAgentError (agentClientMsg g encryptedMsgHash) >>= \case
                           Right (Just (msgId, msgMeta, aMessage, rcPrev)) -> do
                             conn'' <- resetRatchetSync
@@ -2280,7 +2266,6 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                                 | otherwise = pure conn'
                           Right Nothing -> prohibited "msg: bad agent msg" >> ack
                           Left e@(AGENT A_DUPLICATE) -> do
-                            atomically updateDupMsgCount
                             atomically $ incSMPServerStat c userId srv recvDuplicates
                             withStore' c (\db -> getLastMsg db connId srvMsgId) >>= \case
                               Just RcvMsg {internalId, msgMeta, msgBody = agentMsgBody, userAck}
@@ -2315,20 +2300,6 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                           checkDuplicateHash e encryptedMsgHash =
                             unlessM (withStore' c $ \db -> checkRcvMsgHashExists db connId encryptedMsgHash) $
                               throwE e
-                          updateTotalMsgCount :: STM ()
-                          updateTotalMsgCount =
-                            TM.lookup connId (msgCounts c) >>= \case
-                              Just v -> modifyTVar' v $ first (+ 1)
-                              Nothing -> addMsgCount 0
-                          updateDupMsgCount :: STM ()
-                          updateDupMsgCount =
-                            TM.lookup connId (msgCounts c) >>= \case
-                              Just v -> modifyTVar' v $ second (+ 1)
-                              Nothing -> addMsgCount 1
-                          addMsgCount :: Int -> STM ()
-                          addMsgCount duplicate = do
-                            counts <- newTVar (1, duplicate)
-                            TM.insert connId counts (msgCounts c)
                           agentClientMsg :: TVar ChaChaDRG -> ByteString -> AM (Maybe (InternalId, MsgMeta, AMessage, CR.RatchetX448))
                           agentClientMsg g encryptedMsgHash = withStore c $ \db -> runExceptT $ do
                             rc <- ExceptT $ getRatchet db connId -- ratchet state pre-decryption - required for processing EREADY
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index ec8424745..7f5bb43e6 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -104,7 +104,6 @@ module Simplex.Messaging.Agent.Client
     AgentOpState (..),
     AgentState (..),
     AgentLocks (..),
-    AgentStatsKey (..),
     getAgentWorker,
     getAgentWorker',
     cancelWorker,
@@ -158,7 +157,7 @@ module Simplex.Messaging.Agent.Client
 where
 
 import Control.Applicative ((<|>))
-import Control.Concurrent (ThreadId, forkIO, threadDelay)
+import Control.Concurrent (ThreadId, forkIO)
 import Control.Concurrent.Async (Async, uninterruptibleCancel)
 import Control.Concurrent.STM (retry, throwSTM)
 import Control.Exception (AsyncException (..), BlockedIndefinitelyOnSTM (..))
@@ -321,8 +320,6 @@ data AgentClient = AgentClient
     deleteLock :: Lock,
     -- smpSubWorkers for SMP servers sessions
     smpSubWorkers :: TMap SMPTransportSession (SessionVar (Async ())),
-    agentStats :: TMap AgentStatsKey (TVar Int),
-    msgCounts :: TMap ConnId (TVar (Int, Int)), -- (total, duplicates)
     clientId :: Int,
     agentEnv :: Env,
     smpServersStats :: TMap (UserId, SMPServer) AgentSMPServerStats,
@@ -430,15 +427,6 @@ data AgentLocks = AgentLocks
   }
   deriving (Show)
 
-data AgentStatsKey = AgentStatsKey
-  { userId :: UserId,
-    host :: ByteString,
-    clientTs :: ByteString,
-    cmd :: ByteString,
-    res :: ByteString
-  }
-  deriving (Eq, Ord, Show)
-
 data UserNetworkInfo = UserNetworkInfo
   { networkType :: UserNetworkType,
     online :: Bool
@@ -492,8 +480,6 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
   invLocks <- TM.empty
   deleteLock <- createLock
   smpSubWorkers <- TM.empty
-  agentStats <- TM.empty
-  msgCounts <- TM.empty
   smpServersStats <- TM.empty
   xftpServersStats <- TM.empty
   srvStatsStartedAt <- newTVar currentTs
@@ -532,8 +518,6 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
         invLocks,
         deleteLock,
         smpSubWorkers,
-        agentStats,
-        msgCounts,
         clientId,
         agentEnv,
         smpServersStats,
@@ -565,7 +549,6 @@ class (Encoding err, Show err) => ProtocolServerClient v err msg | msg -> v, msg
   closeProtocolServerClient :: ProtoClient msg -> IO ()
   clientServer :: ProtoClient msg -> String
   clientTransportHost :: ProtoClient msg -> TransportHost
-  clientSessionTs :: ProtoClient msg -> UTCTime
 
 instance ProtocolServerClient SMPVersion ErrorType BrokerMsg where
   type Client BrokerMsg = SMPConnectedClient
@@ -576,7 +559,6 @@ instance ProtocolServerClient SMPVersion ErrorType BrokerMsg where
   closeProtocolServerClient = closeProtocolClient
   clientServer = protocolClientServer
   clientTransportHost = transportHost'
-  clientSessionTs = sessionTs
 
 instance ProtocolServerClient NTFVersion ErrorType NtfResponse where
   type Client NtfResponse = ProtocolClient NTFVersion ErrorType NtfResponse
@@ -587,7 +569,6 @@ instance ProtocolServerClient NTFVersion ErrorType NtfResponse where
   closeProtocolServerClient = closeProtocolClient
   clientServer = protocolClientServer
   clientTransportHost = transportHost'
-  clientSessionTs = sessionTs
 
 instance ProtocolServerClient XFTPVersion XFTPErrorType FileResponse where
   type Client FileResponse = XFTPClient
@@ -598,7 +579,6 @@ instance ProtocolServerClient XFTPVersion XFTPErrorType FileResponse where
   closeProtocolServerClient = X.closeXFTPClient
   clientServer = X.xftpClientServer
   clientTransportHost = X.xftpTransportHost
-  clientSessionTs = X.xftpSessionTs
 
 getSMPServerClient :: AgentClient -> SMPTransportSession -> AM SMPConnectedClient
 getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
@@ -642,14 +622,12 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
           >>= either (newProxiedRelay clnt auth) (waitForProxiedRelay tSess)
       pure (clnt, sess)
     newProxiedRelay :: SMPConnectedClient -> Maybe SMP.BasicAuth -> ProxiedRelayVar -> AM (Either AgentErrorType ProxiedRelay)
-    newProxiedRelay clnt@(SMPConnectedClient smp prs) proxyAuth rv =
+    newProxiedRelay (SMPConnectedClient smp prs) proxyAuth rv =
       tryAgentError (liftClient SMP (clientServer smp) $ connectSMPProxiedRelay smp destSrv proxyAuth) >>= \case
         Right sess -> do
           atomically $ putTMVar (sessionVar rv) (Right sess)
-          liftIO $ incClientStat c userId clnt "PROXY" "OK"
           pure $ Right sess
         Left e -> do
-          liftIO $ incClientStat c userId clnt "PROXY" $ bshow e
           atomically $ do
             unless (serverHostError e) $ do
               removeSessVar rv destSrv prs
@@ -701,7 +679,6 @@ smpClientDisconnected c@AgentClient {active, smpClients, smpProxiedRelays} tSess
 
     serverDown :: ([RcvQueue], [ConnId]) -> IO ()
     serverDown (qs, conns) = whenM (readTVarIO active) $ do
-      incClientStat' c userId client "DISCONNECT" ""
       notifySub "" $ hostEvent' DISCONNECT client
       unless (null conns) $ notifySub "" $ DOWN srv conns
       unless (null qs) $ do
@@ -763,7 +740,7 @@ reconnectSMPClient c tSess@(_, srv, _) qs = handleNotify $ do
     notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, AEvt (sAEntity @e) cmd)
 
 getNtfServerClient :: AgentClient -> NtfTransportSession -> AM NtfClient
-getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(userId, srv, _) = do
+getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(_, srv, _) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess ntfClients ts)
@@ -782,12 +759,11 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(userId,
     clientDisconnected :: NtfClientVar -> NtfClient -> IO ()
     clientDisconnected v client = do
       atomically $ removeSessVar v tSess ntfClients
-      incClientStat c userId client "DISCONNECT" ""
       atomically $ writeTBQueue (subQ c) ("", "", AEvt SAENone $ hostEvent DISCONNECT client)
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
 getXFTPServerClient :: AgentClient -> XFTPTransportSession -> AM XFTPClient
-getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(userId, srv, _) = do
+getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(_, srv, _) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess xftpClients ts)
@@ -806,7 +782,6 @@ getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(userId
     clientDisconnected :: XFTPClientVar -> XFTPClient -> IO ()
     clientDisconnected v client = do
       atomically $ removeSessVar v tSess xftpClients
-      incClientStat c userId client "DISCONNECT" ""
       atomically $ writeTBQueue (subQ c) ("", "", AEvt SAENone $ hostEvent DISCONNECT client)
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
@@ -846,11 +821,9 @@ newProtocolClient c tSess@(userId, srv, entityId_) clients connectClient v =
     Right client -> do
       logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv <> " (user " <> bshow userId <> maybe "" (" for entity " <>) entityId_ <> ")"
       atomically $ putTMVar (sessionVar v) (Right client)
-      liftIO $ incClientStat c userId client "CLIENT" "OK"
       atomically $ writeTBQueue (subQ c) ("", "", AEvt SAENone $ hostEvent CONNECT client)
       pure client
     Left e -> do
-      liftIO $ incServerStat c userId srv "CLIENT" $ bshow e
       ei <- asks $ persistErrorInterval . config
       if ei == 0
         then atomically $ do
@@ -1004,46 +977,42 @@ getMapLock locks key = TM.lookup key locks >>= maybe newLock pure
   where
     newLock = createLock >>= \l -> TM.insert key l locks $> l
 
-withClient_ :: forall a v err msg. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> ByteString -> (Client msg -> AM a) -> AM a
-withClient_ c tSess@(userId, srv, _) statCmd action = do
+withClient_ :: forall a v err msg. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> (Client msg -> AM a) -> AM a
+withClient_ c tSess@(_, srv, _) action = do
   cl <- getProtocolServerClient c tSess
-  (action cl <* stat cl "OK") `catchAgentError` logServerError cl
+  action cl `catchAgentError` logServerError
   where
-    stat cl = liftIO . incClientStat c userId cl statCmd
-    logServerError :: Client msg -> AgentErrorType -> AM a
-    logServerError cl e = do
+    logServerError :: AgentErrorType -> AM a
+    logServerError e = do
       logServer "<--" c srv "" $ bshow e
-      stat cl $ bshow e
       throwE e
 
 withProxySession :: AgentClient -> SMPTransportSession -> SMP.SenderId -> ByteString -> ((SMPConnectedClient, ProxiedRelay) -> AM a) -> AM a
-withProxySession c destSess@(userId, destSrv, _) entId cmdStr action = do
+withProxySession c destSess@(_, destSrv, _) entId cmdStr action = do
   (cl, sess_) <- getSMPProxyClient c destSess
   logServer ("--> " <> proxySrv cl <> " >") c destSrv entId cmdStr
   case sess_ of
     Right sess -> do
-      r <- (action (cl, sess) <* stat cl "OK") `catchAgentError` logServerError cl
+      r <- action (cl, sess) `catchAgentError` logServerError cl
       logServer ("<-- " <> proxySrv cl <> " <") c destSrv entId "OK"
       pure r
     Left e -> logServerError cl e
   where
-    stat cl = liftIO . incClientStat c userId cl cmdStr
     proxySrv = showServer . protocolClientServer' . protocolClient
     logServerError :: SMPConnectedClient -> AgentErrorType -> AM a
     logServerError cl e = do
       logServer ("<-- " <> proxySrv cl <> " <") c destSrv "" $ bshow e
-      stat cl $ bshow e
       throwE e
 
 withLogClient_ :: ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> EntityId -> ByteString -> (Client msg -> AM a) -> AM a
 withLogClient_ c tSess@(_, srv, _) entId cmdStr action = do
   logServer "-->" c srv entId cmdStr
-  res <- withClient_ c tSess cmdStr action
+  res <- withClient_ c tSess action
   logServer "<--" c srv entId "OK"
   return res
 
-withClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> ByteString -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
-withClient c tSess statKey action = withClient_ c tSess statKey $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer $ protocolClient client) $ action client
+withClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
+withClient c tSess action = withClient_ c tSess $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer $ protocolClient client) $ action client
 {-# INLINE withClient #-}
 
 withLogClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> EntityId -> ByteString -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
@@ -1235,7 +1204,6 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
           unless (digest == rcvDigest) $ throwE $ ProtocolTestFailure TSCompareFile $ XFTP (B.unpack $ strEncode srv) DIGEST
           liftError (testErr TSDeleteFile) $ X.deleteXFTPChunk xftp spKey sId
         ok <- tcpTimeout xftpNetworkConfig `timeout` X.closeXFTPClient xftp
-        incClientStat c userId xftp "XFTP_TEST" "OK"
         pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
       Left e -> pure (Just $ testErr TSConnect e)
   where
@@ -1274,7 +1242,6 @@ runNTFServerTest c userId (ProtoServerWithAuth srv _) = do
           (tknId, _) <- liftError (testErr TSCreateNtfToken) $ ntfRegisterToken ntf npKey (NewNtfTkn deviceToken nKey dhKey)
           liftError (testErr TSDeleteNtfToken) $ ntfDeleteToken ntf npKey tknId
         ok <- tcpTimeout (networkConfig cfg) `timeout` closeProtocolClient ntf
-        incClientStat c userId ntf "NTF_TEST" "OK"
         pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
       Left e -> pure (Just $ testErr TSConnect e)
   where
@@ -1317,7 +1284,7 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
   logServer "-->" c srv "" "NEW"
   tSess <- liftIO $ mkTransportSession c userId srv connId
   (sessId, QIK {rcvId, sndId, rcvPublicDhKey}) <-
-    withClient c tSess "NEW" $ \(SMPConnectedClient smp _) ->
+    withClient c tSess $ \(SMPConnectedClient smp _) ->
       (sessionId $ thParams smp,) <$> createSMPQueue smp rKeys dhKey auth subMode
   liftIO . logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
   let rq =
@@ -1393,7 +1360,7 @@ subscribeQueues c qs = do
   env <- ask
   -- only "checked" queues are subscribed
   session <- newTVarIO Nothing
-  rs <- sendTSessionBatches "SUB" 90 id (subscribeQueues_ env session) c qs'
+  rs <- sendTSessionBatches "SUB" id (subscribeQueues_ env session) c qs'
   (errs <> rs,) <$> readTVarIO session
   where
     checkQueue rq = do
@@ -1432,9 +1399,8 @@ activeClientSession c tSess sessId = sameSess <$> tryReadSessVar tSess (smpClien
 
 type BatchResponses e r = NonEmpty (RcvQueue, Either e r)
 
--- statBatchSize is not used to batch the commands, only for traffic statistics
-sendTSessionBatches :: forall q r. ByteString -> Int -> (q -> RcvQueue) -> (SMPClient -> NonEmpty q -> IO (BatchResponses SMPClientError r)) -> AgentClient -> [q] -> AM' [(RcvQueue, Either AgentErrorType r)]
-sendTSessionBatches statCmd statBatchSize toRQ action c qs =
+sendTSessionBatches :: forall q r. ByteString -> (q -> RcvQueue) -> (SMPClient -> NonEmpty q -> IO (BatchResponses SMPClientError r)) -> AgentClient -> [q] -> AM' [(RcvQueue, Either AgentErrorType r)]
+sendTSessionBatches statCmd toRQ action c qs =
   concatMap L.toList <$> (mapConcurrently sendClientBatch =<< batchQueues)
   where
     batchQueues :: AM' [(SMPTransportSession, NonEmpty q)]
@@ -1446,19 +1412,14 @@ sendTSessionBatches statCmd statBatchSize toRQ action c qs =
           let tSess = mkSMPTSession (toRQ q) mode
            in M.alter (Just . maybe [q] (q <|)) tSess m
     sendClientBatch :: (SMPTransportSession, NonEmpty q) -> AM' (BatchResponses AgentErrorType r)
-    sendClientBatch (tSess@(userId, srv, _), qs') =
+    sendClientBatch (tSess@(_, srv, _), qs') =
       tryAgentError' (getSMPServerClient c tSess) >>= \case
         Left e -> pure $ L.map ((,Left e) . toRQ) qs'
         Right (SMPConnectedClient smp _) -> liftIO $ do
           logServer "-->" c srv (bshow (length qs') <> " queues") statCmd
-          rs <- L.map agentError <$> action smp qs'
-          statBatch
-          pure rs
+          L.map agentError <$> action smp qs'
           where
             agentError = second . first $ protocolClientError SMP $ clientServer smp
-            statBatch =
-              let n = (length qs - 1) `div` statBatchSize + 1
-               in incClientStatN c userId smp n statCmd "OK"
 
 sendBatch :: (SMPClient -> NonEmpty (SMP.RcvPrivateAuthKey, 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)
@@ -1574,7 +1535,7 @@ enableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} notifierKey rcvNtf
     enableSMPQueueNotifications smp rcvPrivateKey rcvId notifierKey rcvNtfPublicDhKey
 
 enableQueuesNtfs :: AgentClient -> [(RcvQueue, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey)] -> AM' [(RcvQueue, Either AgentErrorType (SMP.NotifierId, SMP.RcvNtfPublicDhKey))]
-enableQueuesNtfs = sendTSessionBatches "NKEY" 90 fst3 enableQueues_
+enableQueuesNtfs = sendTSessionBatches "NKEY" fst3 enableQueues_
   where
     fst3 (x, _, _) = x
     enableQueues_ :: SMPClient -> NonEmpty (RcvQueue, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey) -> IO (NonEmpty (RcvQueue, Either (ProtocolClientError ErrorType) (SMP.NotifierId, RcvNtfPublicDhKey)))
@@ -1588,7 +1549,7 @@ disableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} =
     disableSMPQueueNotifications smp rcvPrivateKey rcvId
 
 disableQueuesNtfs :: AgentClient -> [RcvQueue] -> AM' [(RcvQueue, Either AgentErrorType ())]
-disableQueuesNtfs = sendTSessionBatches "NDEL" 90 id $ sendBatch disableSMPQueuesNtfs
+disableQueuesNtfs = sendTSessionBatches "NDEL" id $ sendBatch disableSMPQueuesNtfs
 
 sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = do
@@ -1615,7 +1576,7 @@ deleteQueue c rq@RcvQueue {rcvId, rcvPrivateKey} = do
     deleteSMPQueue smp rcvPrivateKey rcvId
 
 deleteQueues :: AgentClient -> [RcvQueue] -> AM' [(RcvQueue, Either AgentErrorType ())]
-deleteQueues = sendTSessionBatches "DEL" 90 id $ sendBatch deleteSMPQueues
+deleteQueues = sendTSessionBatches "DEL" id $ sendBatch deleteSMPQueues
 
 sendAgentMessage :: AgentClient -> SndQueue -> MsgFlags -> ByteString -> AM (Maybe SMPServer)
 sendAgentMessage c sq@SndQueue {userId, server, sndId, sndPrivateKey} msgFlags agentMsg = do
@@ -1630,7 +1591,7 @@ getQueueInfo c rq@RcvQueue {rcvId, rcvPrivateKey} =
 
 agentNtfRegisterToken :: AgentClient -> NtfToken -> NtfPublicAuthKey -> C.PublicKeyX25519 -> AM (NtfTokenId, C.PublicKeyX25519)
 agentNtfRegisterToken c NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =
-  withClient c (0, ntfServer, Nothing) "TNEW" $ \ntf -> ntfRegisterToken ntf ntfPrivKey (NewNtfTkn deviceToken ntfPubKey pubDhKey)
+  withClient c (0, ntfServer, Nothing) $ \ntf -> ntfRegisterToken ntf ntfPrivKey (NewNtfTkn deviceToken ntfPubKey pubDhKey)
 
 agentNtfVerifyToken :: AgentClient -> NtfTokenId -> NtfToken -> NtfRegCode -> AM ()
 agentNtfVerifyToken c tknId NtfToken {ntfServer, ntfPrivKey} code =
@@ -1676,7 +1637,7 @@ agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize},
   let fileInfo = FileInfo {sndKey, size = chunkSize, digest = chunkDigest}
   logServer "-->" c srv "" "FNEW"
   tSess <- liftIO $ mkTransportSession c userId srv chunkDigest
-  (sndId, rIds) <- withClient c tSess "FNEW" $ \xftp -> X.createXFTPChunk xftp replicaKey fileInfo (L.map fst rKeys) auth
+  (sndId, rIds) <- withClient c tSess $ \xftp -> X.createXFTPChunk xftp replicaKey fileInfo (L.map fst rKeys) auth
   logServer "<--" c srv "" $ B.unwords ["SIDS", logSecret sndId]
   pure NewSndChunkReplica {server = srv, replicaId = ChunkReplicaId sndId, replicaKey, rcvIdsKeys = L.toList $ xftpRcvIdsKeys rIds rKeys}
 
@@ -1887,33 +1848,6 @@ storeError = \case
   SEDatabaseBusy e -> CRITICAL True $ B.unpack e
   e -> INTERNAL $ show e
 
-incStat :: AgentClient -> Int -> AgentStatsKey -> STM ()
-incStat AgentClient {agentStats} n k = do
-  TM.lookup k agentStats >>= \case
-    Just v -> modifyTVar' v (+ n)
-    _ -> newTVar n >>= \v -> TM.insert k v agentStats
-
-incClientStat :: ProtocolServerClient v err msg => AgentClient -> UserId -> Client msg -> ByteString -> ByteString -> IO ()
-incClientStat c userId = incClientStat' c userId . protocolClient
-{-# INLINE incClientStat #-}
-
-incClientStat' :: ProtocolServerClient v err msg => AgentClient -> UserId -> ProtoClient msg -> ByteString -> ByteString -> IO ()
-incClientStat' c userId pc = incClientStatN c userId pc 1
-{-# INLINE incClientStat' #-}
-
-incServerStat :: AgentClient -> UserId -> ProtocolServer p -> ByteString -> ByteString -> IO ()
-incServerStat c userId ProtocolServer {host} cmd res = do
-  threadDelay 100000
-  atomically $ incStat c 1 statsKey
-  where
-    statsKey = AgentStatsKey {userId, host = strEncode $ L.head host, clientTs = "", cmd, res}
-
-incClientStatN :: ProtocolServerClient v err msg => AgentClient -> UserId -> ProtoClient msg -> Int -> ByteString -> ByteString -> IO ()
-incClientStatN c userId pc n cmd res = do
-  atomically $ incStat c n statsKey
-  where
-    statsKey = AgentStatsKey {userId, host = strEncode $ clientTransportHost pc, clientTs = strEncode $ clientSessionTs pc, cmd, res}
-
 userServers :: forall p. (ProtocolTypeI p, UserProtocol p) => AgentClient -> TMap UserId (NonEmpty (ProtoServerWithAuth p))
 userServers c = case protocolTypeI @p of
   SPSMP -> smpServers c
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index d52c12877..7c7a6cc17 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -957,6 +957,7 @@ testIncreaseConnAgentVersion t = do
     -- version doesn't increase if incompatible
 
     disposeAgentClient alice
+    threadDelay 250000
     alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
 
     runRight_ $ do
@@ -968,6 +969,7 @@ testIncreaseConnAgentVersion t = do
     -- version increases if compatible
 
     disposeAgentClient bob
+    threadDelay 250000
     bob2 <- getSMPAgentClient' 4 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
 
     runRight_ $ do
@@ -979,6 +981,7 @@ testIncreaseConnAgentVersion t = do
     -- version doesn't decrease, even if incompatible
 
     disposeAgentClient alice2
+    threadDelay 250000
     alice3 <- getSMPAgentClient' 5 agentCfg {smpAgentVRange = mkVersionRange 2 2} initAgentServers testDB
 
     runRight_ $ do
@@ -988,6 +991,7 @@ testIncreaseConnAgentVersion t = do
       checkVersion bob2 aliceId 3
 
     disposeAgentClient bob2
+    threadDelay 250000
     bob3 <- getSMPAgentClient' 6 agentCfg {smpAgentVRange = mkVersionRange 1 1} initAgentServers testDB2
 
     runRight_ $ do
@@ -1018,8 +1022,10 @@ testIncreaseConnAgentVersionMaxCompatible t = do
     -- version increases to max compatible
 
     disposeAgentClient alice
+    threadDelay 250000
     alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
     disposeAgentClient bob
+    threadDelay 250000
     bob2 <- getSMPAgentClient' 4 agentCfg {smpAgentVRange = supportedSMPAgentVRange} initAgentServers testDB2
 
     runRight_ $ do
@@ -1098,6 +1104,7 @@ testDuplicateMessage t = do
       get alice ##> ("", bobId, SENT 4)
       get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
     disposeAgentClient bob
+    threadDelay 250000
 
     -- if the agent user did not send ACK, the message will be delivered again
     bob1 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB2
@@ -1120,6 +1127,7 @@ testDuplicateMessage t = do
 
   disposeAgentClient alice
   disposeAgentClient bob1
+  threadDelay 250000
 
   alice2 <- getSMPAgentClient' 4 agentCfg initAgentServers testDB
   bob2 <- getSMPAgentClient' 5 agentCfg initAgentServers testDB2
@@ -1393,6 +1401,7 @@ setupDesynchronizedRatchet alice bob = do
     ackMessage alice bobId 7 Nothing
 
   disposeAgentClient bob
+  threadDelay 250000
 
   -- importing database backup after progressing ratchet de-synchronizes ratchet
   liftIO $ renameFile (testDB2 <> ".bak") testDB2
@@ -3018,7 +3027,7 @@ noNetworkDelay a = do
 networkDelay :: AgentClient -> Int64 -> IO ()
 networkDelay a d' = do
   d <- waitNetwork a
-  unless (d' < d && d < d' + 15000) $ expectationFailure $ "expected delay " <> show d' <> ", d = " <> show d
+  unless (d' - 1000 < d && d < d' + 15000) $ expectationFailure $ "expected delay " <> show d' <> ", d = " <> show d
 
 waitNetwork :: AgentClient -> IO Int64
 waitNetwork a = do

From a99ce6122ca0bab9935f54c3c1f1c80d5e11bb80 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 30 Jun 2024 16:20:54 +0100
Subject: [PATCH 018/195] secure queue by sender via proxy (proxy SKEY command)
 (#1210)

* client: secure queue by sender via proxy (proxy SKEY command)

* agent and server: proxy SKEY command
---
 src/Simplex/Messaging/Agent/Client.hs | 42 ++++++++++++++++++---------
 src/Simplex/Messaging/Client.hs       | 28 +++++++++++-------
 src/Simplex/Messaging/Protocol.hs     |  6 ++--
 src/Simplex/Messaging/Server.hs       | 27 ++++++++---------
 4 files changed, 64 insertions(+), 39 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index d049cfeb0..01d97f9ac 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1026,7 +1026,27 @@ withSMPClient c q cmdStr action = do
   withLogClient c tSess (queueId q) cmdStr $ action . connectedClient
 
 sendOrProxySMPMessage :: AgentClient -> UserId -> SMPServer -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer)
-sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do
+sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg =
+  sendOrProxySMPCommand c userId destSrv cmdStr senderId sendViaProxy sendDirectly
+  where
+    sendViaProxy smp proxySess = do
+      atomically $ incSMPServerStat c userId destSrv sentViaProxyAttempts
+      atomically $ incSMPServerStat c userId (protocolClientServer' smp) sentProxiedAttempts
+      proxySMPMessage smp proxySess spKey_ senderId msgFlags msg
+    sendDirectly smp = do
+      atomically $ incSMPServerStat c userId destSrv sentDirectAttempts
+      sendSMPMessage smp spKey_ senderId msgFlags msg
+
+sendOrProxySMPCommand ::
+  AgentClient ->
+  UserId ->
+  SMPServer ->
+  ByteString ->
+  SMP.SenderId ->
+  (SMPClient -> ProxiedRelay -> ExceptT SMPClientError IO (Either ProxyClientError ())) ->
+  (SMPClient -> ExceptT SMPClientError IO ()) ->
+  AM (Maybe SMPServer)
+sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
   sess <- liftIO $ mkTransportSession c userId destSrv senderId
   ifM (atomically shouldUseProxy) (sendViaProxy sess) (sendDirectly sess $> Nothing)
   where
@@ -1048,10 +1068,7 @@ sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do
     unknownServer = maybe True (all ((destSrv /=) . protoServer)) <$> TM.lookup userId (userServers c)
     sendViaProxy destSess@(_, _, qId) = do
       r <- tryAgentError . withProxySession c destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess) -> do
-        r' <- liftClient SMP (clientServer smp) $ do
-          atomically $ incSMPServerStat c userId destSrv sentViaProxyAttempts
-          atomically $ incSMPServerStat c userId (protocolClientServer' smp) sentProxiedAttempts
-          proxySMPMessage smp proxySess spKey_ senderId msgFlags msg
+        r' <- liftClient SMP (clientServer smp) $ sendCmdViaProxy smp proxySess
         case r' of
           Right () -> pure . Just $ protocolClientServer' smp
           Left proxyErr -> do
@@ -1089,11 +1106,7 @@ sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do
           | otherwise -> throwE e
     sendDirectly tSess =
       withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
-        r <-
-          tryAgentError $
-            liftClient SMP (clientServer smp) $ do
-              atomically $ incSMPServerStat c userId destSrv sentDirectAttempts
-              sendSMPMessage smp spKey_ senderId msgFlags msg
+        r <- tryAgentError $ liftClient SMP (clientServer smp) $ sendCmdDirectly smp
         case r of
           Right () -> atomically $ incSMPServerStat c userId destSrv sentDirect
           Left e -> throwE e
@@ -1536,9 +1549,12 @@ secureQueue c rq@RcvQueue {rcvId, rcvPrivateKey} senderKey =
     secureSMPQueue smp rcvPrivateKey rcvId senderKey
 
 secureSndQueue :: AgentClient -> SndQueue -> AM ()
-secureSndQueue c sq@SndQueue {sndId, sndPrivateKey, sndPublicKey} =
-  withSMPClient c sq "SKEY <key>" $ \smp ->
-    secureSndSMPQueue smp sndPrivateKey sndId sndPublicKey
+secureSndQueue c SndQueue {userId, server, sndId, sndPrivateKey, sndPublicKey} =
+  void $ sendOrProxySMPCommand c userId server "SKEY <key>" sndId secureViaProxy secureDirectly
+  where
+    -- TODO track statistics
+    secureViaProxy smp proxySess = proxySecureSndSMPQueue smp proxySess sndPrivateKey sndId sndPublicKey
+    secureDirectly smp = secureSndSMPQueue smp sndPrivateKey sndId sndPublicKey
 
 enableQueueNotifications :: AgentClient -> RcvQueue -> SMP.NtfPublicAuthKey -> SMP.RcvNtfPublicDhKey -> AM (SMP.NotifierId, SMP.RcvNtfPublicDhKey)
 enableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} notifierKey rcvNtfPublicDhKey =
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 39cf32677..e20b00039 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -48,6 +48,7 @@ module Simplex.Messaging.Client
     subscribeSMPQueuesNtfs,
     secureSMPQueue,
     secureSndSMPQueue,
+    proxySecureSndSMPQueue,
     enableSMPQueueNotifications,
     disableSMPQueueNotifications,
     enableSMPQueuesNtfs,
@@ -59,7 +60,7 @@ module Simplex.Messaging.Client
     deleteSMPQueues,
     connectSMPProxiedRelay,
     proxySMPMessage,
-    forwardSMPMessage,
+    forwardSMPTransmission,
     getSMPQueueInfo,
     sendProtocolCommand,
 
@@ -736,6 +737,10 @@ secureSndSMPQueue :: SMPClient -> SndPrivateAuthKey -> SenderId -> SndPublicAuth
 secureSndSMPQueue c spKey sId senderKey = okSMPCommand (SKEY senderKey) c spKey sId
 {-# INLINE secureSndSMPQueue #-}
 
+proxySecureSndSMPQueue :: SMPClient -> ProxiedRelay -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO (Either ProxyClientError ())
+proxySecureSndSMPQueue c proxiedRelay spKey sId senderKey = proxySMPCommand c proxiedRelay (Just spKey) sId (SKEY senderKey)
+{-# INLINE proxySecureSndSMPQueue #-}
+
 -- | Enable notifications for the queue for push notifications server.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command
@@ -776,6 +781,9 @@ sendSMPMessage c spKey sId flags msg =
     OK -> pure ()
     r -> throwE $ unexpectedResponse r
 
+proxySMPMessage :: SMPClient -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> MsgFlags -> MsgBody -> ExceptT SMPClientError IO (Either ProxyClientError ())
+proxySMPMessage c proxiedRelay spKey sId flags msg = proxySMPCommand c proxiedRelay spKey sId (SEND flags msg)
+
 -- | Acknowledge message delivery (server deletes the message).
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#acknowledge-message-delivery
@@ -877,24 +885,24 @@ instance StrEncoding ProxyClientError where
 -- 8) PFWD(SEND) -> WTF  -> ProxyUnexpectedResponse - client/proxy protocol logic
 -- 9) PFWD(SEND) -> ???  -> ProxyResponseError - client/proxy syntax
 --
--- We report as proxySMPMessage error (ExceptT error) the errors of two kinds:
+-- We report as proxySMPCommand error (ExceptT error) the errors of two kinds:
 -- - protocol errors from the destination relay wrapped in PRES - to simplify processing of AUTH and QUOTA errors, in this case proxy is "transparent" for such errors (PCEProtocolError, PCEUnexpectedResponse, PCEResponseError)
 -- - other response/transport/connection errors from the client connected to proxy itself
 -- Other errors are reported in the function result as `Either ProxiedRelayError ()`, including
 -- - protocol  errors from the client connected to proxy in ProxyClientError (PCEProtocolError, PCEUnexpectedResponse, PCEResponseError)
 -- - other errors from the client running on proxy and connected to relay in PREProxiedRelayError
 
-proxySMPMessage ::
+-- This function proxies Sender commands that return OK or ERR
+proxySMPCommand ::
   SMPClient ->
   -- proxy session from PKEY
   ProxiedRelay ->
   -- message to deliver
   Maybe SndPrivateAuthKey ->
   SenderId ->
-  MsgFlags ->
-  MsgBody ->
+  Command 'Sender ->
   ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v serverKey) spKey sId flags msg = do
+proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v serverKey) spKey sId command = do
   -- prepare params
   let serverThAuth = (\ta -> ta {serverPeerPubKey = serverKey}) <$> thAuth proxyThParams
       serverThParams = smpTHParamsSetVersion v proxyThParams {sessionId, thAuth = serverThAuth}
@@ -902,14 +910,14 @@ proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
   let cmdSecret = C.dh' serverKey cmdPrivKey
   nonce@(C.CbNonce corrId) <- liftIO . atomically $ C.randomCbNonce g
   -- encode
-  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender (SEND flags msg))
+  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender command)
   auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth spKey nonce tForAuth
   b <- case batchTransmissions (batch serverThParams) (blockSize serverThParams) [Right (auth, tToSend)] of
     [] -> throwE $ PCETransportError TELargeMsg
     TBError e _ : _ -> throwE $ PCETransportError e
     TBTransmission s _ : _ -> pure s
     TBTransmissions s _ _ : _ -> pure s
-  et <- liftEitherWith PCECryptoError $ EncTransmission <$> C.cbEncrypt cmdSecret nonce b paddedProxiedMsgLength
+  et <- liftEitherWith PCECryptoError $ EncTransmission <$> C.cbEncrypt cmdSecret nonce b paddedProxiedTLength
   -- proxy interaction errors are wrapped
   let tOut = Just $ 2 * tcpTimeout
   tryE (sendProtocolCommand_ c (Just nonce) tOut Nothing sessionId (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
@@ -937,8 +945,8 @@ proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
 -- sends RFWD :: EncFwdTransmission -> Command Sender
 -- receives RRES :: EncFwdResponse -> BrokerMsg
 -- proxy should send PRES to the client with EncResponse
-forwardSMPMessage :: SMPClient -> CorrId -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO EncResponse
-forwardSMPMessage c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdVersion fwdKey fwdTransmission = do
+forwardSMPTransmission :: SMPClient -> CorrId -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO EncResponse
+forwardSMPTransmission c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdVersion fwdKey fwdTransmission = do
   -- prepare params
   sessSecret <- case thAuth thParams of
     Nothing -> throwE $ PCETransportError TENoServerAuth
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index d1b3f85d6..63e3e4d98 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -43,7 +43,7 @@ module Simplex.Messaging.Protocol
   ( -- * SMP protocol parameters
     supportedSMPClientVRange,
     maxMessageLength,
-    paddedProxiedMsgLength,
+    paddedProxiedTLength,
     e2eEncConfirmationLength,
     e2eEncMessageLength,
 
@@ -258,8 +258,8 @@ maxMessageLength v
   | v >= sendingProxySMPVersion = 16064 -- max 16067
   | otherwise = 16088 -- 16064 - always use this size to determine allowed ranges
 
-paddedProxiedMsgLength :: Int
-paddedProxiedMsgLength = 16242 -- 16241 .. 16243
+paddedProxiedTLength :: Int
+paddedProxiedTLength = 16242 -- 16241 .. 16243
 
 -- TODO v6.0 change to 16064
 type MaxMessageLen = 16088
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index f673018bf..e96e8b582 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -70,7 +70,7 @@ import GHC.Stats (getRTSStats)
 import GHC.TypeLits (KnownNat)
 import Network.Socket (ServiceName, Socket, socketToHandle)
 import Simplex.Messaging.Agent.Lock
-import Simplex.Messaging.Client (ProtocolClient (thParams), ProtocolClientError (..), SMPClient, SMPClientError, forwardSMPMessage, smpProxyError, temporaryClientError)
+import Simplex.Messaging.Client (ProtocolClient (thParams), ProtocolClientError (..), SMPClient, SMPClientError, forwardSMPTransmission, smpProxyError, temporaryClientError)
 import Simplex.Messaging.Client.Agent (OwnServer, SMPClientAgent (..), SMPClientAgentEvent (..), closeSMPClientAgent, getSMPServerClient'', isOwnServer, lookupSMPServerClient, getConnectedSMPServerClient)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
@@ -742,7 +742,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             inc own pRequests
             if v >= sendingProxySMPVersion
               then forkProxiedCmd $ do
-                liftIO (runExceptT (forwardSMPMessage smp corrId fwdV pubKey encBlock) `catch` (pure . Left . PCEIOError))  >>= \case
+                liftIO (runExceptT (forwardSMPTransmission smp corrId fwdV pubKey encBlock) `catch` (pure . Left . PCEIOError))  >>= \case
                   Right r -> PRES r <$ inc own pSuccesses
                   Left e -> ERR (smpProxyError e) <$ case e of
                     PCEProtocolError {} -> inc own pSuccesses
@@ -1095,16 +1095,13 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             t :| [] -> pure $ tDecodeParseValidate clntTHParams t
             _ -> throwE BLOCK
           let clntThAuth = Just $ THAuthServer {serverPrivKey, sessSecret' = Just clientSecret}
-          -- process forwarded SEND
+          -- process forwarded command
           r <-
             lift (rejectOrVerify clntThAuth t') >>= \case
               Left r -> pure r
-              Right t''@(_, (corrId', entId', cmd')) -> case cmd' of
-                Cmd SSender SEND {} ->
-                  -- Left will not be returned by processCommand, as only SEND command is allowed
-                  fromMaybe (corrId', entId', ERR INTERNAL) <$> lift (processCommand t'')
-                _ ->
-                  pure (corrId', entId', ERR $ CMD PROHIBITED)
+              -- rejectOrVerify filters allowed commands, no need to repeat it here.
+              -- INTERNAL is used because processCommand never returns Nothing for sender commands (could be extracted for better types).
+              Right t''@(_, (corrId', entId', _)) -> fromMaybe (corrId', entId', ERR INTERNAL) <$> lift (processCommand t'')
           -- encode response
           r' <- case batchTransmissions (batch clntTHParams) (blockSize clntTHParams) [Right (Nothing, encodeTransmission clntTHParams r)] of
             [] -> throwE INTERNAL -- at least 1 item is guaranteed from NonEmpty/Right
@@ -1112,7 +1109,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             TBTransmission b' _ : _ -> pure b'
             TBTransmissions b' _ _ : _ -> pure b'
           -- encrypt to client
-          r2 <- liftEitherWith (const BLOCK) $ EncResponse <$> C.cbEncrypt clientSecret (C.reverseNonce clientNonce) r' paddedProxiedMsgLength
+          r2 <- liftEitherWith (const BLOCK) $ EncResponse <$> C.cbEncrypt clientSecret (C.reverseNonce clientNonce) r' paddedProxiedTLength
           -- encrypt to proxy
           let fr = FwdResponse {fwdCorrId, fwdResponse = r2}
               r3 = EncFwdResponse $ C.cbEncryptNoPad sessSecret (C.reverseNonce proxyNonce) (smpEncode fr)
@@ -1124,13 +1121,17 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             rejectOrVerify clntThAuth (tAuth, authorized, (corrId', entId', cmdOrError)) =
               case cmdOrError of
                 Left e -> pure $ Left (corrId', entId', ERR e)
-                Right cmd'@(Cmd SSender SEND {}) -> verified <$> verifyTransmission ((,C.cbNonce (bs corrId')) <$> clntThAuth) tAuth authorized entId' cmd'
+                Right cmd'
+                  | allowed -> verified <$> verifyTransmission ((,C.cbNonce (bs corrId')) <$> clntThAuth) tAuth authorized entId' cmd'
+                  | otherwise -> pure $ Left (corrId', entId', ERR $ CMD PROHIBITED)
                   where
+                    allowed = case cmd' of
+                      Cmd SSender SEND {} -> True
+                      Cmd SSender (SKEY _) -> True
+                      _ -> False
                     verified = \case
                       VRVerified qr -> Right (qr, (corrId', entId', cmd'))
                       VRFailed -> Left (corrId', entId', ERR AUTH)
-                Right _ -> pure $ Left (corrId', entId', ERR $ CMD PROHIBITED)
-
         deliverMessage :: T.Text -> QueueRec -> RecipientId -> TVar Sub -> MsgQueue -> Maybe Message -> M (Transmission BrokerMsg)
         deliverMessage name qr rId sub q msg_ = time (name <> " deliver") $ do
           readTVarIO sub >>= \case

From 26cfad5e88772a58e10efa43ac58bfb584977497 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 1 Jul 2024 13:42:46 +0100
Subject: [PATCH 019/195] do not use sndSecure when rotating queue (#1213)

---
 src/Simplex/Messaging/Agent.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index c6942af8f..63f59a9c5 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1565,14 +1565,13 @@ switchConnection' c connId =
       _ -> throwE $ CMD PROHIBITED "switchConnection: not duplex"
 
 switchDuplexConnection :: AgentClient -> Connection 'CDuplex -> RcvQueue -> AM ConnectionStats
-switchDuplexConnection c (DuplexConnection cData@ConnData {connId, userId, connAgentVersion} rqs sqs) rq@RcvQueue {server, dbQueueId = DBQueueId dbQueueId, sndId} = do
+switchDuplexConnection c (DuplexConnection cData@ConnData {connId, userId} rqs sqs) rq@RcvQueue {server, dbQueueId = DBQueueId dbQueueId, sndId} = do
   checkRQSwchStatus rq RSSwitchStarted
   clientVRange <- asks $ smpClientVRange . config
   -- try to get the server that is different from all queues, or at least from the primary rcv queue
   srvAuth@(ProtoServerWithAuth srv _) <- getNextServer c userId $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
   srv' <- if srv == server then getNextServer c userId [server] else pure srvAuth
-  let sndSecure = connAgentVersion >= sndAuthKeySMPAgentVersion
-  (q, qUri, tSess, sessId) <- newRcvQueue c userId connId srv' clientVRange SMSubscribe sndSecure
+  (q, qUri, tSess, sessId) <- newRcvQueue c userId connId srv' clientVRange SMSubscribe False
   let rq' = (q :: NewRcvQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
   rq'' <- withStore c $ \db -> addConnRcvQueue db connId rq'
   lift $ addNewQueueSubscription c rq'' tSess sessId

From a50e2e74a587fa5363251a4614a1f3c0730dc390 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 2 Jul 2024 00:06:38 +0400
Subject: [PATCH 020/195] agent: disable saving stats (#1214)

* agent: disable stat saving

* disable migration

* schema

* disable restore
---
 src/Simplex/Messaging/Agent.hs                | 21 ++++++++++---------
 .../Agent/Store/SQLite/Migrations.hs          |  4 ++--
 .../Store/SQLite/Migrations/agent_schema.sql  |  7 -------
 3 files changed, 13 insertions(+), 19 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index c4f62702e..72b7bcb7b 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -210,14 +210,14 @@ getSMPAgentClient_ clientId cfg initServers store backgroundMode =
     runAgentThreads c
       | backgroundMode = run c "subscriber" $ subscriber c
       | otherwise = do
-          restoreServersStats c
+          -- restoreServersStats c
           raceAny_
             [ run c "subscriber" $ subscriber c,
               run c "runNtfSupervisor" $ runNtfSupervisor c,
-              run c "cleanupManager" $ cleanupManager c,
-              run c "logServersStats" $ logServersStats c
+              run c "cleanupManager" $ cleanupManager c
+              -- run c "logServersStats" $ logServersStats c
             ]
-            `E.finally` saveServersStats c
+            -- `E.finally` saveServersStats c
     run AgentClient {subQ, acThread} name a =
       a `E.catchAny` \e -> whenM (isJust <$> readTVarIO acThread) $ do
         logError $ "Agent thread " <> name <> " crashed: " <> tshow e
@@ -234,12 +234,13 @@ logServersStats c = do
 
 saveServersStats :: AgentClient -> AM' ()
 saveServersStats c@AgentClient {subQ, smpServersStats, xftpServersStats} = do
-  sss <- mapM (lift . getAgentSMPServerStats) =<< readTVarIO smpServersStats
-  xss <- mapM (lift . getAgentXFTPServerStats) =<< readTVarIO xftpServersStats
-  let stats = AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss}
-  tryAgentError' (withStore' c (`updateServersStats` stats)) >>= \case
-    Left e -> atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
-    Right () -> pure ()
+  -- sss <- mapM (lift . getAgentSMPServerStats) =<< readTVarIO smpServersStats
+  -- xss <- mapM (lift . getAgentXFTPServerStats) =<< readTVarIO xftpServersStats
+  -- let stats = AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss}
+  -- tryAgentError' (withStore' c (`updateServersStats` stats)) >>= \case
+  --   Left e -> atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
+  --   Right () -> pure ()
+  pure ()
 
 restoreServersStats :: AgentClient -> AM' ()
 restoreServersStats c@AgentClient {smpServersStats, xftpServersStats, srvStatsStartedAt} = do
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
index 340063f5c..9dd10d1b6 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
@@ -113,8 +113,8 @@ schemaMigrations =
     ("m20240124_file_redirect", m20240124_file_redirect, Just down_m20240124_file_redirect),
     ("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
     ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
-    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
-    ("m20240518_servers_stats", m20240518_servers_stats, Just down_m20240518_servers_stats)
+    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays)
+    -- ("m20240518_servers_stats", m20240518_servers_stats, Just down_m20240518_servers_stats)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
index 50cf6d74a..caf94418a 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
@@ -394,13 +394,6 @@ CREATE TABLE processed_ratchet_key_hashes(
   created_at TEXT NOT NULL DEFAULT(datetime('now')),
   updated_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
-CREATE TABLE servers_stats(
-  servers_stats_id INTEGER PRIMARY KEY,
-  servers_stats TEXT,
-  started_at TEXT NOT NULL DEFAULT(datetime('now')),
-  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);

From da5f6691336e90feffd6c0043b70a2f477d1cc7f Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 1 Jul 2024 23:34:31 +0100
Subject: [PATCH 021/195] remove diagram

---
 .../duplex-messaging/duplex-creating-v6.mmd   | 63 -------------------
 1 file changed, 63 deletions(-)
 delete mode 100644 protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd

diff --git a/protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd b/protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd
deleted file mode 100644
index 183e4bfa9..000000000
--- a/protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd
+++ /dev/null
@@ -1,63 +0,0 @@
-sequenceDiagram
-  participant A as Alice
-  participant AA as Alice's<br>agent
-  participant AS as Alice's<br>server
-  participant BS as Bob's<br>server
-  participant BA as Bob's<br>agent
-  participant B as Bob
-
-  note over AA, BA: status (receive/send): NONE/NONE
-
-  note over A, AA: 1. request connection<br>from agent
-  A ->> AA: NEW: create<br>duplex connection
- 
-  note over AA, AS: 2. create Alice's SMP queue
-  AA ->> AS: NEW: create SMP queue
-  AS ->> AA: IDS: SMP queue IDs
-  note over AA: status: NEW/NONE
-
-  AA ->> A: INV: invitation<br>to connect
-
-  note over A, B: 3. out-of-band invitation
-  A ->> B: OOB: invitation to connect
-
-  note over BA, B: 4. accept connection
-  B ->> BA: JOIN:<br>via invitation info
-  note over BA: status: NONE/NEW
-
-  note over BA, AS: 5. secure Alice's SMP queue
-  BA ->> AS: SKEY: secure queue (this command needs to be proxied)
-  note over BA: status: NONE/SECURED
-
-  note over BA, BS: 6. create Bob's SMP queue
-  BA ->> BS: NEW: create SMP queue
-  BS ->> BA: IDS: SMP queue IDs
-  note over BA: status: NEW/SECURED
-
-  note over BA, AA: 7. confirm Alice's SMP queue
-  BA ->> AS: SEND: Bob's info without sender's key (SMP confirmation with reply queues)
-  note over BA: status: NEW/CONFIRMED
-
-  AS ->> AA: MSG: Bob's info without<br>sender server key
-  note over AA: status: CONFIRMED/NEW
-  AA ->> AS: ACK: confirm message
-
-  note over AA, BS: 8. secure Bob's SMP queue
-  AA ->> BS: SKEY: secure queue (this command needs to be proxied)
-  note over BA: status: CONFIRMED/SECURED
-
-  AA ->> BS: SEND: Alice's info without sender's server key (SMP confirmation without reply queues)
-  note over AA: status: CONFIRMED/CONFIRMED
-
-  note over AA, A: 9. notify Alice<br>about connection success<br>(no HELLO needed in v6)
-  AA ->> A: CON: connected
-  note over AA: status: ACTIVE/ACTIVE
-
-  BS ->> BA: MSG: Alice's info without<br>sender's server key
-  note over BA: status: CONFIRMED/CONFIRMED
-  BA ->> B: INFO: Alice's info
-  BA ->> BS: ACK: confirm message
-
-  note over BA, B: 10. notify Bob<br>about connection success
-  BA ->> B: CON: connected
-  note over BA: status: ACTIVE/ACTIVE

From aa1d8d6c8bcff82f02aa580b1b729fc4b1396fd9 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 2 Jul 2024 13:40:37 +0100
Subject: [PATCH 022/195] agent: disable fast handshake (#1215)

---
 src/Simplex/Messaging/Agent.hs         |   4 +-
 tests/AgentTests/FunctionalAPITests.hs | 110 ++++++++++++-------------
 tests/AgentTests/NotificationTests.hs  |  14 ++--
 tests/SMPProxyTests.hs                 |  18 ++--
 4 files changed, 73 insertions(+), 73 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 29ea05ead..32bfa4198 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -739,7 +739,7 @@ newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv
     (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv"
     _ -> pure ()
   AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
-  let sndSecure = case cMode of SCMInvitation -> True; SCMContact -> False
+  let sndSecure = False -- case cMode of SCMInvitation -> True; SCMContact -> False
   (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srvWithAuth smpClientVRange subMode sndSecure `catchAgentError` \e -> liftIO (print e) >> throwE e
   atomically $ incSMPServerStat c userId srv connCreated
   rq' <- withStore c $ \db -> updateNewConnRcv db connId rq
@@ -883,7 +883,7 @@ joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode
 
 createReplyQueue :: AgentClient -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo
 createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVersion} subMode srv = do
-  let sndSecure = smpClientVersion >= sndAuthKeySMPClientVersion
+  let sndSecure = False -- smpClientVersion >= sndAuthKeySMPClientVersion
   (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv (versionToRange smpClientVersion) subMode sndSecure
   let qInfo = toVersionT qUri smpClientVersion
   rq' <- withStore c $ \db -> upgradeSndConnToDuplex db connId rq
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index b06cc9194..19f4977fc 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -257,11 +257,11 @@ functionalAPITests :: ATransport -> Spec
 functionalAPITests t = do
   describe "Establishing duplex connection" $ do
     testMatrix2 t runAgentClientTest
-    it "should connect when server with multiple identities is stored" $
+    xit "should connect when server with multiple identities is stored" $
       withSmpServer t testServerMultipleIdentities
-    it "should connect with two peers" $
+    xit "should connect with two peers" $
       withSmpServer t testAgentClient3
-    it "should establish connection without PQ encryption and enable it" $
+    xit "should establish connection without PQ encryption and enable it" $
       withSmpServer t testEnablePQEncryption
   describe "Establishing duplex connection, different PQ settings" $ do
     testPQMatrix2 t $ runAgentClientTestPQ True
@@ -290,43 +290,43 @@ functionalAPITests t = do
       testAllowConnectionClientRestart t
   describe "Message delivery" $ do
     describe "update connection agent version on received messages" $ do
-      it "should increase if compatible, shouldn't decrease" $
+      xit "should increase if compatible, shouldn't decrease" $
         testIncreaseConnAgentVersion t
-      it "should increase to max compatible version" $
+      xit "should increase to max compatible version" $
         testIncreaseConnAgentVersionMaxCompatible t
-      it "should increase when connection was negotiated on different versions" $
+      xit "should increase when connection was negotiated on different versions" $
         testIncreaseConnAgentVersionStartDifferentVersion t
     -- TODO PQ tests for upgrading connection to PQ encryption
-    it "should deliver message after client restart" $
+    xit "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)" $
+    xit "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" $
+    xit "should report error via msg integrity on skipped messages" $
       testSkippedMessages t
-    it "should connect to the server when server goes up if it initially was down" $
+    xit "should connect to the server when server goes up if it initially was down" $
       testDeliveryAfterSubscriptionError t
-    it "should deliver messages if one of connections has quota exceeded" $
+    xit "should deliver messages if one of connections has quota exceeded" $
       testMsgDeliveryQuotaExceeded t
     describe "message expiration" $ do
-      it "should expire one message" $ testExpireMessage t
-      it "should expire multiple messages" $ testExpireManyMessages t
-      it "should expire one message if quota is exceeded" $ testExpireMessageQuota t
-      it "should expire multiple messages if quota is exceeded" $ testExpireManyMessagesQuota t
+      xit "should expire one message" $ testExpireMessage t
+      xit "should expire multiple messages" $ testExpireManyMessages t
+      xit "should expire one message if quota is exceeded" $ testExpireMessageQuota t
+      xit "should expire multiple messages if quota is exceeded" $ testExpireManyMessagesQuota t
     describe "Ratchet synchronization" $ do
-      it "should report ratchet de-synchronization, synchronize ratchets" $
+      xit "should report ratchet de-synchronization, synchronize ratchets" $
         testRatchetSync t
-      it "should synchronize ratchets after server being offline" $
+      xit "should synchronize ratchets after server being offline" $
         testRatchetSyncServerOffline t
-      it "should synchronize ratchets after client restart" $
+      xit "should synchronize ratchets after client restart" $
         testRatchetSyncClientRestart t
-      it "should synchronize ratchets after suspend/foreground" $
+      xit "should synchronize ratchets after suspend/foreground" $
         testRatchetSyncSuspendForeground t
-      it "should synchronize ratchets when clients start synchronization simultaneously" $
+      xit "should synchronize ratchets when clients start synchronization simultaneously" $
         testRatchetSyncSimultaneous t
     describe "Subscription mode OnlyCreate" $ do
       it "messages delivered only when polled (v8 - slow handshake)" $
         withSmpServer t testOnlyCreatePullSlowHandshake
-      it "messages delivered only when polled" $
+      xit "messages delivered only when polled" $
         withSmpServer t testOnlyCreatePull
   describe "Inactive client disconnection" $ do
     it "should disconnect clients without subs if they were inactive longer than TTL" $
@@ -336,14 +336,14 @@ functionalAPITests t = do
     it "should NOT disconnect active clients" $
       testActiveClientNotDisconnected t
   describe "Suspending agent" $ do
-    it "should update client when agent is suspended" $
+    xit "should update client when agent is suspended" $
       withSmpServer t testSuspendingAgent
-    it "should complete sending messages when agent is suspended" $
+    xit "should complete sending messages when agent is suspended" $
       testSuspendingAgentCompleteSending t
-    it "should suspend agent on timeout, even if pending messages not sent" $
+    xit "should suspend agent on timeout, even if pending messages not sent" $
       testSuspendingAgentTimeout t
   describe "Batching SMP commands" $ do
-    it "should subscribe to multiple (200) subscriptions with batching" $
+    xit "should subscribe to multiple (200) subscriptions with batching" $
       testBatchedSubscriptions 200 10 t
     skip "faster version of the previous test (200 subscriptions gets very slow with test coverage)" $
       it "should subscribe to multiple (6) subscriptions with batching" $
@@ -362,7 +362,7 @@ functionalAPITests t = do
       testDeleteConnectionAsync t
     it "join connection when reply queue creation fails (v8 - slow handshake)" $
       testJoinConnectionAsyncReplyErrorV8 t
-    it "join connection when reply queue creation fails" $
+    xit "join connection when reply queue creation fails" $
       testJoinConnectionAsyncReplyError t
     describe "delete connection waiting for delivery" $ do
       it "should delete connection immediately if there are no pending messages" $
@@ -376,34 +376,34 @@ functionalAPITests t = do
       it "should delete connection by timeout, message in progress can be delivered" $
         testWaitDeliveryTimeout2 t
   describe "Users" $ do
-    it "should create and delete user with connections" $
+    xit "should create and delete user with connections" $
       withSmpServer t testUsers
-    it "should create and delete user without connections" $
+    xit "should create and delete user without connections" $
       withSmpServer t testDeleteUserQuietly
-    it "should create and delete user with connections when server connection fails" $
+    xit "should create and delete user with connections when server connection fails" $
       testUsersNoServer t
-    it "should connect two users and switch session mode" $
+    xit "should connect two users and switch session mode" $
       withSmpServer t testTwoUsers
   describe "Connection switch" $ do
-    describe "should switch delivery to the new queue" $
+    xdescribe "should switch delivery to the new queue" $
       testServerMatrix2 t testSwitchConnection
-    describe "should switch to new queue asynchronously" $
+    xdescribe "should switch to new queue asynchronously" $
       testServerMatrix2 t testSwitchAsync
     describe "should delete connection during switch" $
       testServerMatrix2 t testSwitchDelete
-    describe "should abort switch in Started phase" $
+    xdescribe "should abort switch in Started phase" $
       testServerMatrix2 t testAbortSwitchStarted
-    describe "should abort switch in Started phase, reinitiate immediately" $
+    xdescribe "should abort switch in Started phase, reinitiate immediately" $
       testServerMatrix2 t testAbortSwitchStartedReinitiate
-    describe "should prohibit to abort switch in Secured phase" $
+    xdescribe "should prohibit to abort switch in Secured phase" $
       testServerMatrix2 t testCannotAbortSwitchSecured
-    describe "should switch two connections simultaneously" $
+    xdescribe "should switch two connections simultaneously" $
       testServerMatrix2 t testSwitch2Connections
-    describe "should switch two connections simultaneously, abort one" $
+    xdescribe "should switch two connections simultaneously, abort one" $
       testServerMatrix2 t testSwitch2ConnectionsAbort1
   describe "SMP basic auth" $ do
     let v4 = prevVersion basicAuthSMPVersion
-    forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, currentServerSMPRelayVersion]) $ \v -> do
+    forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, prevVersion currentServerSMPRelayVersion]) $ \v -> do
       let baseId = if v >= sndAuthKeySMPVersion then 1 else 3
       describe ("v" <> show v <> ": with server auth") $ do
         --                                       allow NEW | server auth, v | clnt1 auth, v  | clnt2 auth, v    |  2 - success, 1 - JOIN fail, 0 - NEW fail
@@ -444,15 +444,15 @@ functionalAPITests t = do
     it "should return the same data for both peers" $
       withSmpServer t testRatchetAdHash
   describe "Delivery receipts" $ do
-    it "should send and receive delivery receipt" $ withSmpServer t testDeliveryReceipts
-    it "should send delivery receipt only in connection v3+" $ testDeliveryReceiptsVersion t
+    xit "should send and receive delivery receipt" $ withSmpServer t testDeliveryReceipts
+    xit "should send delivery receipt only in connection v3+" $ testDeliveryReceiptsVersion t
     it "send delivery receipts concurrently with messages" $ testDeliveryReceiptsConcurrent t
   describe "user network info" $ do
     it "should wait for user network" testWaitForUserNetwork
     it "should not reset online to offline if happens too quickly" testDoNotResetOnlineToOffline
     it "should resume multiple threads" testResumeMultipleThreads
   describe "SMP queue info" $ do
-    it "server should respond with queue and subscription information" $
+    xit "server should respond with queue and subscription information" $
       withSmpServer t testServerQueueInfo
 
 testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> AgentMsgId -> IO Int
@@ -475,28 +475,28 @@ canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =
 
 testMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2 t runTest = do
-  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
+  xit "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
   it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
-  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
+  xit "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
   it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 $ runTest PQSupportOff False
   it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff False
   it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff False
 
 testBasicMatrix2 :: HasCallStack => ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testBasicMatrix2 t runTest = do
-  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest
+  xit "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest
   it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 3 $ runTest
   it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfg 3 $ runTest
   it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrevPQ 3 $ runTest
 
 testRatchetMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testRatchetMatrix2 t runTest = do
-  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
+  xit "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
   it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
-  it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
-  it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
-  it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff False
-  it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
+  xit "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
+  xit "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
+  xit "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff False
+  xit "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
 
 testServerMatrix2 :: HasCallStack => ATransport -> (InitialAgentServers -> IO ()) -> Spec
 testServerMatrix2 t runTest = do
@@ -1947,7 +1947,7 @@ testWaitDeliveryNoPending t = withAgentClients2 $ \alice bob ->
     liftIO $ noMessages alice "nothing else should be delivered to alice"
     liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 1
+    baseId = 3
     msgId = subtract baseId
 
 testWaitDelivery :: ATransport -> IO ()
@@ -2001,7 +2001,7 @@ testWaitDelivery t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 1
+    baseId = 3
     msgId = subtract baseId
 
 testWaitDeliveryAUTHErr :: ATransport -> IO ()
@@ -2044,7 +2044,7 @@ testWaitDeliveryAUTHErr t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 1
+    baseId = 3
     msgId = subtract baseId
 
 testWaitDeliveryTimeout :: ATransport -> IO ()
@@ -2084,7 +2084,7 @@ testWaitDeliveryTimeout t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 1
+    baseId = 3
     msgId = subtract baseId
 
 testWaitDeliveryTimeout2 :: ATransport -> IO ()
@@ -2130,7 +2130,7 @@ testWaitDeliveryTimeout2 t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 1
+    baseId = 3
     msgId = subtract baseId
 
 testJoinConnectionAsyncReplyErrorV8 :: HasCallStack => ATransport -> IO ()
@@ -3087,7 +3087,7 @@ exchangeGreetings :: HasCallStack => AgentClient -> ConnId -> AgentClient -> Con
 exchangeGreetings = exchangeGreetings_ PQEncOn
 
 exchangeGreetings_ :: HasCallStack => PQEncryption -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
-exchangeGreetings_ pqEnc = exchangeGreetingsMsgId_ pqEnc 2
+exchangeGreetings_ pqEnc = exchangeGreetingsMsgId_ pqEnc 4
 
 exchangeGreetingsMsgId :: HasCallStack => Int64 -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 exchangeGreetingsMsgId = exchangeGreetingsMsgId_ PQEncOn
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index ab9d8453c..603ffd3c0 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -105,7 +105,7 @@ notificationTests t = do
   describe "Managing notification subscriptions" $ do
     describe "should create notification subscription for existing connection" $
       testNtfMatrix t testNotificationSubscriptionExistingConnection
-    describe "should create notification subscription for new connection" $
+    xdescribe "should create notification subscription for new connection" $
       testNtfMatrix t testNotificationSubscriptionNewConnection
     it "should change notifications mode" $
       withSmpServer t $
@@ -116,19 +116,19 @@ notificationTests t = do
         withAPNSMockServer $ \apns ->
           withNtfServer t $ testChangeToken apns
   describe "Notifications server store log" $
-    it "should save and restore tokens and subscriptions" $
+    xit "should save and restore tokens and subscriptions" $
       withSmpServer t $
         withAPNSMockServer $ \apns ->
           testNotificationsStoreLog t apns
   describe "Notifications after SMP server restart" $
-    it "should resume subscriptions after SMP server is restarted" $
+    xit "should resume subscriptions after SMP server is restarted" $
       withAPNSMockServer $ \apns ->
         withNtfServer t $ testNotificationsSMPRestart t apns
   describe "Notifications after SMP server restart" $
     it "should resume batched subscriptions after SMP server is restarted" $
       withAPNSMockServer $ \apns ->
         withNtfServer t $ testNotificationsSMPRestartBatch 100 t apns
-  describe "should switch notifications to the new queue" $
+  xdescribe "should switch notifications to the new queue" $
     testServerMatrix2 t $ \servers ->
       withAPNSMockServer $ \apns ->
         withNtfServer t $ testSwitchNotifications servers apns
@@ -146,7 +146,7 @@ notificationTests t = do
 testNtfMatrix :: HasCallStack => ATransport -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> Spec
 testNtfMatrix t runTest = do
   describe "next and current" $ do
-    it "curr servers; curr clients" $ runNtfTestCfg t 1 cfg ntfServerCfg agentCfg agentCfg runTest
+    xit "curr servers; curr clients" $ runNtfTestCfg t 1 cfg ntfServerCfg agentCfg agentCfg runTest
     it "curr servers; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
     it "prev servers; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
     it "prev servers; curr clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest
@@ -515,7 +515,7 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
     -- no notifications should follow
     noNotification apnsQ
   where
-    baseId = 1
+    baseId = 3
     msgId = subtract baseId
 
 testChangeToken :: APNSMockServer -> IO ()
@@ -554,7 +554,7 @@ testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers t
     -- no notifications should follow
     noNotification apnsQ
   where
-    baseId = 1
+    baseId = 3
     msgId = subtract baseId
 
 testNotificationsStoreLog :: ATransport -> APNSMockServer -> IO ()
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 6452d2677..e05ff884d 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -101,26 +101,26 @@ smpProxyTests = do
         it "500x20" . twoServersFirstProxy $ 500 `inParrallel` deliver 20
     describe "agent API" $ do
       describe "one server" $ do
-        it "always via proxy" . oneServer $
+        xit "always via proxy" . oneServer $
           agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv1], SPMAlways, True) C.SEd448 "hello 1" "hello 2" 1
-        it "without proxy" . oneServer $
+        xit "without proxy" . oneServer $
           agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv1], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
       describe "two servers" $ do
-        it "always via proxy" . twoServers $
+        xit "always via proxy" . twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv2], SPMAlways, True) C.SEd448 "hello 1" "hello 2" 1
-        it "both via proxy" . twoServers $
+        xit "both via proxy" . twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMUnknown, True) C.SEd448 "hello 1" "hello 2" 1
-        it "first via proxy" . twoServers $
+        xit "first via proxy" . twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
-        it "without proxy" . twoServers $
+        xit "without proxy" . twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
-        it "first via proxy for unknown" . twoServers $
+        xit "first via proxy for unknown" . twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv1, srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2" 1
         it "without proxy with fallback" . twoServers_ proxyCfg cfgV7 $
           agentDeliverMessageViaProxy ([srv1], SPMUnknown, False) ([srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2" 3
         it "fails when fallback is prohibited" . twoServers_ proxyCfg cfgV7 $
           agentViaProxyVersionError
-        it "retries sending when destination or proxy relay is offline" $
+        xit "retries sending when destination or proxy relay is offline" $
           agentViaProxyRetryOffline
       describe "stress test 1k" $ do
         let deliver nAgents nMsgs = agentDeliverMessagesViaProxyConc (replicate nAgents [srv1]) (map bshow [1 :: Int .. nMsgs])
@@ -370,7 +370,7 @@ agentViaProxyRetryOffline = do
     a `up` cId = nGet a =##> \case ("", "", UP _ [c]) -> c == cId; _ -> False
     a `down` cId = nGet a =##> \case ("", "", DOWN _ [c]) -> c == cId; _ -> False
     aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
-    baseId = 1
+    baseId = 3
     msgId = subtract baseId . fst
     servers srv = (initAgentServersProxy SPMAlways SPFProhibit) {smp = userServers $ L.map noAuthSrv [srv]}
 

From f392ce0a9355cd3883400906ae6c361b77ca46ea Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 2 Jul 2024 13:55:28 +0100
Subject: [PATCH 023/195] 5.8.2.0

---
 CHANGELOG.md    | 10 ++++++++++
 package.yaml    |  2 +-
 simplexmq.cabal |  2 +-
 3 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 707a6ff5f..90706a19e 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,13 @@
+# 5.8.2
+
+Agent:
+- fast handshake support (disabled).
+- new statistics api.
+
+SMP server:
+- fast handshake support (SKEY command).
+- minor changes to reduce memory usage.
+
 # 5.8.1
 
 Agent:
diff --git a/package.yaml b/package.yaml
index 16e75c866..94c2b6db0 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 5.8.1.0
+version: 5.8.2.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index d46b58dc2..d1fa32d43 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        5.8.1.0
+version:        5.8.2.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From ae8e1c5e9aa3155907f1bd075e9c69af5fce2bee Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Wed, 3 Jul 2024 15:36:15 +0400
Subject: [PATCH 024/195] agent: servers stats improvements, fixes (#1208)

* agent: reset stats startedAt time in memory

* getAgentSubsSummary

* change sub counting

* ack statistics

* add import

* instance

* Revert "instance"

This reverts commit 1f63740d565d43d033558ee62cfb5a8c2fe4575d.

* Revert "add import"

This reverts commit ef72df80144044a0c1eefa1bffab2fd01d0851b4.

* modify sub counting

* modify conn creation counting

* use int64

* file size stats

* remove import

* ack err counting

* conn del stats

* format

* new data

* add data

* toKB

* restore connCompleted

* use Int for counts

* use rq from scope

* remove getAgentSubsSummary

* fix connCompleted

* fix

* revert disabling stats

* use srv from scope

* combine ack stats

* modify

* comment

* count subs

* refactor

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
---
 simplexmq.cabal                               |   2 +-
 src/Simplex/FileTransfer/Agent.hs             |   8 +-
 src/Simplex/FileTransfer/Chunks.hs            |   4 +
 src/Simplex/Messaging/Agent.hs                |  76 +++++---
 src/Simplex/Messaging/Agent/Client.hs         |  48 +++--
 src/Simplex/Messaging/Agent/Stats.hs          | 182 +++++++++++++++++-
 src/Simplex/Messaging/Agent/Store.hs          |   6 +
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |   7 +-
 .../Agent/Store/SQLite/Migrations.hs          |   4 +-
 ...rs_stats.hs => M20240702_servers_stats.hs} |  10 +-
 .../Store/SQLite/Migrations/agent_schema.sql  |   7 +
 11 files changed, 295 insertions(+), 59 deletions(-)
 rename src/Simplex/Messaging/Agent/Store/SQLite/Migrations/{M20240518_servers_stats.hs => M20240702_servers_stats.hs} (79%)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index d1fa32d43..aec362196 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -133,8 +133,8 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
-      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240518_servers_stats
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
       Simplex.Messaging.Agent.TRcvQueues
       Simplex.Messaging.Client
       Simplex.Messaging.Client.Agent
diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 90dda5cbc..4683143c5 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -49,6 +49,7 @@ import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Format (defaultTimeLocale, formatTime)
+import Simplex.FileTransfer.Chunks (toKB)
 import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
 import Simplex.FileTransfer.Client.Main
 import Simplex.FileTransfer.Crypto
@@ -206,7 +207,8 @@ runXFTPRcvWorker c srv Worker {doWork} = do
       unlessM ((approvedRelays ||) <$> ipAddressProtected') $ throwE $ FILE NOT_APPROVED
       fsFileTmpPath <- lift $ toFSFilePath fileTmpPath
       chunkPath <- uniqueCombine fsFileTmpPath $ show chunkNo
-      let chunkSpec = XFTPRcvChunkSpec chunkPath (unFileSize chunkSize) (unFileDigest digest)
+      let chSize = unFileSize chunkSize
+          chunkSpec = XFTPRcvChunkSpec chunkPath chSize (unFileDigest digest)
           relChunkPath = fileTmpPath </> takeFileName chunkPath
       agentXFTPDownloadChunk c userId digest replica chunkSpec
       atomically $ waitUntilForeground c
@@ -221,6 +223,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
         liftIO . when complete $ updateRcvFileStatus db rcvFileId RFSReceived
         pure (entityId, complete, RFPROG rcvd total)
       atomically $ incXFTPServerStat c userId srv downloads
+      atomically $ incXFTPServerSizeStat c userId srv downloadsSize (fromIntegral $ toKB chSize)
       notify c entityId progress
       when complete . lift . void $
         getXFTPRcvWorker True c Nothing
@@ -506,7 +509,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
               atomically $ incXFTPServerStat c userId srv uploadErrs
               sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) e
     uploadFileChunk :: AgentConfig -> SndFileChunk -> SndFileChunkReplica -> AM ()
-    uploadFileChunk AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients} sndFileChunk@SndFileChunk {sndFileId, userId, chunkSpec = chunkSpec@XFTPChunkSpec {filePath}, digest = chunkDigest} replica = do
+    uploadFileChunk AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients} sndFileChunk@SndFileChunk {sndFileId, userId, chunkSpec = chunkSpec@XFTPChunkSpec {filePath, chunkSize = chSize}, digest = chunkDigest} replica = do
       replica'@SndFileChunkReplica {sndChunkReplicaId} <- addRecipients sndFileChunk replica
       fsFilePath <- lift $ toFSFilePath filePath
       unlessM (doesFileExist fsFilePath) $ throwE $ FILE NO_FILE
@@ -521,6 +524,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
           total = totalSize chunks
           complete = all chunkUploaded chunks
       atomically $ incXFTPServerStat c userId srv uploads
+      atomically $ incXFTPServerSizeStat c userId srv uploadsSize (fromIntegral $ toKB chSize)
       notify c sndFileEntityId $ SFPROG uploaded total
       when complete $ do
         (sndDescr, rcvDescrs) <- sndFileToDescrs sf
diff --git a/src/Simplex/FileTransfer/Chunks.hs b/src/Simplex/FileTransfer/Chunks.hs
index 0b35649c5..d8890944d 100644
--- a/src/Simplex/FileTransfer/Chunks.hs
+++ b/src/Simplex/FileTransfer/Chunks.hs
@@ -26,6 +26,10 @@ kb :: Integral a => a -> a
 kb n = 1024 * n
 {-# INLINE kb #-}
 
+toKB :: Integral a => a -> a
+toKB n = n `div` 1024
+{-# INLINE toKB #-}
+
 mb :: Integral a => a -> a
 mb n = 1024 * kb n
 {-# INLINE mb #-}
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 32bfa4198..480c8f801 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -157,6 +157,7 @@ import Simplex.Messaging.Agent.NtfSubSupervisor
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Stats
+import Simplex.Messaging.Agent.Stats (AgentSMPServerStats (connSubErrs))
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
@@ -210,14 +211,14 @@ getSMPAgentClient_ clientId cfg initServers store backgroundMode =
     runAgentThreads c
       | backgroundMode = run c "subscriber" $ subscriber c
       | otherwise = do
-          -- restoreServersStats c
+          restoreServersStats c
           raceAny_
             [ run c "subscriber" $ subscriber c,
               run c "runNtfSupervisor" $ runNtfSupervisor c,
-              run c "cleanupManager" $ cleanupManager c
-              -- run c "logServersStats" $ logServersStats c
+              run c "cleanupManager" $ cleanupManager c,
+              run c "logServersStats" $ logServersStats c
             ]
-            -- `E.finally` saveServersStats c
+            `E.finally` saveServersStats c
     run AgentClient {subQ, acThread} name a =
       a `E.catchAny` \e -> whenM (isJust <$> readTVarIO acThread) $ do
         logError $ "Agent thread " <> name <> " crashed: " <> tshow e
@@ -234,13 +235,12 @@ logServersStats c = do
 
 saveServersStats :: AgentClient -> AM' ()
 saveServersStats c@AgentClient {subQ, smpServersStats, xftpServersStats} = do
-  -- sss <- mapM (lift . getAgentSMPServerStats) =<< readTVarIO smpServersStats
-  -- xss <- mapM (lift . getAgentXFTPServerStats) =<< readTVarIO xftpServersStats
-  -- let stats = AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss}
-  -- tryAgentError' (withStore' c (`updateServersStats` stats)) >>= \case
-  --   Left e -> atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
-  --   Right () -> pure ()
-  pure ()
+  sss <- mapM (lift . getAgentSMPServerStats) =<< readTVarIO smpServersStats
+  xss <- mapM (lift . getAgentXFTPServerStats) =<< readTVarIO xftpServersStats
+  let stats = AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss}
+  tryAgentError' (withStore' c (`updateServersStats` stats)) >>= \case
+    Left e -> atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
+    Right () -> pure ()
 
 restoreServersStats :: AgentClient -> AM' ()
 restoreServersStats c@AgentClient {smpServersStats, xftpServersStats, srvStatsStartedAt} = do
@@ -885,6 +885,7 @@ createReplyQueue :: AgentClient -> ConnData -> SndQueue -> SubscriptionMode -> S
 createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVersion} subMode srv = do
   let sndSecure = False -- smpClientVersion >= sndAuthKeySMPClientVersion
   (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv (versionToRange smpClientVersion) subMode sndSecure
+  atomically $ incSMPServerStat c userId (qServer rq) connCreated
   let qInfo = toVersionT qUri smpClientVersion
   rq' <- withStore c $ \db -> upgradeSndConnToDuplex db connId rq
   lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
@@ -1175,7 +1176,6 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
         ICDeleteRcvQueue rId -> withServer $ \srv -> tryWithLock "ICDeleteRcvQueue" $ do
           rq <- withStore c (\db -> getDeletedRcvQueue db connId srv rId)
           deleteQueue c rq
-          atomically $ incSMPServerStat c userId srv connDeleted
           withStore' c (`deleteConnRcvQueue` rq)
         ICQSecure rId senderKey ->
           withServer $ \srv -> tryWithLock "ICQSecure" . withDuplexConn $ \(DuplexConnection cData rqs sqs) ->
@@ -1425,7 +1425,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
                   withStore' c $ \db -> setSndQueueStatus db sq Active
                   case rq_ of
                     -- party initiating connection (in v1)
-                    Just RcvQueue {status} ->
+                    Just rq@RcvQueue {status} ->
                       -- it is unclear why subscribeQueue was needed here,
                       -- message delivery can only be enabled for queues that were created in the current session or subscribed
                       -- subscribeQueue c rq connId
@@ -1435,7 +1435,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
                       -- because it can be sent before HELLO is received
                       -- With `status == Active` condition, CON is sent here only by the accepting party, that previously received HELLO
                       when (status == Active) $ do
-                        atomically $ incSMPServerStat c userId server connCompleted
+                        atomically $ incSMPServerStat c userId (qServer rq) connCompleted
                         notify $ CON pqEncryption
                     -- this branch should never be reached as receive queue is created before the confirmation,
                     _ -> logError "HELLO sent without receive queue"
@@ -1627,10 +1627,14 @@ synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchroni
     _ -> throwE $ CMD PROHIBITED "synchronizeRatchet: not duplex"
 
 ackQueueMessage :: AgentClient -> RcvQueue -> SMP.MsgId -> AM ()
-ackQueueMessage c rq srvMsgId =
-  sendAck c rq srvMsgId `catchAgentError` \case
-    SMP _ SMP.NO_MSG -> pure ()
-    e -> throwE e
+ackQueueMessage c rq@RcvQueue {userId, server} srvMsgId = do
+  atomically $ incSMPServerStat c userId server ackAttempts
+  tryAgentError (sendAck c rq srvMsgId) >>= \case
+    Right _ -> atomically $ incSMPServerStat c userId server ackMsgs
+    Left (SMP _ SMP.NO_MSG) -> atomically $ incSMPServerStat c userId server ackNoMsgErrs
+    Left e -> do
+      unless (temporaryOrHostError e) $ atomically $ incSMPServerStat c userId server ackOtherErrs
+      throwE e
 
 -- | Suspend SMP agent connection (OFF command) in Reader monad
 suspendConnection' :: AgentClient -> ConnId -> AM ()
@@ -1727,11 +1731,15 @@ deleteConnQueues c waitDelivery ntf rqs = do
           Int ->
           (RcvQueue, Either AgentErrorType ()) ->
           IO ((RcvQueue, Either AgentErrorType ()), Maybe (AM' ()))
-        deleteQueueRec db maxErrs (rq, r) = case r of
+        deleteQueueRec db maxErrs (rq@RcvQueue {userId, server}, r) = case r of
           Right _ -> deleteConnRcvQueue db rq $> ((rq, r), Just (notifyRQ rq Nothing))
           Left e
             | temporaryOrHostError e && deleteErrors rq + 1 < maxErrs -> incRcvDeleteErrors db rq $> ((rq, r), Nothing)
-            | otherwise -> deleteConnRcvQueue db rq $> ((rq, Right ()), Just (notifyRQ rq (Just e)))
+            | otherwise -> do
+                deleteConnRcvQueue db rq
+                -- attempts and successes are counted in deleteQueues function
+                atomically $ incSMPServerStat c userId server connDeleted
+                pure ((rq, Right ()), Just (notifyRQ rq (Just e)))
     notifyRQ rq e_ = notify ("", qConnId rq, AEvt SAEConn $ DEL_RCVQ (qServer rq) (queueId rq) e_)
     notify = when ntf . atomically . writeTBQueue (subQ c)
     connResults :: [(RcvQueue, Either AgentErrorType ())] -> Map ConnId (Either AgentErrorType ())
@@ -2009,10 +2017,12 @@ setNtfServers c = atomically . writeTVar (ntfServers c)
 {-# INLINE setNtfServers #-}
 
 resetAgentServersStats' :: AgentClient -> AM ()
-resetAgentServersStats' c@AgentClient {smpServersStats, xftpServersStats} = do
+resetAgentServersStats' c@AgentClient {smpServersStats, xftpServersStats, srvStatsStartedAt} = do
+  startedAt <- liftIO getCurrentTime
+  atomically $ writeTVar srvStatsStartedAt startedAt
   atomically $ TM.clear smpServersStats
   atomically $ TM.clear xftpServersStats
-  withStore' c resetServersStats
+  withStore' c (`resetServersStats` startedAt)
 
 -- | Activate operations
 foregroundAgent :: AgentClient -> IO ()
@@ -2146,7 +2156,7 @@ data ACKd = ACKd | ACKPending
 -- It cannot be finally, as sometimes it needs to be ACK+DEL,
 -- and sometimes ACK has to be sent from the consumer.
 processSMPTransmissions :: AgentClient -> ServerTransmissionBatch SMPVersion ErrorType BrokerMsg -> AM' ()
-processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts) = do
+processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId, ts) = do
   upConnIds <- newTVarIO []
   forM_ ts $ \(entId, t) -> case t of
     STEvent msgOrErr ->
@@ -2171,7 +2181,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
       logServer "<--" c srv entId $ "error: " <> bshow e
       notifyErr "" e
   connIds <- readTVarIO upConnIds
-  unless (null connIds) $ notify' "" $ UP srv connIds
+  unless (null connIds) $ do
+    notify' "" $ UP srv connIds
+    atomically $ incSMPServerStat' c userId srv connSubscribed $ length connIds
   where
     withRcvConn :: SMP.RecipientId -> (forall c. RcvQueue -> Connection c -> AM ()) -> AM' ()
     withRcvConn rId a = do
@@ -2182,17 +2194,19 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
             Left e -> notify' connId (ERR e)
             Right () -> pure ()
     processSubOk :: RcvQueue -> TVar [ConnId] -> AM ()
-    processSubOk rq@RcvQueue {userId, connId} upConnIds = do
+    processSubOk rq@RcvQueue {connId} upConnIds =
       atomically . whenM (isPendingSub connId) $ do
         addSubscription c rq
         modifyTVar' upConnIds (connId :)
-      atomically $ incSMPServerStat c userId srv connSubscribed
     processSubErr :: RcvQueue -> SMPClientError -> AM ()
-    processSubErr rq@RcvQueue {userId, connId} e = do
-      atomically . whenM (isPendingSub connId) $ failSubscription c rq e
-      atomically $ incSMPServerStat c userId srv connSubErrs
+    processSubErr rq@RcvQueue {connId} e = do
+      atomically . whenM (isPendingSub connId) $
+        failSubscription c rq e >> incSMPServerStat c userId srv connSubErrs
       lift $ notifyErr connId e
-    isPendingSub connId = (&&) <$> hasPendingSubscription c connId <*> activeClientSession c tSess sessId
+    isPendingSub connId = do
+      pending <- (&&) <$> hasPendingSubscription c connId <*> activeClientSession c tSess sessId
+      unless pending $ incSMPServerStat c userId srv connSubIgnored
+      pure pending
     notify' :: forall e m. (AEntityI e, MonadIO m) => ConnId -> AEvent e -> m ()
     notify' connId msg = atomically $ writeTBQueue subQ ("", connId, AEvt (sAEntity @e) msg)
     notifyErr :: ConnId -> SMPClientError -> AM' ()
@@ -2201,7 +2215,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
     processSMP
       rq@RcvQueue {rcvId = rId, sndSecure, e2ePrivKey, e2eDhSecret, status}
       conn
-      cData@ConnData {userId, connId, connAgentVersion, ratchetSyncState = rss}
+      cData@ConnData {connId, connAgentVersion, ratchetSyncState = rss}
       smpMsg =
         withConnLock c connId "processSMP" $ case smpMsg of
           SMP.MSG msg@SMP.RcvMessage {msgId = srvMsgId} -> do
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 01d97f9ac..c9db8e7a7 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -142,6 +142,8 @@ module Simplex.Messaging.Agent.Client
     incSMPServerStat,
     incSMPServerStat',
     incXFTPServerStat,
+    incXFTPServerStat',
+    incXFTPServerSizeStat,
     AgentWorkersDetails (..),
     getAgentWorkersDetails,
     AgentWorkersSummary (..),
@@ -174,8 +176,9 @@ import Data.Bifunctor (bimap, first, second)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Either (partitionEithers)
+import Data.Either (isRight, partitionEithers)
 import Data.Functor (($>))
+import Data.Int (Int64)
 import Data.List (deleteFirstsBy, foldl', partition, (\\))
 import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
@@ -1329,13 +1332,16 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode sender
   pure (rq, qUri, tSess, sessId)
 
 processSubResult :: AgentClient -> RcvQueue -> Either SMPClientError () -> STM ()
-processSubResult c rq@RcvQueue {connId} = \case
+processSubResult c rq@RcvQueue {userId, server, connId} = \case
   Left e ->
-    unless (temporaryClientError e) $
+    unless (temporaryClientError e) $ do
+      incSMPServerStat c userId server connSubErrs
       failSubscription c rq e
   Right () ->
-    whenM (hasPendingSubscription c connId) $
-      addSubscription c rq
+    ifM
+      (hasPendingSubscription c connId)
+      (incSMPServerStat c userId server connSubscribed >> addSubscription c rq)
+      (incSMPServerStat c userId server connSubIgnored)
 
 temporaryAgentError :: AgentErrorType -> Bool
 temporaryAgentError = \case
@@ -1387,14 +1393,14 @@ subscribeQueues c qs = do
     subscribeQueues_ :: Env -> TVar (Maybe SessionId) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
     subscribeQueues_ env session smp qs' = do
       let (userId, srv, _) = transportSession' smp
-      atomically $ incSMPServerStat' c userId srv connSubAttempts (length qs')
+      atomically $ incSMPServerStat' c userId srv connSubAttempts $ length qs'
       rs <- sendBatch subscribeSMPQueues smp qs'
       active <-
         atomically $
           ifM
             (activeClientSession c tSess sessId)
             (writeTVar session (Just sessId) >> processSubResults rs $> True)
-            (pure False)
+            (incSMPServerStat' c userId srv connSubIgnored (length rs) $> False)
       if active
         then when (hasTempErrors rs) resubscribe $> rs
         else do
@@ -1603,7 +1609,15 @@ deleteQueue c rq@RcvQueue {rcvId, rcvPrivateKey} = do
     deleteSMPQueue smp rcvPrivateKey rcvId
 
 deleteQueues :: AgentClient -> [RcvQueue] -> AM' [(RcvQueue, Either AgentErrorType ())]
-deleteQueues = sendTSessionBatches "DEL" id $ sendBatch deleteSMPQueues
+deleteQueues c = sendTSessionBatches "DEL" id deleteQueues_ c
+  where
+    deleteQueues_ smp rqs = do
+      let (userId, srv, _) = transportSession' smp
+      atomically $ incSMPServerStat' c userId srv connDelAttempts $ length rqs
+      rs <- sendBatch deleteSMPQueues smp rqs
+      let successes = foldl' (\n (_, r) -> if isRight r then n + 1 else n) 0 rs
+      atomically $ incSMPServerStat' c userId srv connDeleted successes
+      pure rs
 
 sendAgentMessage :: AgentClient -> SndQueue -> MsgFlags -> ByteString -> AM (Maybe SMPServer)
 sendAgentMessage c sq@SndQueue {userId, server, sndId, sndPrivateKey} msgFlags agentMsg = do
@@ -1924,12 +1938,24 @@ incSMPServerStat' AgentClient {smpServersStats} userId srv sel n = do
       TM.insert (userId, srv) newStats smpServersStats
 
 incXFTPServerStat :: AgentClient -> UserId -> XFTPServer -> (AgentXFTPServerStats -> TVar Int) -> STM ()
-incXFTPServerStat AgentClient {xftpServersStats} userId srv sel = do
+incXFTPServerStat c userId srv sel = incXFTPServerStat_ c userId srv sel 1
+{-# INLINE incXFTPServerStat #-}
+
+incXFTPServerStat' :: AgentClient -> UserId -> XFTPServer -> (AgentXFTPServerStats -> TVar Int) -> Int -> STM ()
+incXFTPServerStat' = incXFTPServerStat_
+{-# INLINE incXFTPServerStat' #-}
+
+incXFTPServerSizeStat :: AgentClient -> UserId -> XFTPServer -> (AgentXFTPServerStats -> TVar Int64) -> Int64 -> STM ()
+incXFTPServerSizeStat = incXFTPServerStat_
+{-# INLINE incXFTPServerSizeStat #-}
+
+incXFTPServerStat_ :: Num n => AgentClient -> UserId -> XFTPServer -> (AgentXFTPServerStats -> TVar n) -> n -> STM ()
+incXFTPServerStat_ AgentClient {xftpServersStats} userId srv sel n = do
   TM.lookup (userId, srv) xftpServersStats >>= \case
-    Just v -> modifyTVar' (sel v) (+ 1)
+    Just v -> modifyTVar' (sel v) (+ n)
     Nothing -> do
       newStats <- newAgentXFTPServerStats
-      modifyTVar' (sel newStats) (+ 1)
+      modifyTVar' (sel newStats) (+ n)
       TM.insert (userId, srv) newStats xftpServersStats
 
 data AgentServersSummary = AgentServersSummary
diff --git a/src/Simplex/Messaging/Agent/Stats.hs b/src/Simplex/Messaging/Agent/Stats.hs
index c8f81a6aa..424052d74 100644
--- a/src/Simplex/Messaging/Agent/Stats.hs
+++ b/src/Simplex/Messaging/Agent/Stats.hs
@@ -5,6 +5,7 @@
 module Simplex.Messaging.Agent.Stats where
 
 import qualified Data.Aeson.TH as J
+import Data.Int (Int64)
 import Data.Map (Map)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
@@ -29,12 +30,20 @@ data AgentSMPServerStats = AgentSMPServerStats
     recvDuplicates :: TVar Int, -- duplicate messages received
     recvCryptoErrs :: TVar Int, -- message decryption errors
     recvErrs :: TVar Int, -- receive errors
-    connCreated :: TVar Int,
-    connSecured :: TVar Int,
-    connCompleted :: TVar Int,
-    connDeleted :: TVar Int,
+    ackMsgs :: TVar Int, -- total messages acknowledged
+    ackAttempts :: TVar Int, -- acknowledgement attempts
+    ackNoMsgErrs :: TVar Int, -- NO_MSG ack errors
+    ackOtherErrs :: TVar Int, -- other permanent ack errors (temporary accounted for in attempts)
+    -- conn stats are accounted for rcv queue server
+    connCreated :: TVar Int, -- total connections created
+    connSecured :: TVar Int, -- connections secured
+    connCompleted :: TVar Int, -- connections completed
+    connDeleted :: TVar Int, -- total connections deleted
+    connDelAttempts :: TVar Int, -- total connection deletion attempts
+    connDelErrs :: TVar Int, -- permanent connection deletion errors (temporary accounted for in attempts)
     connSubscribed :: TVar Int, -- total successful subscription
     connSubAttempts :: TVar Int, -- subscription attempts
+    connSubIgnored :: TVar Int, -- subscription results ignored (client switched to different session or it was not pending)
     connSubErrs :: TVar Int -- permanent subscription errors (temporary accounted for in attempts)
   }
 
@@ -53,12 +62,19 @@ data AgentSMPServerStatsData = AgentSMPServerStatsData
     _recvDuplicates :: Int,
     _recvCryptoErrs :: Int,
     _recvErrs :: Int,
+    _ackMsgs :: Int,
+    _ackAttempts :: Int,
+    _ackNoMsgErrs :: Int,
+    _ackOtherErrs :: Int,
     _connCreated :: Int,
     _connSecured :: Int,
     _connCompleted :: Int,
     _connDeleted :: Int,
+    _connDelAttempts :: Int,
+    _connDelErrs :: Int,
     _connSubscribed :: Int,
     _connSubAttempts :: Int,
+    _connSubIgnored :: Int,
     _connSubErrs :: Int
   }
   deriving (Show)
@@ -79,12 +95,19 @@ newAgentSMPServerStats = do
   recvDuplicates <- newTVar 0
   recvCryptoErrs <- newTVar 0
   recvErrs <- newTVar 0
+  ackMsgs <- newTVar 0
+  ackAttempts <- newTVar 0
+  ackNoMsgErrs <- newTVar 0
+  ackOtherErrs <- newTVar 0
   connCreated <- newTVar 0
   connSecured <- newTVar 0
   connCompleted <- newTVar 0
   connDeleted <- newTVar 0
+  connDelAttempts <- newTVar 0
+  connDelErrs <- newTVar 0
   connSubscribed <- newTVar 0
   connSubAttempts <- newTVar 0
+  connSubIgnored <- newTVar 0
   connSubErrs <- newTVar 0
   pure
     AgentSMPServerStats
@@ -102,15 +125,55 @@ newAgentSMPServerStats = do
         recvDuplicates,
         recvCryptoErrs,
         recvErrs,
+        ackMsgs,
+        ackAttempts,
+        ackNoMsgErrs,
+        ackOtherErrs,
         connCreated,
         connSecured,
         connCompleted,
         connDeleted,
+        connDelAttempts,
+        connDelErrs,
         connSubscribed,
         connSubAttempts,
+        connSubIgnored,
         connSubErrs
       }
 
+newAgentSMPServerStatsData :: AgentSMPServerStatsData
+newAgentSMPServerStatsData =
+  AgentSMPServerStatsData
+    { _sentDirect = 0,
+      _sentViaProxy = 0,
+      _sentProxied = 0,
+      _sentDirectAttempts = 0,
+      _sentViaProxyAttempts = 0,
+      _sentProxiedAttempts = 0,
+      _sentAuthErrs = 0,
+      _sentQuotaErrs = 0,
+      _sentExpiredErrs = 0,
+      _sentOtherErrs = 0,
+      _recvMsgs = 0,
+      _recvDuplicates = 0,
+      _recvCryptoErrs = 0,
+      _recvErrs = 0,
+      _ackMsgs = 0,
+      _ackAttempts = 0,
+      _ackNoMsgErrs = 0,
+      _ackOtherErrs = 0,
+      _connCreated = 0,
+      _connSecured = 0,
+      _connCompleted = 0,
+      _connDeleted = 0,
+      _connDelAttempts = 0,
+      _connDelErrs = 0,
+      _connSubscribed = 0,
+      _connSubAttempts = 0,
+      _connSubIgnored = 0,
+      _connSubErrs = 0
+    }
+
 newAgentSMPServerStats' :: AgentSMPServerStatsData -> STM AgentSMPServerStats
 newAgentSMPServerStats' s = do
   sentDirect <- newTVar $ _sentDirect s
@@ -127,12 +190,19 @@ newAgentSMPServerStats' s = do
   recvDuplicates <- newTVar $ _recvDuplicates s
   recvCryptoErrs <- newTVar $ _recvCryptoErrs s
   recvErrs <- newTVar $ _recvErrs s
+  ackMsgs <- newTVar $ _ackMsgs s
+  ackAttempts <- newTVar $ _ackAttempts s
+  ackNoMsgErrs <- newTVar $ _ackNoMsgErrs s
+  ackOtherErrs <- newTVar $ _ackOtherErrs s
   connCreated <- newTVar $ _connCreated s
   connSecured <- newTVar $ _connSecured s
   connCompleted <- newTVar $ _connCompleted s
   connDeleted <- newTVar $ _connDeleted s
+  connDelAttempts <- newTVar $ _connDelAttempts s
+  connDelErrs <- newTVar $ _connDelErrs s
   connSubscribed <- newTVar $ _connSubscribed s
   connSubAttempts <- newTVar $ _connSubAttempts s
+  connSubIgnored <- newTVar $ _connSubIgnored s
   connSubErrs <- newTVar $ _connSubErrs s
   pure
     AgentSMPServerStats
@@ -150,12 +220,19 @@ newAgentSMPServerStats' s = do
         recvDuplicates,
         recvCryptoErrs,
         recvErrs,
+        ackMsgs,
+        ackAttempts,
+        ackNoMsgErrs,
+        ackOtherErrs,
         connCreated,
         connSecured,
         connCompleted,
         connDeleted,
+        connDelAttempts,
+        connDelErrs,
         connSubscribed,
         connSubAttempts,
+        connSubIgnored,
         connSubErrs
       }
 
@@ -177,12 +254,19 @@ getAgentSMPServerStats s = do
   _recvDuplicates <- readTVarIO $ recvDuplicates s
   _recvCryptoErrs <- readTVarIO $ recvCryptoErrs s
   _recvErrs <- readTVarIO $ recvErrs s
+  _ackMsgs <- readTVarIO $ ackMsgs s
+  _ackAttempts <- readTVarIO $ ackAttempts s
+  _ackNoMsgErrs <- readTVarIO $ ackNoMsgErrs s
+  _ackOtherErrs <- readTVarIO $ ackOtherErrs s
   _connCreated <- readTVarIO $ connCreated s
   _connSecured <- readTVarIO $ connSecured s
   _connCompleted <- readTVarIO $ connCompleted s
   _connDeleted <- readTVarIO $ connDeleted s
+  _connDelAttempts <- readTVarIO $ connDelAttempts s
+  _connDelErrs <- readTVarIO $ connDelErrs s
   _connSubscribed <- readTVarIO $ connSubscribed s
   _connSubAttempts <- readTVarIO $ connSubAttempts s
+  _connSubIgnored <- readTVarIO $ connSubIgnored s
   _connSubErrs <- readTVarIO $ connSubErrs s
   pure
     AgentSMPServerStatsData
@@ -200,20 +284,62 @@ getAgentSMPServerStats s = do
         _recvDuplicates,
         _recvCryptoErrs,
         _recvErrs,
+        _ackMsgs,
+        _ackAttempts,
+        _ackNoMsgErrs,
+        _ackOtherErrs,
         _connCreated,
         _connSecured,
         _connCompleted,
         _connDeleted,
+        _connDelAttempts,
+        _connDelErrs,
         _connSubscribed,
         _connSubAttempts,
+        _connSubIgnored,
         _connSubErrs
       }
 
+addSMPStatsData :: AgentSMPServerStatsData -> AgentSMPServerStatsData -> AgentSMPServerStatsData
+addSMPStatsData sd1 sd2 =
+  AgentSMPServerStatsData
+    { _sentDirect = _sentDirect sd1 + _sentDirect sd2,
+      _sentViaProxy = _sentViaProxy sd1 + _sentViaProxy sd2,
+      _sentProxied = _sentProxied sd1 + _sentProxied sd2,
+      _sentDirectAttempts = _sentDirectAttempts sd1 + _sentDirectAttempts sd2,
+      _sentViaProxyAttempts = _sentViaProxyAttempts sd1 + _sentViaProxyAttempts sd2,
+      _sentProxiedAttempts = _sentProxiedAttempts sd1 + _sentProxiedAttempts sd2,
+      _sentAuthErrs = _sentAuthErrs sd1 + _sentAuthErrs sd2,
+      _sentQuotaErrs = _sentQuotaErrs sd1 + _sentQuotaErrs sd2,
+      _sentExpiredErrs = _sentExpiredErrs sd1 + _sentExpiredErrs sd2,
+      _sentOtherErrs = _sentOtherErrs sd1 + _sentOtherErrs sd2,
+      _recvMsgs = _recvMsgs sd1 + _recvMsgs sd2,
+      _recvDuplicates = _recvDuplicates sd1 + _recvDuplicates sd2,
+      _recvCryptoErrs = _recvCryptoErrs sd1 + _recvCryptoErrs sd2,
+      _recvErrs = _recvErrs sd1 + _recvErrs sd2,
+      _ackMsgs = _ackMsgs sd1 + _ackMsgs sd2,
+      _ackAttempts = _ackAttempts sd1 + _ackAttempts sd2,
+      _ackNoMsgErrs = _ackNoMsgErrs sd1 + _ackNoMsgErrs sd2,
+      _ackOtherErrs = _ackOtherErrs sd1 + _ackOtherErrs sd2,
+      _connCreated = _connCreated sd1 + _connCreated sd2,
+      _connSecured = _connSecured sd1 + _connSecured sd2,
+      _connCompleted = _connCompleted sd1 + _connCompleted sd2,
+      _connDeleted = _connDeleted sd1 + _connDeleted sd2,
+      _connDelAttempts = _connDelAttempts sd1 + _connDelAttempts sd2,
+      _connDelErrs = _connDelErrs sd1 + _connDelErrs sd2,
+      _connSubscribed = _connSubscribed sd1 + _connSubscribed sd2,
+      _connSubAttempts = _connSubAttempts sd1 + _connSubAttempts sd2,
+      _connSubIgnored = _connSubIgnored sd1 + _connSubIgnored sd2,
+      _connSubErrs = _connSubErrs sd1 + _connSubErrs sd2
+    }
+
 data AgentXFTPServerStats = AgentXFTPServerStats
   { uploads :: TVar Int, -- total replicas uploaded to server
+    uploadsSize :: TVar Int64, -- total size of uploaded replicas in KB
     uploadAttempts :: TVar Int, -- upload attempts
     uploadErrs :: TVar Int, -- upload errors
     downloads :: TVar Int, -- total replicas downloaded from server
+    downloadsSize :: TVar Int64, -- total size of downloaded replicas in KB
     downloadAttempts :: TVar Int, -- download attempts
     downloadAuthErrs :: TVar Int, -- download AUTH errors
     downloadErrs :: TVar Int, -- other download errors (excluding above)
@@ -224,9 +350,11 @@ data AgentXFTPServerStats = AgentXFTPServerStats
 
 data AgentXFTPServerStatsData = AgentXFTPServerStatsData
   { _uploads :: Int,
+    _uploadsSize :: Int64,
     _uploadAttempts :: Int,
     _uploadErrs :: Int,
     _downloads :: Int,
+    _downloadsSize :: Int64,
     _downloadAttempts :: Int,
     _downloadAuthErrs :: Int,
     _downloadErrs :: Int,
@@ -239,9 +367,11 @@ data AgentXFTPServerStatsData = AgentXFTPServerStatsData
 newAgentXFTPServerStats :: STM AgentXFTPServerStats
 newAgentXFTPServerStats = do
   uploads <- newTVar 0
+  uploadsSize <- newTVar 0
   uploadAttempts <- newTVar 0
   uploadErrs <- newTVar 0
   downloads <- newTVar 0
+  downloadsSize <- newTVar 0
   downloadAttempts <- newTVar 0
   downloadAuthErrs <- newTVar 0
   downloadErrs <- newTVar 0
@@ -251,9 +381,11 @@ newAgentXFTPServerStats = do
   pure
     AgentXFTPServerStats
       { uploads,
+        uploadsSize,
         uploadAttempts,
         uploadErrs,
         downloads,
+        downloadsSize,
         downloadAttempts,
         downloadAuthErrs,
         downloadErrs,
@@ -262,12 +394,31 @@ newAgentXFTPServerStats = do
         deleteErrs
       }
 
+newAgentXFTPServerStatsData :: AgentXFTPServerStatsData
+newAgentXFTPServerStatsData =
+  AgentXFTPServerStatsData
+    { _uploads = 0,
+      _uploadsSize = 0,
+      _uploadAttempts = 0,
+      _uploadErrs = 0,
+      _downloads = 0,
+      _downloadsSize = 0,
+      _downloadAttempts = 0,
+      _downloadAuthErrs = 0,
+      _downloadErrs = 0,
+      _deletions = 0,
+      _deleteAttempts = 0,
+      _deleteErrs = 0
+    }
+
 newAgentXFTPServerStats' :: AgentXFTPServerStatsData -> STM AgentXFTPServerStats
 newAgentXFTPServerStats' s = do
   uploads <- newTVar $ _uploads s
+  uploadsSize <- newTVar $ _uploadsSize s
   uploadAttempts <- newTVar $ _uploadAttempts s
   uploadErrs <- newTVar $ _uploadErrs s
   downloads <- newTVar $ _downloads s
+  downloadsSize <- newTVar $ _downloadsSize s
   downloadAttempts <- newTVar $ _downloadAttempts s
   downloadAuthErrs <- newTVar $ _downloadAuthErrs s
   downloadErrs <- newTVar $ _downloadErrs s
@@ -277,9 +428,11 @@ newAgentXFTPServerStats' s = do
   pure
     AgentXFTPServerStats
       { uploads,
+        uploadsSize,
         uploadAttempts,
         uploadErrs,
         downloads,
+        downloadsSize,
         downloadAttempts,
         downloadAuthErrs,
         downloadErrs,
@@ -293,9 +446,11 @@ newAgentXFTPServerStats' s = do
 getAgentXFTPServerStats :: AgentXFTPServerStats -> IO AgentXFTPServerStatsData
 getAgentXFTPServerStats s = do
   _uploads <- readTVarIO $ uploads s
+  _uploadsSize <- readTVarIO $ uploadsSize s
   _uploadAttempts <- readTVarIO $ uploadAttempts s
   _uploadErrs <- readTVarIO $ uploadErrs s
   _downloads <- readTVarIO $ downloads s
+  _downloadsSize <- readTVarIO $ downloadsSize s
   _downloadAttempts <- readTVarIO $ downloadAttempts s
   _downloadAuthErrs <- readTVarIO $ downloadAuthErrs s
   _downloadErrs <- readTVarIO $ downloadErrs s
@@ -305,9 +460,11 @@ getAgentXFTPServerStats s = do
   pure
     AgentXFTPServerStatsData
       { _uploads,
+        _uploadsSize,
         _uploadAttempts,
         _uploadErrs,
         _downloads,
+        _downloadsSize,
         _downloadAttempts,
         _downloadAuthErrs,
         _downloadErrs,
@@ -316,6 +473,23 @@ getAgentXFTPServerStats s = do
         _deleteErrs
       }
 
+addXFTPStatsData :: AgentXFTPServerStatsData -> AgentXFTPServerStatsData -> AgentXFTPServerStatsData
+addXFTPStatsData sd1 sd2 =
+  AgentXFTPServerStatsData
+    { _uploads = _uploads sd1 + _uploads sd2,
+      _uploadsSize = _uploadsSize sd1 + _uploadsSize sd2,
+      _uploadAttempts = _uploadAttempts sd1 + _uploadAttempts sd2,
+      _uploadErrs = _uploadErrs sd1 + _uploadErrs sd2,
+      _downloads = _downloads sd1 + _downloads sd2,
+      _downloadsSize = _downloadsSize sd1 + _downloadsSize sd2,
+      _downloadAttempts = _downloadAttempts sd1 + _downloadAttempts sd2,
+      _downloadAuthErrs = _downloadAuthErrs sd1 + _downloadAuthErrs sd2,
+      _downloadErrs = _downloadErrs sd1 + _downloadErrs sd2,
+      _deletions = _deletions sd1 + _deletions sd2,
+      _deleteAttempts = _deleteAttempts sd1 + _deleteAttempts sd2,
+      _deleteErrs = _deleteErrs sd1 + _deleteErrs sd2
+    }
+
 -- Type for gathering both smp and xftp stats across all users and servers,
 -- to then be persisted to db as a single json.
 data AgentPersistedServerStats = AgentPersistedServerStats
diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs
index baec2ef93..ae010a884 100644
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -175,6 +175,12 @@ instance SMPQueue RcvQueue where
   queueId RcvQueue {rcvId} = rcvId
   {-# INLINE queueId #-}
 
+instance SMPQueue NewRcvQueue where
+  qServer RcvQueue {server} = server
+  {-# INLINE qServer #-}
+  queueId RcvQueue {rcvId} = rcvId
+  {-# INLINE queueId #-}
+
 instance SMPQueue SndQueue where
   qServer SndQueue {server} = server
   {-# INLINE qServer #-}
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index d4cd99b39..0727343e7 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -3041,10 +3041,9 @@ getServersStats db =
   firstRow id SEServersStatsNotFound $
     DB.query_ db "SELECT started_at, servers_stats FROM servers_stats WHERE servers_stats_id = 1"
 
-resetServersStats :: DB.Connection -> IO ()
-resetServersStats db = do
-  currentTs <- getCurrentTime
-  DB.execute db "UPDATE servers_stats SET servers_stats = NULL, started_at = ?, updated_at = ? WHERE servers_stats_id = 1" (currentTs, currentTs)
+resetServersStats :: DB.Connection -> UTCTime -> IO ()
+resetServersStats db startedAt =
+  DB.execute db "UPDATE servers_stats SET servers_stats = NULL, started_at = ?, updated_at = ? WHERE servers_stats_id = 1" (startedAt, startedAt)
 
 $(J.deriveJSON defaultJSON ''UpMigration)
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
index 2279d7ea5..131561f4d 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
@@ -73,6 +73,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wai
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -114,7 +115,8 @@ schemaMigrations =
     ("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
     ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
     ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
-    ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure)
+    ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
+    ("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240518_servers_stats.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240702_servers_stats.hs
similarity index 79%
rename from src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240518_servers_stats.hs
rename to src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240702_servers_stats.hs
index fe017e233..5e283d8b1 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240518_servers_stats.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240702_servers_stats.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 
-module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240518_servers_stats where
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats where
 
 import Database.SQLite.Simple (Query)
 import Database.SQLite.Simple.QQ (sql)
@@ -8,8 +8,8 @@ import Database.SQLite.Simple.QQ (sql)
 -- servers_stats_id: dummy id, there should always only be one record with servers_stats_id = 1
 -- servers_stats: overall accumulated stats, past and session, reset to null on stats reset
 -- started_at: starting point of tracking stats, reset on stats reset
-m20240518_servers_stats :: Query
-m20240518_servers_stats =
+m20240702_servers_stats :: Query
+m20240702_servers_stats =
     [sql|
 CREATE TABLE servers_stats(
   servers_stats_id INTEGER PRIMARY KEY,
@@ -22,8 +22,8 @@ CREATE TABLE servers_stats(
 INSERT INTO servers_stats (servers_stats_id) VALUES (1);
 |]
 
-down_m20240518_servers_stats :: Query
-down_m20240518_servers_stats =
+down_m20240702_servers_stats :: Query
+down_m20240702_servers_stats =
     [sql|
 DROP TABLE servers_stats;
 |]
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
index b9d2d945f..80af08989 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
@@ -396,6 +396,13 @@ CREATE TABLE processed_ratchet_key_hashes(
   created_at TEXT NOT NULL DEFAULT(datetime('now')),
   updated_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
+CREATE TABLE servers_stats(
+  servers_stats_id INTEGER PRIMARY KEY,
+  servers_stats TEXT,
+  started_at TEXT NOT NULL DEFAULT(datetime('now')),
+  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);

From ce732c0efbc5530035e7b7042e398c1b9ea6e4fe Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 3 Jul 2024 18:05:27 +0100
Subject: [PATCH 025/195] agent: enable fast handshake (revert #1215) (#1216)

* Revert "agent: disable fast handshake (#1215)"

This reverts commit aa1d8d6c8bcff82f02aa580b1b729fc4b1396fd9.

* remove import

* test delays
---
 src/Simplex/Messaging/Agent.hs         |   5 +-
 tests/AgentTests/FunctionalAPITests.hs | 111 +++++++++++++------------
 tests/AgentTests/NotificationTests.hs  |  22 ++---
 tests/SMPProxyTests.hs                 |  18 ++--
 4 files changed, 78 insertions(+), 78 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 480c8f801..7764d16a3 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -157,7 +157,6 @@ import Simplex.Messaging.Agent.NtfSubSupervisor
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Stats
-import Simplex.Messaging.Agent.Stats (AgentSMPServerStats (connSubErrs))
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
@@ -739,7 +738,7 @@ newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv
     (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv"
     _ -> pure ()
   AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
-  let sndSecure = False -- case cMode of SCMInvitation -> True; SCMContact -> False
+  let sndSecure = case cMode of SCMInvitation -> True; SCMContact -> False
   (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srvWithAuth smpClientVRange subMode sndSecure `catchAgentError` \e -> liftIO (print e) >> throwE e
   atomically $ incSMPServerStat c userId srv connCreated
   rq' <- withStore c $ \db -> updateNewConnRcv db connId rq
@@ -883,7 +882,7 @@ joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode
 
 createReplyQueue :: AgentClient -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo
 createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVersion} subMode srv = do
-  let sndSecure = False -- smpClientVersion >= sndAuthKeySMPClientVersion
+  let sndSecure = smpClientVersion >= sndAuthKeySMPClientVersion
   (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv (versionToRange smpClientVersion) subMode sndSecure
   atomically $ incSMPServerStat c userId (qServer rq) connCreated
   let qInfo = toVersionT qUri smpClientVersion
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 19f4977fc..569901c77 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -257,11 +257,11 @@ functionalAPITests :: ATransport -> Spec
 functionalAPITests t = do
   describe "Establishing duplex connection" $ do
     testMatrix2 t runAgentClientTest
-    xit "should connect when server with multiple identities is stored" $
+    it "should connect when server with multiple identities is stored" $
       withSmpServer t testServerMultipleIdentities
-    xit "should connect with two peers" $
+    it "should connect with two peers" $
       withSmpServer t testAgentClient3
-    xit "should establish connection without PQ encryption and enable it" $
+    it "should establish connection without PQ encryption and enable it" $
       withSmpServer t testEnablePQEncryption
   describe "Establishing duplex connection, different PQ settings" $ do
     testPQMatrix2 t $ runAgentClientTestPQ True
@@ -290,43 +290,43 @@ functionalAPITests t = do
       testAllowConnectionClientRestart t
   describe "Message delivery" $ do
     describe "update connection agent version on received messages" $ do
-      xit "should increase if compatible, shouldn't decrease" $
+      it "should increase if compatible, shouldn't decrease" $
         testIncreaseConnAgentVersion t
-      xit "should increase to max compatible version" $
+      it "should increase to max compatible version" $
         testIncreaseConnAgentVersionMaxCompatible t
-      xit "should increase when connection was negotiated on different versions" $
+      it "should increase when connection was negotiated on different versions" $
         testIncreaseConnAgentVersionStartDifferentVersion t
     -- TODO PQ tests for upgrading connection to PQ encryption
-    xit "should deliver message after client restart" $
+    it "should deliver message after client restart" $
       testDeliverClientRestart t
-    xit "should deliver messages to the user once, even if repeat delivery is made by the server (no ACK)" $
+    it "should deliver messages to the user once, even if repeat delivery is made by the server (no ACK)" $
       testDuplicateMessage t
-    xit "should report error via msg integrity on skipped messages" $
+    it "should report error via msg integrity on skipped messages" $
       testSkippedMessages t
-    xit "should connect to the server when server goes up if it initially was down" $
+    it "should connect to the server when server goes up if it initially was down" $
       testDeliveryAfterSubscriptionError t
-    xit "should deliver messages if one of connections has quota exceeded" $
+    it "should deliver messages if one of connections has quota exceeded" $
       testMsgDeliveryQuotaExceeded t
     describe "message expiration" $ do
-      xit "should expire one message" $ testExpireMessage t
-      xit "should expire multiple messages" $ testExpireManyMessages t
-      xit "should expire one message if quota is exceeded" $ testExpireMessageQuota t
-      xit "should expire multiple messages if quota is exceeded" $ testExpireManyMessagesQuota t
+      it "should expire one message" $ testExpireMessage t
+      it "should expire multiple messages" $ testExpireManyMessages t
+      it "should expire one message if quota is exceeded" $ testExpireMessageQuota t
+      it "should expire multiple messages if quota is exceeded" $ testExpireManyMessagesQuota t
     describe "Ratchet synchronization" $ do
-      xit "should report ratchet de-synchronization, synchronize ratchets" $
+      it "should report ratchet de-synchronization, synchronize ratchets" $
         testRatchetSync t
-      xit "should synchronize ratchets after server being offline" $
+      it "should synchronize ratchets after server being offline" $
         testRatchetSyncServerOffline t
-      xit "should synchronize ratchets after client restart" $
+      it "should synchronize ratchets after client restart" $
         testRatchetSyncClientRestart t
-      xit "should synchronize ratchets after suspend/foreground" $
+      it "should synchronize ratchets after suspend/foreground" $
         testRatchetSyncSuspendForeground t
-      xit "should synchronize ratchets when clients start synchronization simultaneously" $
+      it "should synchronize ratchets when clients start synchronization simultaneously" $
         testRatchetSyncSimultaneous t
     describe "Subscription mode OnlyCreate" $ do
       it "messages delivered only when polled (v8 - slow handshake)" $
         withSmpServer t testOnlyCreatePullSlowHandshake
-      xit "messages delivered only when polled" $
+      it "messages delivered only when polled" $
         withSmpServer t testOnlyCreatePull
   describe "Inactive client disconnection" $ do
     it "should disconnect clients without subs if they were inactive longer than TTL" $
@@ -336,14 +336,14 @@ functionalAPITests t = do
     it "should NOT disconnect active clients" $
       testActiveClientNotDisconnected t
   describe "Suspending agent" $ do
-    xit "should update client when agent is suspended" $
+    it "should update client when agent is suspended" $
       withSmpServer t testSuspendingAgent
-    xit "should complete sending messages when agent is suspended" $
+    it "should complete sending messages when agent is suspended" $
       testSuspendingAgentCompleteSending t
-    xit "should suspend agent on timeout, even if pending messages not sent" $
+    it "should suspend agent on timeout, even if pending messages not sent" $
       testSuspendingAgentTimeout t
   describe "Batching SMP commands" $ do
-    xit "should subscribe to multiple (200) subscriptions with batching" $
+    it "should subscribe to multiple (200) subscriptions with batching" $
       testBatchedSubscriptions 200 10 t
     skip "faster version of the previous test (200 subscriptions gets very slow with test coverage)" $
       it "should subscribe to multiple (6) subscriptions with batching" $
@@ -362,7 +362,7 @@ functionalAPITests t = do
       testDeleteConnectionAsync t
     it "join connection when reply queue creation fails (v8 - slow handshake)" $
       testJoinConnectionAsyncReplyErrorV8 t
-    xit "join connection when reply queue creation fails" $
+    it "join connection when reply queue creation fails" $
       testJoinConnectionAsyncReplyError t
     describe "delete connection waiting for delivery" $ do
       it "should delete connection immediately if there are no pending messages" $
@@ -376,34 +376,34 @@ functionalAPITests t = do
       it "should delete connection by timeout, message in progress can be delivered" $
         testWaitDeliveryTimeout2 t
   describe "Users" $ do
-    xit "should create and delete user with connections" $
+    it "should create and delete user with connections" $
       withSmpServer t testUsers
-    xit "should create and delete user without connections" $
+    it "should create and delete user without connections" $
       withSmpServer t testDeleteUserQuietly
-    xit "should create and delete user with connections when server connection fails" $
+    it "should create and delete user with connections when server connection fails" $
       testUsersNoServer t
-    xit "should connect two users and switch session mode" $
+    it "should connect two users and switch session mode" $
       withSmpServer t testTwoUsers
   describe "Connection switch" $ do
-    xdescribe "should switch delivery to the new queue" $
+    describe "should switch delivery to the new queue" $
       testServerMatrix2 t testSwitchConnection
-    xdescribe "should switch to new queue asynchronously" $
+    describe "should switch to new queue asynchronously" $
       testServerMatrix2 t testSwitchAsync
     describe "should delete connection during switch" $
       testServerMatrix2 t testSwitchDelete
-    xdescribe "should abort switch in Started phase" $
+    describe "should abort switch in Started phase" $
       testServerMatrix2 t testAbortSwitchStarted
-    xdescribe "should abort switch in Started phase, reinitiate immediately" $
+    describe "should abort switch in Started phase, reinitiate immediately" $
       testServerMatrix2 t testAbortSwitchStartedReinitiate
-    xdescribe "should prohibit to abort switch in Secured phase" $
+    describe "should prohibit to abort switch in Secured phase" $
       testServerMatrix2 t testCannotAbortSwitchSecured
-    xdescribe "should switch two connections simultaneously" $
+    describe "should switch two connections simultaneously" $
       testServerMatrix2 t testSwitch2Connections
-    xdescribe "should switch two connections simultaneously, abort one" $
+    describe "should switch two connections simultaneously, abort one" $
       testServerMatrix2 t testSwitch2ConnectionsAbort1
   describe "SMP basic auth" $ do
     let v4 = prevVersion basicAuthSMPVersion
-    forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, prevVersion currentServerSMPRelayVersion]) $ \v -> do
+    forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, currentServerSMPRelayVersion]) $ \v -> do
       let baseId = if v >= sndAuthKeySMPVersion then 1 else 3
       describe ("v" <> show v <> ": with server auth") $ do
         --                                       allow NEW | server auth, v | clnt1 auth, v  | clnt2 auth, v    |  2 - success, 1 - JOIN fail, 0 - NEW fail
@@ -444,15 +444,15 @@ functionalAPITests t = do
     it "should return the same data for both peers" $
       withSmpServer t testRatchetAdHash
   describe "Delivery receipts" $ do
-    xit "should send and receive delivery receipt" $ withSmpServer t testDeliveryReceipts
-    xit "should send delivery receipt only in connection v3+" $ testDeliveryReceiptsVersion t
+    it "should send and receive delivery receipt" $ withSmpServer t testDeliveryReceipts
+    it "should send delivery receipt only in connection v3+" $ testDeliveryReceiptsVersion t
     it "send delivery receipts concurrently with messages" $ testDeliveryReceiptsConcurrent t
   describe "user network info" $ do
     it "should wait for user network" testWaitForUserNetwork
     it "should not reset online to offline if happens too quickly" testDoNotResetOnlineToOffline
     it "should resume multiple threads" testResumeMultipleThreads
   describe "SMP queue info" $ do
-    xit "server should respond with queue and subscription information" $
+    it "server should respond with queue and subscription information" $
       withSmpServer t testServerQueueInfo
 
 testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> AgentMsgId -> IO Int
@@ -475,28 +475,28 @@ canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =
 
 testMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2 t runTest = do
-  xit "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
+  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
   it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
-  xit "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
+  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
   it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 $ runTest PQSupportOff False
   it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff False
   it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff False
 
 testBasicMatrix2 :: HasCallStack => ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testBasicMatrix2 t runTest = do
-  xit "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest
+  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest
   it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 3 $ runTest
   it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfg 3 $ runTest
   it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrevPQ 3 $ runTest
 
 testRatchetMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testRatchetMatrix2 t runTest = do
-  xit "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
+  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
   it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
-  xit "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
-  xit "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
-  xit "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff False
-  xit "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
+  it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
+  it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
+  it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff False
+  it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
 
 testServerMatrix2 :: HasCallStack => ATransport -> (InitialAgentServers -> IO ()) -> Spec
 testServerMatrix2 t runTest = do
@@ -911,6 +911,7 @@ testAllowConnectionClientRestart t = do
 
     threadDelay 100000 -- give time to enqueue confirmation (enqueueConfirmation)
     disposeAgentClient alice
+    threadDelay 250000
 
     alice2 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB
 
@@ -1947,7 +1948,7 @@ testWaitDeliveryNoPending t = withAgentClients2 $ \alice bob ->
     liftIO $ noMessages alice "nothing else should be delivered to alice"
     liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testWaitDelivery :: ATransport -> IO ()
@@ -2001,7 +2002,7 @@ testWaitDelivery t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testWaitDeliveryAUTHErr :: ATransport -> IO ()
@@ -2044,7 +2045,7 @@ testWaitDeliveryAUTHErr t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testWaitDeliveryTimeout :: ATransport -> IO ()
@@ -2084,7 +2085,7 @@ testWaitDeliveryTimeout t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testWaitDeliveryTimeout2 :: ATransport -> IO ()
@@ -2130,7 +2131,7 @@ testWaitDeliveryTimeout2 t =
         liftIO $ noMessages alice "nothing else should be delivered to alice"
         liftIO $ noMessages bob "nothing else should be delivered to bob"
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testJoinConnectionAsyncReplyErrorV8 :: HasCallStack => ATransport -> IO ()
@@ -3087,7 +3088,7 @@ exchangeGreetings :: HasCallStack => AgentClient -> ConnId -> AgentClient -> Con
 exchangeGreetings = exchangeGreetings_ PQEncOn
 
 exchangeGreetings_ :: HasCallStack => PQEncryption -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
-exchangeGreetings_ pqEnc = exchangeGreetingsMsgId_ pqEnc 4
+exchangeGreetings_ pqEnc = exchangeGreetingsMsgId_ pqEnc 2
 
 exchangeGreetingsMsgId :: HasCallStack => Int64 -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 exchangeGreetingsMsgId = exchangeGreetingsMsgId_ PQEncOn
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 603ffd3c0..f5988672d 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -105,7 +105,7 @@ notificationTests t = do
   describe "Managing notification subscriptions" $ do
     describe "should create notification subscription for existing connection" $
       testNtfMatrix t testNotificationSubscriptionExistingConnection
-    xdescribe "should create notification subscription for new connection" $
+    describe "should create notification subscription for new connection" $
       testNtfMatrix t testNotificationSubscriptionNewConnection
     it "should change notifications mode" $
       withSmpServer t $
@@ -116,19 +116,19 @@ notificationTests t = do
         withAPNSMockServer $ \apns ->
           withNtfServer t $ testChangeToken apns
   describe "Notifications server store log" $
-    xit "should save and restore tokens and subscriptions" $
+    it "should save and restore tokens and subscriptions" $
       withSmpServer t $
         withAPNSMockServer $ \apns ->
           testNotificationsStoreLog t apns
   describe "Notifications after SMP server restart" $
-    xit "should resume subscriptions after SMP server is restarted" $
+    it "should resume subscriptions after SMP server is restarted" $
       withAPNSMockServer $ \apns ->
         withNtfServer t $ testNotificationsSMPRestart t apns
   describe "Notifications after SMP server restart" $
     it "should resume batched subscriptions after SMP server is restarted" $
       withAPNSMockServer $ \apns ->
         withNtfServer t $ testNotificationsSMPRestartBatch 100 t apns
-  xdescribe "should switch notifications to the new queue" $
+  describe "should switch notifications to the new queue" $
     testServerMatrix2 t $ \servers ->
       withAPNSMockServer $ \apns ->
         withNtfServer t $ testSwitchNotifications servers apns
@@ -146,7 +146,7 @@ notificationTests t = do
 testNtfMatrix :: HasCallStack => ATransport -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> Spec
 testNtfMatrix t runTest = do
   describe "next and current" $ do
-    xit "curr servers; curr clients" $ runNtfTestCfg t 1 cfg ntfServerCfg agentCfg agentCfg runTest
+    it "curr servers; curr clients" $ runNtfTestCfg t 1 cfg ntfServerCfg agentCfg agentCfg runTest
     it "curr servers; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
     it "prev servers; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
     it "prev servers; curr clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest
@@ -374,20 +374,20 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
   -- alice client already has subscription for the connection
   Left (CMD PROHIBITED _) <- runExceptT $ getNotificationMessage alice nonce message
 
-  threadDelay 200000
+  threadDelay 300000
   suspendAgent alice 0
   closeSQLiteStore store
-  threadDelay 200000
+  threadDelay 300000
 
   -- aliceNtf client doesn't have subscription and is allowed to get notification message
   withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do
     (_, [SMPMsgMeta {msgFlags = MsgFlags True}]) <- getNotificationMessage aliceNtf nonce message
     pure ()
 
-  threadDelay 200000
+  threadDelay 300000
   reopenSQLiteStore store
   foregroundAgent alice
-  threadDelay 200000
+  threadDelay 300000
 
   runRight_ $ do
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
@@ -515,7 +515,7 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
     -- no notifications should follow
     noNotification apnsQ
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testChangeToken :: APNSMockServer -> IO ()
@@ -554,7 +554,7 @@ testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers t
     -- no notifications should follow
     noNotification apnsQ
   where
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId
 
 testNotificationsStoreLog :: ATransport -> APNSMockServer -> IO ()
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index e05ff884d..6452d2677 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -101,26 +101,26 @@ smpProxyTests = do
         it "500x20" . twoServersFirstProxy $ 500 `inParrallel` deliver 20
     describe "agent API" $ do
       describe "one server" $ do
-        xit "always via proxy" . oneServer $
+        it "always via proxy" . oneServer $
           agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv1], SPMAlways, True) C.SEd448 "hello 1" "hello 2" 1
-        xit "without proxy" . oneServer $
+        it "without proxy" . oneServer $
           agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv1], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
       describe "two servers" $ do
-        xit "always via proxy" . twoServers $
+        it "always via proxy" . twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv2], SPMAlways, True) C.SEd448 "hello 1" "hello 2" 1
-        xit "both via proxy" . twoServers $
+        it "both via proxy" . twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMUnknown, True) C.SEd448 "hello 1" "hello 2" 1
-        xit "first via proxy" . twoServers $
+        it "first via proxy" . twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
-        xit "without proxy" . twoServers $
+        it "without proxy" . twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
-        xit "first via proxy for unknown" . twoServers $
+        it "first via proxy for unknown" . twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv1, srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2" 1
         it "without proxy with fallback" . twoServers_ proxyCfg cfgV7 $
           agentDeliverMessageViaProxy ([srv1], SPMUnknown, False) ([srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2" 3
         it "fails when fallback is prohibited" . twoServers_ proxyCfg cfgV7 $
           agentViaProxyVersionError
-        xit "retries sending when destination or proxy relay is offline" $
+        it "retries sending when destination or proxy relay is offline" $
           agentViaProxyRetryOffline
       describe "stress test 1k" $ do
         let deliver nAgents nMsgs = agentDeliverMessagesViaProxyConc (replicate nAgents [srv1]) (map bshow [1 :: Int .. nMsgs])
@@ -370,7 +370,7 @@ agentViaProxyRetryOffline = do
     a `up` cId = nGet a =##> \case ("", "", UP _ [c]) -> c == cId; _ -> False
     a `down` cId = nGet a =##> \case ("", "", DOWN _ [c]) -> c == cId; _ -> False
     aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
-    baseId = 3
+    baseId = 1
     msgId = subtract baseId . fst
     servers srv = (initAgentServersProxy SPMAlways SPFProhibit) {smp = userServers $ L.map noAuthSrv [srv]}
 

From 9d0774a58e3307892e0b38500fe96fb5d15d9def Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 3 Jul 2024 19:32:27 +0100
Subject: [PATCH 026/195] agent: add queue information (#1217)

* agent: add queue information to "debug delivery" response

* fix test

* rename

* encodings
---
 src/Simplex/Messaging/Agent.hs         |  5 ++---
 src/Simplex/Messaging/Agent/Client.hs  | 29 ++++++++++++++++++++------
 tests/AgentTests/FunctionalAPITests.hs |  4 ++--
 3 files changed, 27 insertions(+), 11 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 7764d16a3..c7b5f5390 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -174,7 +174,6 @@ import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
 import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), EntityId, ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, XFTPServerWithAuth, sndAuthKeySMPClientVersion)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPVersion, THandleParams (sessionId))
@@ -403,7 +402,7 @@ ackMessage :: AgentClient -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AE
 ackMessage c = withAgentEnv c .:. ackMessage' c
 {-# INLINE ackMessage #-}
 
-getConnectionQueueInfo :: AgentClient -> ConnId -> AE QueueInfo
+getConnectionQueueInfo :: AgentClient -> ConnId -> AE ServerQueueInfo
 getConnectionQueueInfo c = withAgentEnv c . getConnectionQueueInfo' c
 {-# INLINE getConnectionQueueInfo #-}
 
@@ -1542,7 +1541,7 @@ ackMessage' c connId msgId rcptInfo_ = withConnLock c connId "ackMessage" $ do
             withStore' c $ \db -> deleteDeliveredSndMsg db connId $ InternalId sndMsgId
           _ -> pure ()
 
-getConnectionQueueInfo' :: AgentClient -> ConnId -> AM QueueInfo
+getConnectionQueueInfo' :: AgentClient -> ConnId -> AM ServerQueueInfo
 getConnectionQueueInfo' c connId = do
   SomeConn _ conn <- withStore c (`getConn` connId)
   case conn of
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index c9db8e7a7..0467c31f8 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -89,6 +89,7 @@ module Simplex.Messaging.Agent.Client
     activeClientSession,
     agentClientStore,
     agentDRG,
+    ServerQueueInfo (..),
     AgentServersSummary (..),
     ServerSessions (..),
     SMPServerSubs (..),
@@ -173,7 +174,7 @@ import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as J
 import Data.Bifunctor (bimap, first, second)
-import Data.ByteString.Base64
+import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (isRight, partitionEithers)
@@ -1505,7 +1506,7 @@ showServer ProtocolServer {host, port} =
 {-# INLINE showServer #-}
 
 logSecret :: ByteString -> ByteString
-logSecret bs = encode $ B.take 3 bs
+logSecret bs = B64.encode $ B.take 3 bs
 {-# INLINE logSecret #-}
 
 sendConfirmation :: AgentClient -> SndQueue -> ByteString -> AM (Maybe SMPServer)
@@ -1625,10 +1626,24 @@ sendAgentMessage c sq@SndQueue {userId, server, sndId, sndPrivateKey} msgFlags a
   msg <- agentCbEncrypt sq Nothing $ smpEncode clientMsg
   sendOrProxySMPMessage c userId server "<MSG>" (Just sndPrivateKey) sndId msgFlags msg
 
-getQueueInfo :: AgentClient -> RcvQueue -> AM QueueInfo
-getQueueInfo c rq@RcvQueue {rcvId, rcvPrivateKey} =
-  withSMPClient c rq "QUE" $ \smp ->
-    getSMPQueueInfo smp rcvPrivateKey rcvId
+data ServerQueueInfo = ServerQueueInfo
+  { server :: SMPServer,
+    rcvId :: Text,
+    sndId :: Text,
+    ntfId :: Maybe Text,
+    status :: Text,
+    info :: QueueInfo
+  }
+  deriving (Show)
+
+getQueueInfo :: AgentClient -> RcvQueue -> AM ServerQueueInfo
+getQueueInfo c rq@RcvQueue {server, rcvId, rcvPrivateKey, sndId, status, clientNtfCreds} =
+  withSMPClient c rq "QUE" $ \smp -> do
+    info <- getSMPQueueInfo smp rcvPrivateKey rcvId
+    let ntfId = enc . (\ClientNtfCreds {notifierId} -> notifierId) <$> clientNtfCreds
+    pure ServerQueueInfo {server, rcvId = enc rcvId, sndId = enc sndId, ntfId, status = serializeQueueStatus status, info}
+  where
+    enc = decodeLatin1 . B64.encode
 
 agentNtfRegisterToken :: AgentClient -> NtfToken -> NtfPublicAuthKey -> C.PublicKeyX25519 -> AM (NtfTokenId, C.PublicKeyX25519)
 agentNtfRegisterToken c NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =
@@ -2249,3 +2264,5 @@ $(J.deriveJSON defaultJSON ''AgentQueuesInfo)
 $(J.deriveJSON (enumJSON $ dropPrefix "UN") ''UserNetworkType)
 
 $(J.deriveJSON defaultJSON ''UserNetworkInfo)
+
+$(J.deriveJSON defaultJSON ''ServerQueueInfo)
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 569901c77..9cf7c2793 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -78,7 +78,7 @@ import SMPAgentClient
 import SMPClient (cfg, prevRange, prevVersion, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerOn, withSmpServerProxy, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import qualified Simplex.Messaging.Agent as A
-import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), UserNetworkInfo (..), UserNetworkType (..), waitForUserNetwork)
+import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), ServerQueueInfo (..), UserNetworkInfo (..), UserNetworkType (..), waitForUserNetwork)
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore)
 import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, REQ, SENT)
 import qualified Simplex.Messaging.Agent.Protocol as A
@@ -3057,7 +3057,7 @@ testServerQueueInfo = do
       liftIO $ isJust r `shouldBe` True
       pure r
     checkQ c cId qiSnd' qiSubThread_ qiSize' msgType_ = do
-      QueueInfo {qiSnd, qiNtf, qiSub, qiSize, qiMsg} <- getConnectionQueueInfo c cId
+      ServerQueueInfo {info = QueueInfo {qiSnd, qiNtf, qiSub, qiSize, qiMsg}} <- getConnectionQueueInfo c cId
       liftIO $ do
         qiSnd `shouldBe` qiSnd'
         qiNtf `shouldBe` False

From 743676421db003036afdd183dd48fcf6f5e4c617 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 7 Jul 2024 21:17:12 +0100
Subject: [PATCH 027/195] ntf server: simplify and optimize subscriptions in
 server agent (#1219)

* increase queue size

* simplify

* refactor to optimize memory usage and performance

* comment

* refactor

* test delays
---
 src/Simplex/Messaging/Client/Agent.hs         | 190 +++++++++---------
 src/Simplex/Messaging/Notifications/Server.hs |  37 +---
 src/Simplex/Messaging/Server.hs               |   4 +-
 tests/AgentTests/FunctionalAPITests.hs        |   1 +
 tests/AgentTests/NotificationTests.hs         |   8 +-
 5 files changed, 110 insertions(+), 130 deletions(-)

diff --git a/src/Simplex/Messaging/Client/Agent.hs b/src/Simplex/Messaging/Client/Agent.hs
index e7c22eec2..99c77f67c 100644
--- a/src/Simplex/Messaging/Client/Agent.hs
+++ b/src/Simplex/Messaging/Client/Agent.hs
@@ -20,17 +20,15 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
-import Data.Bifunctor (bimap, first)
+import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-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 qualified Data.Set as S
 import Data.Text.Encoding
 import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
 import Data.Tuple (swap)
@@ -55,8 +53,8 @@ type SMPClientVar = SessionVar (Either (SMPClientError, Maybe UTCTime) (OwnServe
 data SMPClientAgentEvent
   = CAConnected SMPServer
   | CADisconnected SMPServer (Set SMPSub)
-  | CAResubscribed SMPServer (NonEmpty SMPSub)
-  | CASubError SMPServer (NonEmpty (SMPSub, SMPClientError))
+  | CASubscribed SMPServer SMPSubParty (NonEmpty QueueId)
+  | CASubError SMPServer SMPSubParty (NonEmpty (QueueId, SMPClientError))
 
 data SMPSubParty = SPRecipient | SPNotifier
   deriving (Eq, Ord, Show)
@@ -86,9 +84,9 @@ defaultSMPClientAgentConfig =
             maxInterval = 10 * second
           },
       persistErrorInterval = 30, -- seconds
-      msgQSize = 256,
-      agentQSize = 256,
-      agentSubsBatchSize = 900,
+      msgQSize = 1024,
+      agentQSize = 1024,
+      agentSubsBatchSize = 1360,
       ownServerDomains = []
     }
   where
@@ -192,7 +190,7 @@ getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, worke
 isOwnServer :: SMPClientAgent -> SMPServer -> OwnServer
 isOwnServer SMPClientAgent {agentCfg} ProtocolServer {host} =
   let srv = strEncode $ L.head host
-   in any (\s -> s == srv || (B.cons '.' s) `B.isSuffixOf` srv) (ownServerDomains agentCfg)
+   in any (\s -> s == srv || B.cons '.' s `B.isSuffixOf` srv) (ownServerDomains agentCfg)
 
 -- | Run an SMP client for SMPClientVar
 connectClient :: SMPClientAgent -> SMPServer -> SMPClientVar -> IO (Either SMPClientError SMPClient)
@@ -212,15 +210,9 @@ connectClient ca@SMPClientAgent {agentCfg, smpClients, smpSessions, msgQ, random
       where
         updateSubs sVar = do
           ss <- readTVar sVar
-          addPendingSubs sVar ss
+          addSubs_ (pendingSrvSubs ca) srv ss
           pure ss
 
-        addPendingSubs sVar ss = do
-          let ps = pendingSrvSubs ca
-          TM.lookup srv ps >>= \case
-            Just ss' -> TM.union ss ss'
-            _ -> TM.insert srv sVar ps
-
     serverDown :: Map SMPSub C.APrivateAuthKey -> IO ()
     serverDown ss = unless (M.null ss) $ do
       notify ca . CADisconnected srv $ M.keysSet ss
@@ -244,11 +236,11 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
     runSubWorker =
       withRetryInterval (reconnectInterval agentCfg) $ \_ loop -> do
         pending <- atomically getPending
-        forM_ pending $ \cs -> whenM (readTVarIO active) $ do
-          void $ tcpConnectTimeout `timeout` runExceptT (reconnectSMPClient ca srv cs)
+        unless (null pending) $ whenM (readTVarIO active) $ do
+          void $ tcpConnectTimeout `timeout` runExceptT (reconnectSMPClient ca srv pending)
           loop
     ProtocolClientConfig {networkConfig = NetworkConfig {tcpConnectTimeout}} = smpCfg agentCfg
-    getPending = mapM readTVar =<< TM.lookup srv (pendingSrvSubs ca)
+    getPending = maybe (pure M.empty) readTVar =<< TM.lookup srv (pendingSrvSubs ca)
     cleanup :: SessionVar (Async ()) -> STM ()
     cleanup v = do
       -- Here we wait until TMVar is not empty to prevent worker cleanup happening before worker is added to TMVar.
@@ -258,32 +250,22 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
 
 reconnectSMPClient :: SMPClientAgent -> SMPServer -> Map SMPSub C.APrivateAuthKey -> ExceptT SMPClientError IO ()
 reconnectSMPClient ca@SMPClientAgent {agentCfg} srv cs =
-  withSMP ca srv $ \smp -> do
-    subs' <- filterM (fmap not . atomically . hasSub (srvSubs ca) srv . fst) $ M.assocs cs
-    let (nSubs, rSubs) = partition (isNotifier . fst . fst) subs'
+  withSMP ca srv $ \smp -> liftIO $ do
+    currSubs <- atomically $ maybe (pure M.empty) readTVar =<< TM.lookup srv (srvSubs ca)
+    let (nSubs, rSubs) = foldr (groupSub currSubs) ([], []) $ M.assocs cs
     subscribe_ smp SPNotifier nSubs
     subscribe_ smp SPRecipient rSubs
   where
-    isNotifier = \case
-      SPNotifier -> True
-      SPRecipient -> False
-    subscribe_ :: SMPClient -> SMPSubParty -> [(SMPSub, C.APrivateAuthKey)] -> ExceptT SMPClientError IO ()
-    subscribe_ smp party = mapM_ subscribeBatch . toChunks (agentSubsBatchSize agentCfg)
+    groupSub :: Map SMPSub C.APrivateAuthKey -> (SMPSub, C.APrivateAuthKey) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)]) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)])
+    groupSub currSubs (s@(party, qId), k) (nSubs, rSubs)
+      | M.member s currSubs = (nSubs, rSubs)
+      | otherwise = case party of
+          SPNotifier -> (s' : nSubs, rSubs)
+          SPRecipient -> (nSubs, s' : rSubs)
       where
-        subscribeBatch subs' = do
-          let subs'' :: (NonEmpty (QueueId, C.APrivateAuthKey)) = L.map (first snd) subs'
-          rs <- liftIO $ smpSubscribeQueues party ca smp srv subs''
-          let rs' :: (NonEmpty ((SMPSub, C.APrivateAuthKey), Either SMPClientError ())) =
-                L.zipWith (first . const) subs' rs
-              rs'' :: [Either (SMPSub, SMPClientError) (SMPSub, C.APrivateAuthKey)] =
-                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_ (notify ca . CAResubscribed srv) $ L.nonEmpty $ map fst oks
-          mapM_ (atomically . removePendingSubscription ca srv . fst) finalErrs
-          mapM_ (notify ca . CASubError srv) $ L.nonEmpty finalErrs
-          mapM_ (throwE . snd) $ listToMaybe tempErrs
+        s' = (qId, k)
+    subscribe_ :: SMPClient -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> IO ()
+    subscribe_ smp party = mapM_ (smpSubscribeQueues party ca smp srv) . toChunks (agentSubsBatchSize agentCfg)
 
 notify :: MonadIO m => SMPClientAgent -> SMPClientAgentEvent -> m ()
 notify ca evt = atomically $ writeTBQueue (agentQ ca) evt
@@ -297,7 +279,8 @@ getConnectedSMPServerClient SMPClientAgent {smpClients} srv =
     $>>= \case
       (_, Right r) -> pure $ Just $ Right r
       (v, Left (e, ts_)) ->
-        pure ts_ $>>= \ts ->  -- proxy will create a new connection if ts_ is Nothing
+        pure ts_ $>>= \ts ->
+          -- proxy will create a new connection if ts_ is Nothing
           ifM
             ((ts <) <$> liftIO getCurrentTime) -- error persistence interval period expired?
             (Nothing <$ atomically (removeSessVar v srv smpClients)) -- proxy will create a new connection
@@ -334,86 +317,99 @@ withSMP ca srv action = (getSMPServerClient' ca srv >>= action) `catchE` logSMPE
       liftIO $ putStrLn $ "SMP error (" <> show srv <> "): " <> show e
       throwE e
 
-subscribeQueue :: SMPClientAgent -> SMPServer -> (SMPSub, C.APrivateAuthKey) -> ExceptT SMPClientError IO ()
-subscribeQueue ca srv sub = do
-  atomically $ addPendingSubscription ca srv sub
-  withSMP ca srv $ \smp -> subscribe_ smp `catchE` handleErr
-  where
-    subscribe_ smp = do
-      smpSubscribe smp sub
-      atomically $ addSubscription ca srv sub
-
-    handleErr e = do
-      atomically . when (e /= PCENetworkError && e /= PCEResponseTimeout) $
-        removePendingSubscription ca srv (fst sub)
-      throwE e
-
-subscribeQueuesSMP :: SMPClientAgent -> SMPServer -> NonEmpty (RecipientId, RcvPrivateAuthKey) -> IO (NonEmpty (RecipientId, Either SMPClientError ()))
+subscribeQueuesSMP :: SMPClientAgent -> SMPServer -> NonEmpty (RecipientId, RcvPrivateAuthKey) -> IO ()
 subscribeQueuesSMP = subscribeQueues_ SPRecipient
 
-subscribeQueuesNtfs :: SMPClientAgent -> SMPServer -> NonEmpty (NotifierId, NtfPrivateAuthKey) -> IO (NonEmpty (NotifierId, Either SMPClientError ()))
+subscribeQueuesNtfs :: SMPClientAgent -> SMPServer -> NonEmpty (NotifierId, NtfPrivateAuthKey) -> IO ()
 subscribeQueuesNtfs = subscribeQueues_ SPNotifier
 
-subscribeQueues_ :: SMPSubParty -> SMPClientAgent -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO (NonEmpty (QueueId, Either SMPClientError ()))
+subscribeQueues_ :: SMPSubParty -> SMPClientAgent -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
 subscribeQueues_ party ca srv subs = do
-  atomically $ forM_ subs $ addPendingSubscription ca srv . first (party,)
+  atomically $ addPendingSubs ca srv party $ L.toList subs
   runExceptT (getSMPServerClient' ca srv) >>= \case
-    Left e -> pure $ L.map ((,Left e) . fst) subs
     Right smp -> smpSubscribeQueues party ca smp srv subs
+    Left _ -> pure () -- no call to reconnectClient - failing getSMPServerClient' does that
 
-smpSubscribeQueues :: SMPSubParty -> SMPClientAgent -> SMPClient -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO (NonEmpty (QueueId, Either SMPClientError ()))
+smpSubscribeQueues :: SMPSubParty -> SMPClientAgent -> SMPClient -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
 smpSubscribeQueues party ca smp srv subs = do
-  rs <- L.zip subs <$> subscribe smp (L.map swap subs)
-  atomically $ forM rs $ \(sub, r) ->
-    (fst sub,) <$> case r of
-      Right () -> do
-        addSubscription ca srv $ first (party,) sub
-        pure $ Right ()
-      Left e -> do
-        when (e /= PCENetworkError && e /= PCEResponseTimeout) $
-          removePendingSubscription ca srv (party, fst sub)
-        pure $ Left e
+  rs <- subscribe smp $ L.map swap subs
+  rs' <-
+    atomically $
+      ifM
+        (activeClientSession ca smp srv)
+        (Just <$> processSubscriptions rs)
+        (pure Nothing)
+  case rs' of
+    Just (tempErrs, finalErrs, oks, _) -> do
+      notify_ CASubscribed $ map fst oks
+      notify_ CASubError finalErrs
+      when tempErrs $ reconnectClient ca srv
+    Nothing -> reconnectClient ca srv
   where
+    processSubscriptions :: NonEmpty (Either SMPClientError ()) -> STM (Bool, [(QueueId, SMPClientError)], [(QueueId, C.APrivateAuthKey)], [QueueId])
+    processSubscriptions rs = do
+      pending <- maybe (pure M.empty) readTVar =<< TM.lookup srv (pendingSrvSubs ca)
+      let acc@(_, _, oks, notPending) = foldr (groupSub pending) (False, [], [], []) (L.zip subs rs)
+      unless (null oks) $ addSubscriptions ca srv party oks
+      unless (null notPending) $ removePendingSubs ca srv party notPending
+      pure acc
+    groupSub :: Map SMPSub C.APrivateAuthKey -> ((QueueId, C.APrivateAuthKey), Either SMPClientError ()) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, C.APrivateAuthKey)], [QueueId]) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, C.APrivateAuthKey)], [QueueId])
+    groupSub pending (s@(qId, _), r) acc@(!tempErrs, finalErrs, oks, notPending) = case r of
+      Right ()
+        | M.member (party, qId) pending -> (tempErrs, finalErrs, s : oks, qId : notPending)
+        | otherwise -> acc
+      Left e
+        | temporaryClientError e -> (True, finalErrs, oks, notPending)
+        | otherwise -> (tempErrs, (qId, e) : finalErrs, oks, qId : notPending)
     subscribe = case party of
       SPRecipient -> subscribeSMPQueues
       SPNotifier -> subscribeSMPQueuesNtfs
+    notify_ :: (SMPServer -> SMPSubParty -> NonEmpty a -> SMPClientAgentEvent) -> [a] -> IO ()
+    notify_ evt qs = mapM_ (notify ca . evt srv party) $ L.nonEmpty qs
+
+activeClientSession :: SMPClientAgent -> SMPClient -> SMPServer -> STM Bool
+activeClientSession ca smp srv = sameSess <$> tryReadSessVar srv (smpClients ca)
+  where
+    sessId = sessionId . thParams
+    sameSess = \case
+      Just (Right (_, smp')) -> sessId smp == sessId smp'
+      _ -> False
 
 showServer :: SMPServer -> ByteString
 showServer ProtocolServer {host, port} =
   strEncode host <> B.pack (if null port then "" else ':' : port)
 
-smpSubscribe :: SMPClient -> (SMPSub, C.APrivateAuthKey) -> ExceptT SMPClientError IO ()
-smpSubscribe smp ((party, queueId), privKey) = subscribe_ smp privKey queueId
+addSubscriptions :: SMPClientAgent -> SMPServer -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> STM ()
+addSubscriptions = addSubsList_ . srvSubs
+{-# INLINE addSubscriptions #-}
+
+addPendingSubs :: SMPClientAgent -> SMPServer -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> STM ()
+addPendingSubs = addSubsList_ . pendingSrvSubs
+{-# INLINE addPendingSubs #-}
+
+addSubsList_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> STM ()
+addSubsList_ subs srv party ss = addSubs_ subs srv ss'
   where
-    subscribe_ = case party of
-      SPRecipient -> subscribeSMPQueue
-      SPNotifier -> subscribeSMPQueueNotifications
+    ss' = M.fromList $ map (first (party,)) ss
 
-addSubscription :: SMPClientAgent -> SMPServer -> (SMPSub, C.APrivateAuthKey) -> STM ()
-addSubscription ca srv sub = do
-  addSub_ (srvSubs ca) srv sub
-  removePendingSubscription ca srv $ fst sub
-
-addPendingSubscription :: SMPClientAgent -> SMPServer -> (SMPSub, C.APrivateAuthKey) -> STM ()
-addPendingSubscription = addSub_ . pendingSrvSubs
-
-addSub_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> (SMPSub, C.APrivateAuthKey) -> STM ()
-addSub_ subs srv (s, key) =
+addSubs_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> Map SMPSub C.APrivateAuthKey -> STM ()
+addSubs_ subs srv ss =
   TM.lookup srv subs >>= \case
-    Just m -> TM.insert s key m
-    _ -> TM.singleton s key >>= \v -> TM.insert srv v subs
+    Just m -> TM.union ss m
+    _ -> newTVar ss >>= \v -> TM.insert srv v subs
 
 removeSubscription :: SMPClientAgent -> SMPServer -> SMPSub -> STM ()
 removeSubscription = removeSub_ . srvSubs
-
-removePendingSubscription :: SMPClientAgent -> SMPServer -> SMPSub -> STM ()
-removePendingSubscription = removeSub_ . pendingSrvSubs
+{-# INLINE removeSubscription #-}
 
 removeSub_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSub -> STM ()
 removeSub_ subs srv s = TM.lookup srv subs >>= mapM_ (TM.delete s)
 
-getSubKey :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSub -> STM (Maybe C.APrivateAuthKey)
-getSubKey subs srv s = TM.lookup srv subs $>>= TM.lookup s
+removePendingSubs :: SMPClientAgent -> SMPServer -> SMPSubParty -> [QueueId] -> STM ()
+removePendingSubs = removeSubs_ . pendingSrvSubs
+{-# INLINE removePendingSubs #-}
 
-hasSub :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSub -> STM Bool
-hasSub subs srv s = maybe (pure False) (TM.member s) =<< TM.lookup srv subs
+removeSubs_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSubParty -> [QueueId] -> STM ()
+removeSubs_ subs srv party qs = TM.lookup srv subs >>= mapM_ (`modifyTVar'` (`M.withoutKeys` ss))
+  where
+    ss = S.fromList $ map (party,) qs
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 5d3b4d806..2bf8dbcbf 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -188,33 +188,16 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
     runSMPSubscriber :: SMPSubscriber -> M ()
     runSMPSubscriber SMPSubscriber {newSubQ = subscriberSubQ} =
       forever $ do
-        subs <- atomically (peekTQueue subscriberSubQ)
+        subs <- atomically $ readTQueue 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 srv subs'
-        (subs'', oks, errs) <- foldM process ([], 0, []) rs
-        atomically $ do
-          void $ readTQueue subscriberSubQ
-          mapM_ (writeTQueue subscriberSubQ . L.map NtfSub) $ L.nonEmpty subs''
-        logSubStatus srv "retrying" $ length subs''
-        logSubStatus srv "subscribed" oks
-        logSubErrors srv errs
-      where
-        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
+        liftIO $ subscribeQueues srv subs'
 
     -- \| Subscribe to queues. The list of results can have a different order.
-    subscribeQueues :: SMPServer -> NonEmpty NtfSubData -> IO (NonEmpty (NtfSubData, Either SMPClientError ()))
-    subscribeQueues srv subs =
-      L.zipWith (\s r -> (s, snd r)) subs <$> subscribeQueuesNtfs ca srv (L.map sub subs)
+    subscribeQueues :: SMPServer -> NonEmpty NtfSubData -> IO ()
+    subscribeQueues srv subs = subscribeQueuesNtfs ca srv (L.map sub subs)
       where
         sub NtfSubData {smpQueue = SMPQueueNtf {notifierId}, notifierKey} = (notifierId, notifierKey)
 
@@ -239,7 +222,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
               incNtfStat ntfReceived
             Right SMP.END -> updateSubStatus smpQueue NSEnd
             Right (SMP.ERR e) -> logError $ "SMP server error: " <> tshow e
-            Right _ -> logError $ "SMP server unexpected response"
+            Right _ -> logError "SMP server unexpected response"
             Left e -> logError $ "SMP client error: " <> tshow e
 
     receiveAgent =
@@ -252,11 +235,11 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
             forM_ subs $ \(_, ntfId) -> do
               let smpQueue = SMPQueueNtf srv ntfId
               updateSubStatus smpQueue NSInactive
-          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)
+          CASubscribed srv _ subs -> do
+            forM_ subs $ \ntfId -> updateSubStatus (SMPQueueNtf srv ntfId) NSActive
+            logSubStatus srv "subscribed" $ length subs
+          CASubError srv _ errs ->
+            forM errs (\(ntfId, err) -> handleSubError (SMPQueueNtf srv ntfId) err)
               >>= logSubErrors srv . catMaybes . L.toList
 
     logSubStatus srv event n =
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index e96e8b582..a85036978 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -193,8 +193,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           CAConnected srv -> logInfo $ "SMP server connected " <> showServer' srv
           CADisconnected srv [] -> logInfo $ "SMP server disconnected " <> showServer' srv
           CADisconnected srv subs -> logError $ "SMP server disconnected " <> showServer' srv <> " / subscriptions: " <> tshow (length subs)
-          CAResubscribed srv subs -> logError $ "SMP server resubscribed " <> showServer' srv <> " / subscriptions: " <> tshow (length subs)
-          CASubError srv errs -> logError $ "SMP server subscription errors " <> showServer' srv <> " / errors: " <> tshow (length errs)
+          CASubscribed srv _ subs -> logError $ "SMP server subscribed " <> showServer' srv <> " / subscriptions: " <> tshow (length subs)
+          CASubError srv _ errs -> logError $ "SMP server subscription errors " <> showServer' srv <> " / errors: " <> tshow (length errs)
       where
         showServer' = decodeLatin1 . strEncode . host
 
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 9cf7c2793..71fc2c6f0 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -1038,6 +1038,7 @@ testIncreaseConnAgentVersionStartDifferentVersion t = do
     -- version increases to max compatible
 
     disposeAgentClient alice
+    threadDelay 250000
     alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
 
     runRight_ $ do
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index f5988672d..a104c6cf5 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -374,20 +374,20 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
   -- alice client already has subscription for the connection
   Left (CMD PROHIBITED _) <- runExceptT $ getNotificationMessage alice nonce message
 
-  threadDelay 300000
+  threadDelay 500000
   suspendAgent alice 0
   closeSQLiteStore store
-  threadDelay 300000
+  threadDelay 500000
 
   -- aliceNtf client doesn't have subscription and is allowed to get notification message
   withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do
     (_, [SMPMsgMeta {msgFlags = MsgFlags True}]) <- getNotificationMessage aliceNtf nonce message
     pure ()
 
-  threadDelay 300000
+  threadDelay 500000
   reopenSQLiteStore store
   foregroundAgent alice
-  threadDelay 300000
+  threadDelay 500000
 
   runRight_ $ do
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False

From 6e76221e079d125925c261a3ed09b4b94d50d6a1 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 8 Jul 2024 21:47:42 +0100
Subject: [PATCH 028/195] agent: fix possible dead lock between sending and
 receiving messages, stress test for message delivery (#1224)

* agent: fix possible dead lock between sending and receiving messages, stress test for message delivery

* deliver events after the lock is released

* delayed delivery in command processing too

* tests: increase message expiration time
---
 src/Simplex/Messaging/Agent.hs          |  36 ++++++---
 src/Simplex/Messaging/Server/Env/STM.hs |   1 -
 src/Simplex/Messaging/Server/Main.hs    |   1 -
 tests/AgentTests/FunctionalAPITests.hs  | 103 ++++++++++++++++++++++--
 tests/SMPClient.hs                      |   1 -
 5 files changed, 121 insertions(+), 21 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index c7b5f5390..2262a96e5 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1126,10 +1126,14 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
     lift $ waitForWork doWork
     atomically $ throwWhenInactive c
     atomically $ beginAgentOperation c AOSndNetwork
-    withWork c doWork (`getPendingServerCommand` server_) $ processCmd (riFast ri)
+    withWork c doWork (`getPendingServerCommand` server_) $ runProcessCmd (riFast ri)
   where
-    processCmd :: RetryInterval -> PendingCommand -> AM ()
-    processCmd ri PendingCommand {cmdId, corrId, userId, connId, command} = case command of
+    runProcessCmd ri cmd = do
+      pending <- newTVarIO []
+      processCmd ri cmd pending
+      mapM_ (atomically . writeTBQueue subQ) . reverse =<< readTVarIO pending
+    processCmd :: RetryInterval -> PendingCommand -> TVar [ATransmission] -> AM ()
+    processCmd ri PendingCommand {cmdId, corrId, userId, connId, command} pendingCmds = case command of
       AClientCommand cmd -> case cmd of
         NEW enableNtfs (ACM cMode) pqEnc subMode -> noServer $ do
           usedSrvs <- newTVarIO ([] :: [SMPServer])
@@ -1145,7 +1149,7 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
         LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK
         ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK
         SWCH ->
-          noServer . tryCommand . withConnLock c connId "switchConnection" $
+          noServer . tryWithLock "switchConnection" $
             withStore c (`getConn` connId) >>= \case
               SomeConn _ conn@(DuplexConnection _ (replaced :| _rqs) _) ->
                 switchDuplexConnection c conn replaced >>= notify . SWITCH QDRcv SPStarted
@@ -1247,7 +1251,9 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
         internalErr s = cmdError $ INTERNAL $ s <> ": " <> show (agentCommandTag command)
         cmdError e = notify (ERR e) >> withStore' c (`deleteCommand` cmdId)
         notify :: forall e. AEntityI e => AEvent e -> AM ()
-        notify cmd = atomically $ writeTBQueue subQ (corrId, connId, AEvt (sAEntity @e) cmd)
+        notify cmd =
+          let t = (corrId, connId, AEvt (sAEntity @e) cmd)
+           in atomically $ ifM (isFullTBQueue subQ) (modifyTVar' pendingCmds (t :)) (writeTBQueue subQ t)
 -- ^ ^ ^ async command processing /
 
 enqueueMessages :: AgentClient -> ConnData -> NonEmpty SndQueue -> MsgFlags -> AMessage -> AM (AgentMsgId, PQEncryption)
@@ -2159,7 +2165,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
   forM_ ts $ \(entId, t) -> case t of
     STEvent msgOrErr ->
       withRcvConn entId $ \rq@RcvQueue {connId} conn -> case msgOrErr of
-        Right msg -> processSMP rq conn (toConnData conn) msg
+        Right msg -> runProcessSMP rq conn (toConnData conn) msg
         Left e -> lift $ notifyErr connId e
     STResponse (Cmd SRecipient cmd) respOrErr ->
       withRcvConn entId $ \rq conn -> case cmd of
@@ -2167,11 +2173,11 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
           Right SMP.OK -> processSubOk rq upConnIds
           Right msg@SMP.MSG {} -> do
             processSubOk rq upConnIds -- the connection is UP even when processing this particular message fails
-            processSMP rq conn (toConnData conn) msg
+            runProcessSMP rq conn (toConnData conn) msg
           Right r -> processSubErr rq $ unexpectedResponse r
           Left e -> unless (temporaryClientError e) $ processSubErr rq e -- timeout/network was already reported
         SMP.ACK _ -> case respOrErr of
-          Right msg@SMP.MSG {} -> processSMP rq conn (toConnData conn) msg
+          Right msg@SMP.MSG {} -> runProcessSMP rq conn (toConnData conn) msg
           _ -> pure () -- TODO process OK response to ACK
         _ -> pure () -- TODO process expired response to DEL
     STResponse {} -> pure () -- TODO process expired responses to sent messages
@@ -2209,12 +2215,18 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
     notify' connId msg = atomically $ writeTBQueue subQ ("", connId, AEvt (sAEntity @e) msg)
     notifyErr :: ConnId -> SMPClientError -> AM' ()
     notifyErr connId = notify' connId . ERR . protocolClientError SMP (B.unpack $ strEncode srv)
-    processSMP :: forall c. RcvQueue -> Connection c -> ConnData -> BrokerMsg -> AM ()
+    runProcessSMP :: RcvQueue -> Connection c -> ConnData -> BrokerMsg -> AM ()
+    runProcessSMP rq conn cData msg = do
+      pending <- newTVarIO []
+      processSMP rq conn cData msg pending
+      mapM_ (atomically . writeTBQueue subQ) . reverse =<< readTVarIO pending
+    processSMP :: forall c. RcvQueue -> Connection c -> ConnData -> BrokerMsg -> TVar [ATransmission] -> AM ()
     processSMP
       rq@RcvQueue {rcvId = rId, sndSecure, e2ePrivKey, e2eDhSecret, status}
       conn
       cData@ConnData {connId, connAgentVersion, ratchetSyncState = rss}
-      smpMsg =
+      smpMsg
+      pendingMsgs =
         withConnLock c connId "processSMP" $ case smpMsg of
           SMP.MSG msg@SMP.RcvMessage {msgId = srvMsgId} -> do
             atomically $ incSMPServerStat c userId srv recvMsgs
@@ -2395,7 +2407,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
           r -> unexpected r
         where
           notify :: forall e m. (AEntityI e, MonadIO m) => AEvent e -> m ()
-          notify = notify' connId
+          notify msg =
+            let t = ("", connId, AEvt (sAEntity @e) msg)
+             in atomically $ ifM (isFullTBQueue subQ) (modifyTVar' pendingMsgs (t :)) (writeTBQueue subQ t)
 
           prohibited :: Text -> AM ()
           prohibited s = do
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 4217ea9b9..559aea280 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -47,7 +47,6 @@ data ServerConfig = ServerConfig
   { transports :: [(ServiceName, ATransport)],
     smpHandshakeTimeout :: Int,
     tbqSize :: Natural,
-    -- serverTbqSize :: Natural,
     msgQueueQuota :: Int,
     queueIdBytes :: Int,
     msgIdBytes :: Int,
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 7af57ba25..04e14544c 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -255,7 +255,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
             { transports = iniTransports ini,
               smpHandshakeTimeout = 120000000,
               tbqSize = 64,
-              -- serverTbqSize = 1024,
               msgQueueQuota = 128,
               queueIdBytes = 24,
               msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 71fc2c6f0..00a6e1c55 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -263,6 +263,11 @@ functionalAPITests t = do
       withSmpServer t testAgentClient3
     it "should establish connection without PQ encryption and enable it" $
       withSmpServer t testEnablePQEncryption
+  describe "Duplex connection - delivery stress test" $ do
+    describe "one way (50)" $ testMatrix2Stress t $ runAgentClientStressTestOneWay 50
+    xdescribe "one way (1000)" $ testMatrix2Stress t $ runAgentClientStressTestOneWay 1000
+    describe "two way concurrently (50)" $ testMatrix2Stress t $ runAgentClientStressTestConc 25
+    xdescribe "two way concurrently (1000)" $ testMatrix2Stress t $ runAgentClientStressTestConc 500
   describe "Establishing duplex connection, different PQ settings" $ do
     testPQMatrix2 t $ runAgentClientTestPQ True
   describe "Establishing duplex connection v2, different Ratchet versions" $
@@ -482,6 +487,19 @@ testMatrix2 t runTest = do
   it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff False
   it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff False
 
+testMatrix2Stress :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testMatrix2Stress t runTest = do
+  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aCfg aCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
+  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aProxyCfgV8 aProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
+  it "current" $ withSmpServer t $ runTestCfg2 aCfg aCfg 1 $ runTest PQSupportOn False
+  it "prev" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfgVPrev 3 $ runTest PQSupportOff False
+  it "prev to current" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfg 3 $ runTest PQSupportOff False
+  it "current to prev" $ withSmpServer t $ runTestCfg2 aCfg aCfgVPrev 3 $ runTest PQSupportOff False
+  where
+    aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
+    aProxyCfgV8 = agentProxyCfgV8 {messageRetryInterval = fastMessageRetryInterval}
+    aCfgVPrev = agentCfgVPrev {messageRetryInterval = fastMessageRetryInterval}
+
 testBasicMatrix2 :: HasCallStack => ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testBasicMatrix2 t runTest = do
   it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest
@@ -616,6 +634,71 @@ runAgentClientTestPQ viaProxy (alice, aPQ) (bob, bPQ) baseId =
 pqConnectionMode :: InitialKeys -> PQSupport -> Bool
 pqConnectionMode pqMode1 pqMode2 = supportPQ (CR.connPQEncryption pqMode1) && supportPQ pqMode2
 
+runAgentClientStressTestOneWay :: HasCallStack => Int64 -> PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientStressTestOneWay n pqSupport viaProxy alice bob baseId = runRight_ $ do
+  let pqEnc = PQEncryption $ supportPQ pqSupport
+  (aliceId, bobId) <- makeConnection_ pqSupport alice bob
+  let proxySrv = if viaProxy then Just testSMPServer else Nothing
+      message i = "message " <> bshow i
+  concurrently_
+    ( forM_ ([1 .. n] :: [Int64]) $ \i -> do
+        mId <- msgId <$> A.sendMessage alice bobId pqEnc SMP.noMsgFlags (message i)
+        liftIO $ do
+          mId >= i `shouldBe` True
+          let getEvent =
+                get alice >>= \case
+                  ("", c, A.SENT mId' srv) -> c == bobId && mId' >= baseId + i && srv == proxySrv `shouldBe` True
+                  ("", c, QCONT) -> do
+                    c == bobId `shouldBe` True
+                    getEvent
+                  r -> expectationFailure $ "wrong message: " <> show r
+          getEvent
+    )
+    ( forM_ ([1 .. n] :: [Int64]) $ \i -> do
+        get bob >>= \case
+          ("", c, Msg' mId pq msg) -> do
+            liftIO $ c == aliceId && mId >= baseId + i && pq == pqEnc && msg == message i `shouldBe` True
+            ackMessage bob aliceId mId Nothing
+          r -> liftIO $ expectationFailure $ "wrong message: " <> show r
+    )
+  liftIO $ noMessagesIngoreQCONT alice "nothing else should be delivered to alice"
+  liftIO $ noMessagesIngoreQCONT bob "nothing else should be delivered to bob"
+  where
+    msgId = subtract baseId . fst
+
+runAgentClientStressTestConc :: HasCallStack => Int64 -> PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientStressTestConc n pqSupport viaProxy alice bob baseId = runRight_ $ do
+  let pqEnc = PQEncryption $ supportPQ pqSupport
+  (aliceId, bobId) <- makeConnection_ pqSupport alice bob
+  let proxySrv = if viaProxy then Just testSMPServer else Nothing
+      message i = "message " <> bshow i
+      loop a bId mIdVar i = do
+        when (i <= n) $ do
+          mId <- msgId <$> A.sendMessage a bId pqEnc SMP.noMsgFlags (message i)
+          liftIO $ mId >= i `shouldBe` True
+        let getEvent = do
+              get a >>= \case
+                ("", c, A.SENT _ srv) -> liftIO $ c == bId && srv == proxySrv `shouldBe` True
+                ("", c, QCONT) -> do
+                  liftIO $ c == bId `shouldBe` True
+                  getEvent
+                ("", c, Msg' mId pq msg) -> do
+                  -- tests that mId increases
+                  liftIO $ (mId >) <$> atomically (swapTVar mIdVar mId) `shouldReturn` True
+                  liftIO $ c == bId && pq == pqEnc && ("message " `B.isPrefixOf` msg) `shouldBe` True
+                  ackMessage a bId mId Nothing
+                r -> liftIO $ expectationFailure $ "wrong message: " <> show r
+        getEvent
+  amId <- newTVarIO 0
+  bmId <- newTVarIO 0
+  concurrently_
+    (forM_ ([1 .. n * 2] :: [Int64]) $ loop alice bobId amId)
+    (forM_ ([1 .. n * 2] :: [Int64]) $ loop bob aliceId bmId)
+  liftIO $ noMessagesIngoreQCONT alice "nothing else should be delivered to alice"
+  liftIO $ noMessagesIngoreQCONT bob "nothing else should be delivered to bob"
+  where
+    msgId = subtract baseId . fst
+
 testEnablePQEncryption :: HasCallStack => IO ()
 testEnablePQEncryption =
   withAgentClients2 $ \ca cb -> runRight_ $ do
@@ -789,10 +872,17 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId
       ackMessage a bId (baseId + 2) Nothing
 
 noMessages :: HasCallStack => AgentClient -> String -> Expectation
-noMessages c err = tryGet `shouldReturn` ()
+noMessages = noMessages_ False
+
+noMessagesIngoreQCONT :: AgentClient -> String -> Expectation
+noMessagesIngoreQCONT = noMessages_ True
+
+noMessages_ :: Bool -> HasCallStack => AgentClient -> String -> Expectation
+noMessages_ ingoreQCONT c err = tryGet `shouldReturn` ()
   where
     tryGet =
       10000 `timeout` get c >>= \case
+        Just (_, _, QCONT) | ingoreQCONT -> noMessages_ ingoreQCONT c err
         Just msg -> error $ err <> ": " <> show msg
         _ -> return ()
 
@@ -1194,7 +1284,6 @@ testDeliveryAfterSubscriptionError t = do
   withAgentClients2 $ \a b -> do
     Left (BROKER _ NETWORK) <- runExceptT $ subscribeConnection a bId
     Left (BROKER _ NETWORK) <- runExceptT $ subscribeConnection b aId
-    pure ()
     withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
       withUP a bId $ \case ("", c, SENT 2) -> c == bId; _ -> False
       withUP b aId $ \case ("", c, Msg "hello") -> c == aId; _ -> False
@@ -1230,13 +1319,13 @@ testMsgDeliveryQuotaExceeded t =
 
 testExpireMessage :: HasCallStack => ATransport -> IO ()
 testExpireMessage t =
-  withAgent 1 agentCfg {messageTimeout = 1, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB $ \a ->
+  withAgent 1 agentCfg {messageTimeout = 1.5, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB $ \a ->
     withAgent 2 agentCfg initAgentServers testDB2 $ \b -> do
       (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ makeConnection a b
       nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
       nGet b =##> \case ("", "", DOWN _ [c]) -> c == aId; _ -> False
       2 <- runRight $ sendMessage a bId SMP.noMsgFlags "1"
-      threadDelay 1000000
+      threadDelay 1500000
       3 <- runRight $ sendMessage a bId SMP.noMsgFlags "2" -- this won't expire
       get a =##> \case ("", c, MERR 2 (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
       withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
@@ -1246,7 +1335,7 @@ testExpireMessage t =
 
 testExpireManyMessages :: HasCallStack => ATransport -> IO ()
 testExpireManyMessages t =
-  withAgent 1 agentCfg {messageTimeout = 1, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB $ \a ->
+  withAgent 1 agentCfg {messageTimeout = 1.5, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB $ \a ->
     withAgent 2 agentCfg initAgentServers testDB2 $ \b -> do
       (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ makeConnection a b
       runRight_ $ do
@@ -1255,7 +1344,7 @@ testExpireManyMessages t =
         2 <- sendMessage a bId SMP.noMsgFlags "1"
         3 <- sendMessage a bId SMP.noMsgFlags "2"
         4 <- sendMessage a bId SMP.noMsgFlags "3"
-        liftIO $ threadDelay 1000000
+        liftIO $ threadDelay 1500000
         5 <- sendMessage a bId SMP.noMsgFlags "4" -- this won't expire
         get a =##> \case ("", c, MERR 2 (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
         -- get a =##> \case ("", c, MERRS [5, 6] (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
@@ -1275,7 +1364,7 @@ testExpireManyMessages t =
         withUP b aId $ \case ("", _, MsgErr 2 (MsgSkipped 2 4) "4") -> True; _ -> False
         ackMessage b aId 2 Nothing
 
-withUP :: AgentClient -> ConnId -> (AEntityTransmission 'AEConn -> Bool) -> ExceptT AgentErrorType IO ()
+withUP :: HasCallStack => AgentClient -> ConnId -> (AEntityTransmission 'AEConn -> Bool) -> ExceptT AgentErrorType IO ()
 withUP a bId p =
   liftIO $
     getInAnyOrder
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 144ad8b10..736016b3b 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -100,7 +100,6 @@ cfg =
     { transports = [],
       smpHandshakeTimeout = 60000000,
       tbqSize = 1,
-      -- serverTbqSize = 1,
       msgQueueQuota = 4,
       queueIdBytes = 24,
       msgIdBytes = 24,

From 21abc5cabe371e0b111f04984689457269ff10f1 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 8 Jul 2024 23:12:01 +0100
Subject: [PATCH 029/195] smp server: reduce the number of threads by
 delivering message to subscription when it is sent (#1222)

* smp server: reduce the number of threads by delivering message to subscription when it is sent

* test delay

* test delay
---
 src/Simplex/Messaging/Server.hs              | 92 +++++++++++++-------
 src/Simplex/Messaging/Server/MsgStore/STM.hs |  4 +-
 tests/AgentTests/FunctionalAPITests.hs       |  3 +-
 tests/ServerTests.hs                         | 20 +++--
 4 files changed, 76 insertions(+), 43 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index a85036978..567ff13b6 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -683,7 +683,7 @@ forkClient Client {endThreads, endThreadSeq} label action = do
   mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId
 
 client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
-client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, notifiers} = do
+client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers, notifiers} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
   forever $
     atomically (readTBQueue rcvQ)
@@ -921,7 +921,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             deliver sub = do
               q <- getStoreMsgQueue "SUB" rId
               msg_ <- atomically $ tryPeekMsg q
-              deliverMessage "SUB" qr rId sub q msg_
+              deliverMessage "SUB" qr rId sub msg_
 
         getMessage :: QueueRec -> M (Transmission BrokerMsg)
         getMessage qr = time "GET" $ do
@@ -978,7 +978,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                     _ -> do
                       (deletedMsg_, msg_) <- atomically $ tryDelPeekMsg q msgId
                       mapM_ updateStats deletedMsg_
-                      deliverMessage "ACK" qr queueId sub q msg_
+                      deliverMessage "ACK" qr queueId sub msg_
                 _ -> pure $ err NO_MSG
           where
             getDelivered :: TVar Sub -> STM (Maybe Sub)
@@ -1024,7 +1024,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                         Nothing -> do
                           atomically $ modifyTVar' (msgSentQuota stats) (+ 1)
                           pure $ err QUOTA
-                        Just msg -> time "SEND ok" $ do
+                        Just (msg, wasEmpty) -> time "SEND ok" $ do
+                          when wasEmpty $ tryDeliverMessage msg
                           when (notification msgFlags) $ do
                             forM_ (notifier qr) $ \ntf -> do
                               asks random >>= atomically . trySendNotification ntf msg >>= \case
@@ -1058,6 +1059,53 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 stats <- asks serverStats
                 atomically $ modifyTVar' (msgExpired stats) (+ deleted)
 
+            -- The condition for delivery of the message is:
+            -- - the queue was empty when the message was sent,
+            -- - there is subscribed recipient,
+            -- - no message was "delivered" that was not acknowledged.
+            -- If the send queue of the subscribed client is not full the message is put there in the same transaction.
+            -- If the queue is not full, then the thread is created where these checks are made:
+            -- - it is the same subscribed client (in case it was reconnected it would receive message via SUB command)
+            -- - nothing was delivered to this subscription (to avoid race conditions with the recipient).
+            tryDeliverMessage :: Message -> M ()
+            tryDeliverMessage msg = atomically deliverToSub >>= mapM_ forkDeliver
+              where
+                rId = recipientId qr
+                deliverToSub =
+                  TM.lookup rId subscribers
+                    $>>= \rc@Client {subscriptions = subs, sndQ = q} -> TM.lookup rId subs
+                    $>>= \sub -> readTVar sub >>= \case
+                      s@Sub {subThread = NoSub, delivered} ->
+                        tryTakeTMVar delivered >>= \case
+                          Just _ -> pure Nothing -- if a message was already delivered, should not deliver more
+                          Nothing ->
+                            ifM
+                              (isFullTBQueue q)
+                              (modifyTVar' sub (\s' -> s' {subThread = SubPending}) $> Just (rc, sub))
+                              (deliver q s $> Nothing)
+                      _ -> pure Nothing
+                deliver q s = do
+                  let encMsg = encryptMsg qr msg
+                  writeTBQueue q [(CorrId "", rId, MSG encMsg)]
+                  void $ setDelivered s msg
+                forkDeliver (rc@Client {sndQ = q}, sub) = do
+                  t <- mkWeakThreadId =<< forkIO deliverThread
+                  atomically . modifyTVar' sub $ \case
+                    -- this case is needed because deliverThread can exit before it
+                    s@Sub {subThread = SubPending} -> s {subThread = SubThread t}
+                    s -> s
+                  where
+                    deliverThread = do
+                      labelMyThread $ B.unpack ("client $" <> encode sessionId) <> " deliver/SEND"
+                      time "deliver" . atomically $
+                        whenM (maybe False (sameClientId rc) <$> TM.lookup rId subscribers) $ do
+                          s@Sub {delivered} <- readTVar sub
+                          tryTakeTMVar delivered >>= \case
+                            Just _ -> pure () -- if a message was already delivered, should not deliver more
+                            Nothing -> do
+                              deliver q s
+                              writeTVar sub $! s {subThread = NoSub}
+
             trySendNotification :: NtfCreds -> Message -> TVar ChaChaDRG -> STM (Maybe Bool)
             trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg ntfNonceDrg =
               mapM (writeNtf notifierId msg rcvNtfDhSecret ntfNonceDrg) =<< TM.lookup notifierId notifiers
@@ -1132,35 +1180,17 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                     verified = \case
                       VRVerified qr -> Right (qr, (corrId', entId', cmd'))
                       VRFailed -> Left (corrId', entId', ERR AUTH)
-        deliverMessage :: T.Text -> QueueRec -> RecipientId -> TVar Sub -> MsgQueue -> Maybe Message -> M (Transmission BrokerMsg)
-        deliverMessage name qr rId sub q msg_ = time (name <> " deliver") $ do
-          readTVarIO sub >>= \case
-            s@Sub {subThread = NoSub} ->
-              case msg_ of
-                Just msg ->
-                  let encMsg = encryptMsg qr msg
-                   in atomically (setDelivered s msg) $> (corrId, rId, MSG encMsg)
-                _ -> forkSub $> resp
-            _ -> pure resp
+        deliverMessage :: T.Text -> QueueRec -> RecipientId -> TVar Sub -> Maybe Message -> M (Transmission BrokerMsg)
+        deliverMessage name qr rId sub msg_ = time (name <> " deliver") . atomically $
+          readTVar sub >>= \case
+            Sub {subThread = ProhibitSub} -> pure resp
+            s -> case msg_ of
+              Just msg ->
+                let encMsg = encryptMsg qr msg
+                 in setDelivered s msg $> (corrId, rId, MSG encMsg)
+              _ -> pure resp
           where
             resp = (corrId, rId, OK)
-            forkSub :: M ()
-            forkSub = do
-              atomically . modifyTVar' sub $ \s -> s {subThread = SubPending}
-              t <- mkWeakThreadId =<< forkIO subscriber
-              atomically . modifyTVar' sub $ \case
-                s@Sub {subThread = SubPending} -> s {subThread = SubThread t}
-                s -> s
-              where
-                subscriber = do
-                  labelMyThread $ B.unpack ("client $" <> encode sessionId) <> " subscriber/" <> T.unpack name
-                  msg <- atomically $ peekMsg q
-                  time "subscriber" . atomically $ do
-                    let encMsg = encryptMsg qr msg
-                    writeTBQueue sndQ [(CorrId "", rId, MSG encMsg)]
-                    s <- readTVar sub
-                    void $ setDelivered s msg
-                    writeTVar sub $! s {subThread = NoSub}
 
         time :: T.Text -> M a -> M a
         time name = timed name queueId
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index e315c4fe5..c8f78e2fb 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -75,7 +75,7 @@ snapshotMsgQueue st rId = TM.lookup rId st >>= maybe (pure []) (snapshotTQueue .
       mapM_ (writeTQueue q) msgs
       pure msgs
 
-writeMsg :: MsgQueue -> Message -> STM (Maybe Message)
+writeMsg :: MsgQueue -> Message -> STM (Maybe (Message, Bool))
 writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = do
   canWrt <- readTVar canWrite
   empty <- isEmptyTQueue q
@@ -85,7 +85,7 @@ writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = do
       writeTVar canWrite $! canWrt'
       modifyTVar' size (+ 1)
       if canWrt'
-        then writeTQueue q msg $> Just msg
+        then writeTQueue q msg $> Just (msg, empty)
         else (writeTQueue q $! msgQuota) $> Nothing
     else pure Nothing
   where
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 00a6e1c55..ab78d2ee9 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -2991,6 +2991,7 @@ testServerMultipleIdentities =
     bob' <- liftIO $ do
       Left (BROKER _ NETWORK) <- runExceptT $ joinConnection bob 1 True secondIdentityCReq "bob's connInfo" SMSubscribe
       disposeAgentClient bob
+      threadDelay 250000
       getSMPAgentClient' 3 agentCfg initAgentServers testDB2
     subscribeConnection bob' aliceId
     exchangeGreetingsMsgId 4 alice bobId bob' aliceId
@@ -3140,7 +3141,7 @@ testServerQueueInfo = do
     pure ()
   where
     checkEmptyQ c cId qiSnd' = do
-      r <- checkQ c cId qiSnd' (Just QSubThread) 0 Nothing
+      r <- checkQ c cId qiSnd' (Just QNoSub) 0 Nothing
       liftIO $ r `shouldBe` Nothing
     checkMsgQ c cId qiSize' = do
       r <- checkQ c cId True (Just QNoSub) qiSize' (Just MTMessage)
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 1fa76dfaa..10516b9f2 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -509,19 +509,21 @@ testWithStoreLog at@(ATransport t) =
         writeTVar senderId1 sId1
         writeTVar notifierId nId
       Resp "dabc" _ OK <- signSendRecv h1 nKey ("dabc", nId, NSUB)
-      signSendRecv h sKey1 ("bcda", sId1, _SEND' "hello") >>= \case
-        Resp "bcda" _ OK -> pure ()
-        r -> unexpected r
-      Resp "" _ (Msg mId1 msg1) <- tGet1 h
+      (mId1, msg1) <-
+        signSendRecv h sKey1 ("bcda", sId1, _SEND' "hello") >>= \case
+          Resp "" _ (Msg mId1 msg1) -> pure (mId1, msg1)
+          r -> error $ "unexpected response " <> take 100 (show r)
+      Resp "bcda" _ OK <- tGet1 h
       (decryptMsgV3 dhShared mId1 msg1, Right "hello") #== "delivered from queue 1"
       Resp "" _ (NMSG _ _) <- tGet1 h1
 
       (sId2, rId2, rKey2, dhShared2) <- createAndSecureQueue h sPub2
       atomically $ writeTVar senderId2 sId2
-      signSendRecv h sKey2 ("cdab", sId2, _SEND "hello too") >>= \case
-        Resp "cdab" _ OK -> pure ()
-        r -> unexpected r
-      Resp "" _ (Msg mId2 msg2) <- tGet1 h
+      (mId2, msg2) <-
+        signSendRecv h sKey2 ("cdab", sId2, _SEND "hello too") >>= \case
+          Resp "" _ (Msg mId2 msg2) -> pure (mId2, msg2)
+          r -> error $ "unexpected response " <> take 100 (show r)
+      Resp "cdab" _ OK <- tGet1 h
       (decryptMsgV3 dhShared2 mId2 msg2, Right "hello too") #== "delivered from queue 2"
 
       Resp "dabc" _ OK <- signSendRecv h rKey2 ("dabc", rId2, DEL)
@@ -884,7 +886,7 @@ testMsgExpireOnInterval t =
       testSMPClient @c $ \sh -> do
         (sId, rId, rKey, _) <- testSMPClient @c $ \rh -> createAndSecureQueue rh sPub
         Resp "1" _ OK <- signSendRecv sh sKey ("1", sId, _SEND "hello (should expire)")
-        threadDelay 2500000
+        threadDelay 3000000
         testSMPClient @c $ \rh -> do
           signSendRecv rh rKey ("2", rId, SUB) >>= \case
             Resp "2" _ OK -> pure ()

From 26979ff6b59a157e8d6432909d05c9cbf208b015 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 9 Jul 2024 08:36:03 +0100
Subject: [PATCH 030/195] smp server: simplify client subscriptions (#1223)

---
 src/Simplex/Messaging/Server.hs         | 81 ++++++++++++-------------
 src/Simplex/Messaging/Server/Env/STM.hs |  7 ++-
 2 files changed, 43 insertions(+), 45 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 567ff13b6..014bcd366 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -514,11 +514,11 @@ clientDisconnected c@Client {clientId, subscriptions, connected, sessionId, endT
 sameClientId :: Client -> Client -> Bool
 sameClientId Client {clientId} Client {clientId = cId'} = clientId == cId'
 
-cancelSub :: TVar Sub -> IO ()
-cancelSub sub =
-  readTVarIO sub >>= \case
-    Sub {subThread = SubThread t} -> liftIO $ deRefWeak t >>= mapM_ killThread
-    _ -> return ()
+cancelSub :: Sub -> IO ()
+cancelSub s =
+  readTVarIO (subThread s) >>= \case
+    SubThread t -> liftIO $ deRefWeak t >>= mapM_ killThread
+    _ -> pure ()
 
 receive :: Transport c => THandleSMP c 'TServer -> Client -> M ()
 receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
@@ -901,23 +901,23 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             Nothing -> do
               atomically $ modifyTVar' (qSub stats) (+ 1)
               newSub >>= deliver
-            Just sub ->
-              readTVarIO sub >>= \case
-                Sub {subThread = ProhibitSub} -> do
+            Just s@Sub {subThread} ->
+              readTVarIO subThread >>= \case
+                ProhibitSub -> do
                   -- cannot use SUB in the same connection where GET was used
                   atomically $ modifyTVar' (qSubProhibited stats) (+ 1)
                   pure (corrId, rId, ERR $ CMD PROHIBITED)
-                s -> do
+                _ -> do
                   atomically $ modifyTVar' (qSubDuplicate stats) (+ 1)
-                  atomically (tryTakeTMVar $ delivered s) >> deliver sub
+                  atomically (tryTakeTMVar $ delivered s) >> deliver s
           where
-            newSub :: M (TVar Sub)
+            newSub :: M Sub
             newSub = time "SUB newSub" . atomically $ do
               writeTQueue subscribedQ (rId, clnt)
-              sub <- newTVar =<< newSubscription NoSub
+              sub <- newSubscription NoSub
               TM.insert rId sub subscriptions
               pure sub
-            deliver :: TVar Sub -> M (Transmission BrokerMsg)
+            deliver :: Sub -> M (Transmission BrokerMsg)
             deliver sub = do
               q <- getStoreMsgQueue "SUB" rId
               msg_ <- atomically $ tryPeekMsg q
@@ -928,9 +928,9 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           atomically (TM.lookup queueId subscriptions) >>= \case
             Nothing ->
               atomically newSub >>= getMessage_
-            Just sub ->
-              readTVarIO sub >>= \case
-                s@Sub {subThread = ProhibitSub} ->
+            Just s@Sub {subThread} ->
+              readTVarIO subThread >>= \case
+                ProhibitSub ->
                   atomically (tryTakeTMVar $ delivered s)
                     >> getMessage_ s
                 -- cannot use GET in the same connection where there is an active subscription
@@ -939,8 +939,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             newSub :: STM Sub
             newSub = do
               s <- newSubscription ProhibitSub
-              sub <- newTVar s
-              TM.insert queueId sub subscriptions
+              TM.insert queueId s subscriptions
               pure s
             getMessage_ :: Sub -> M (Transmission BrokerMsg)
             getMessage_ s = do
@@ -968,10 +967,10 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             Nothing -> pure $ err NO_MSG
             Just sub ->
               atomically (getDelivered sub) >>= \case
-                Just s -> do
+                Just st -> do
                   q <- getStoreMsgQueue "ACK" queueId
-                  case s of
-                    Sub {subThread = ProhibitSub} -> do
+                  case st of
+                    ProhibitSub -> do
                       deletedMsg_ <- atomically $ tryDelMsg q msgId
                       mapM_ updateStats deletedMsg_
                       pure ok
@@ -981,12 +980,11 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                       deliverMessage "ACK" qr queueId sub msg_
                 _ -> pure $ err NO_MSG
           where
-            getDelivered :: TVar Sub -> STM (Maybe Sub)
-            getDelivered sub = do
-              s@Sub {delivered} <- readTVar sub
+            getDelivered :: Sub -> STM (Maybe SubscriptionThread)
+            getDelivered Sub {delivered, subThread} = do
               tryTakeTMVar delivered $>>= \msgId' ->
                 if msgId == msgId' || B.null msgId
-                  then pure $ Just s
+                  then Just <$> readTVar subThread
                   else putTMVar delivered msgId' $> Nothing
             updateStats :: Message -> M ()
             updateStats = \case
@@ -1074,37 +1072,36 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 deliverToSub =
                   TM.lookup rId subscribers
                     $>>= \rc@Client {subscriptions = subs, sndQ = q} -> TM.lookup rId subs
-                    $>>= \sub -> readTVar sub >>= \case
-                      s@Sub {subThread = NoSub, delivered} ->
+                    $>>= \s@Sub {subThread, delivered} -> readTVar subThread >>= \case
+                      NoSub ->
                         tryTakeTMVar delivered >>= \case
                           Just _ -> pure Nothing -- if a message was already delivered, should not deliver more
                           Nothing ->
                             ifM
                               (isFullTBQueue q)
-                              (modifyTVar' sub (\s' -> s' {subThread = SubPending}) $> Just (rc, sub))
+                              (writeTVar subThread SubPending $> Just (rc, s))
                               (deliver q s $> Nothing)
                       _ -> pure Nothing
                 deliver q s = do
                   let encMsg = encryptMsg qr msg
                   writeTBQueue q [(CorrId "", rId, MSG encMsg)]
                   void $ setDelivered s msg
-                forkDeliver (rc@Client {sndQ = q}, sub) = do
+                forkDeliver (rc@Client {sndQ = q}, s@Sub {subThread, delivered}) = do
                   t <- mkWeakThreadId =<< forkIO deliverThread
-                  atomically . modifyTVar' sub $ \case
+                  atomically . modifyTVar' subThread $ \case
                     -- this case is needed because deliverThread can exit before it
-                    s@Sub {subThread = SubPending} -> s {subThread = SubThread t}
-                    s -> s
+                    SubPending -> SubThread t
+                    st -> st
                   where
                     deliverThread = do
                       labelMyThread $ B.unpack ("client $" <> encode sessionId) <> " deliver/SEND"
                       time "deliver" . atomically $
                         whenM (maybe False (sameClientId rc) <$> TM.lookup rId subscribers) $ do
-                          s@Sub {delivered} <- readTVar sub
                           tryTakeTMVar delivered >>= \case
                             Just _ -> pure () -- if a message was already delivered, should not deliver more
                             Nothing -> do
                               deliver q s
-                              writeTVar sub $! s {subThread = NoSub}
+                              writeTVar subThread NoSub
 
             trySendNotification :: NtfCreds -> Message -> TVar ChaChaDRG -> STM (Maybe Bool)
             trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg ntfNonceDrg =
@@ -1180,11 +1177,11 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                     verified = \case
                       VRVerified qr -> Right (qr, (corrId', entId', cmd'))
                       VRFailed -> Left (corrId', entId', ERR AUTH)
-        deliverMessage :: T.Text -> QueueRec -> RecipientId -> TVar Sub -> Maybe Message -> M (Transmission BrokerMsg)
-        deliverMessage name qr rId sub msg_ = time (name <> " deliver") . atomically $
-          readTVar sub >>= \case
-            Sub {subThread = ProhibitSub} -> pure resp
-            s -> case msg_ of
+        deliverMessage :: T.Text -> QueueRec -> RecipientId -> Sub -> Maybe Message -> M (Transmission BrokerMsg)
+        deliverMessage name qr rId s@Sub {subThread} msg_ = time (name <> " deliver") . atomically $
+          readTVar subThread >>= \case
+            ProhibitSub -> pure resp
+            _ -> case msg_ of
               Just msg ->
                 let encMsg = encryptMsg qr msg
                  in setDelivered s msg $> (corrId, rId, MSG encMsg)
@@ -1232,9 +1229,9 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             pure QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
           pure (corrId, queueId, INFO info)
           where
-            mkQSub sub = do
-              Sub {subThread, delivered} <- readTVar sub
-              let qSubThread = case subThread of
+            mkQSub Sub {subThread, delivered} = do
+              st <- readTVar subThread
+              let qSubThread = case st of
                     NoSub -> QNoSub
                     SubPending -> QSubPending
                     SubThread _ -> QSubThread
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 559aea280..b40e9fc16 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -144,7 +144,7 @@ type ClientId = Int
 
 data Client = Client
   { clientId :: ClientId,
-    subscriptions :: TMap RecipientId (TVar Sub),
+    subscriptions :: TMap RecipientId Sub,
     ntfSubscriptions :: TMap NotifierId (),
     rcvQ :: TBQueue (NonEmpty (Maybe QueueRec, Transmission Cmd)),
     sndQ :: TBQueue (NonEmpty (Transmission BrokerMsg)),
@@ -163,7 +163,7 @@ data Client = Client
 data SubscriptionThread = NoSub | SubPending | SubThread (Weak ThreadId) | ProhibitSub
 
 data Sub = Sub
-  { subThread :: SubscriptionThread,
+  { subThread :: TVar SubscriptionThread,
     delivered :: TMVar MsgId
   }
 
@@ -193,8 +193,9 @@ newClient nextClientId qSize thVersion sessionId createdAt = do
   return Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, msgQ, procThreads, endThreads, endThreadSeq, thVersion, sessionId, connected, createdAt, rcvActiveAt, sndActiveAt}
 
 newSubscription :: SubscriptionThread -> STM Sub
-newSubscription subThread = do
+newSubscription st = do
   delivered <- newEmptyTMVar
+  subThread <- newTVar st
   return Sub {subThread, delivered}
 
 newEnv :: ServerConfig -> IO Env

From 017469b2de65c7e3ef1d680c2da466b320d1b061 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 9 Jul 2024 13:56:02 +0100
Subject: [PATCH 031/195] 6.0.0.0

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index 94c2b6db0..fbf95a7e5 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 5.8.2.0
+version: 6.0.0.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index aec362196..b7b1ca76c 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        5.8.2.0
+version:        6.0.0.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From ff2b00a0299343e39bd8d56fc43d97f7a8fe214c Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Thu, 11 Jul 2024 19:27:04 +0400
Subject: [PATCH 032/195] agent: change ProxyClientError json encoding (#1226)

---
 src/Simplex/Messaging/Client.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index e20b00039..1837a256b 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -130,7 +130,7 @@ import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.TMap (TMap)
@@ -847,11 +847,11 @@ data ProxiedRelay = ProxiedRelay
 
 data ProxyClientError
   = -- | protocol error response from proxy
-    ProxyProtocolError ErrorType
+    ProxyProtocolError {protocolErr :: ErrorType}
   | -- | unexpexted response
-    ProxyUnexpectedResponse String
+    ProxyUnexpectedResponse {responseStr :: String}
   | -- | error between proxy and server
-    ProxyResponseError ErrorType
+    ProxyResponseError {responseErr :: ErrorType}
   deriving (Eq, Show, Exception)
 
 instance StrEncoding ProxyClientError where
@@ -1139,6 +1139,6 @@ $(J.deriveJSON (enumJSON $ dropPrefix "SPF") ''SMPProxyFallback)
 
 $(J.deriveJSON defaultJSON ''NetworkConfig)
 
-$(J.deriveJSON (enumJSON $ dropPrefix "Proxy") ''ProxyClientError)
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "Proxy") ''ProxyClientError)
 
 $(J.deriveJSON defaultJSON ''TBQueueInfo)

From e56bd0b47b22781f9b5936e3b8a9d51cc3f9e8d5 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Fri, 12 Jul 2024 12:41:55 +0100
Subject: [PATCH 033/195] agent: add known servers (#1225)

* agent: add known servers

* test delays

* ServerCfg

* json encoding

* enabledServerCfg

* checkUserServers
---
 src/Simplex/Messaging/Agent.hs            | 35 ++++++++++-----
 src/Simplex/Messaging/Agent/Client.hs     | 17 ++++----
 src/Simplex/Messaging/Agent/Env/SQLite.hs | 52 +++++++++++++++++++++--
 tests/AgentTests/FunctionalAPITests.hs    | 24 +++++------
 tests/SMPAgentClient.hs                   | 19 ++++++---
 tests/SMPProxyTests.hs                    |  8 ++--
 6 files changed, 111 insertions(+), 44 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 2262a96e5..c08e04298 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -77,6 +77,7 @@ module Simplex.Messaging.Agent
     getConnectionServers,
     getConnectionRatchetAdHash,
     setProtocolServers,
+    checkUserServers,
     testProtocolServer,
     setNtfServers,
     setNetworkConfig,
@@ -172,7 +173,7 @@ import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfReg
 import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..))
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
-import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), EntityId, ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, XFTPServerWithAuth, sndAuthKeySMPClientVersion)
+import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), EntityId, ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, sndAuthKeySMPClientVersion)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
@@ -197,15 +198,18 @@ getSMPAgentClient = getSMPAgentClient_ 1
 {-# INLINE getSMPAgentClient #-}
 
 getSMPAgentClient_ :: Int -> AgentConfig -> InitialAgentServers -> SQLiteStore -> Bool -> IO AgentClient
-getSMPAgentClient_ clientId cfg initServers store backgroundMode =
-  liftIO $ newSMPAgentEnv cfg store >>= runReaderT runAgent
+getSMPAgentClient_ clientId cfg initServers@InitialAgentServers {smp, xftp} store backgroundMode =
+  newSMPAgentEnv cfg store >>= runReaderT runAgent
   where
     runAgent = do
+      liftIO $ checkServers "SMP" smp >> checkServers "XFTP" xftp
       currentTs <- liftIO getCurrentTime
       c@AgentClient {acThread} <- atomically . newAgentClient clientId initServers currentTs =<< ask
       t <- runAgentThreads c `forkFinally` const (liftIO $ disconnectAgentClient c)
       atomically . writeTVar acThread . Just =<< mkWeakThreadId t
       pure c
+    checkServers protocol srvs =
+      forM_ (M.assocs srvs) $ \(userId, srvs') -> checkUserServers ("getSMPAgentClient " <> protocol <> " " <> tshow userId) srvs'
     runAgentThreads c
       | backgroundMode = run c "subscriber" $ subscriber c
       | otherwise = do
@@ -271,7 +275,7 @@ resumeAgentClient :: AgentClient -> IO ()
 resumeAgentClient c = atomically $ writeTVar (active c) True
 {-# INLINE resumeAgentClient #-}
 
-createUser :: AgentClient -> NonEmpty SMPServerWithAuth -> NonEmpty XFTPServerWithAuth -> AE UserId
+createUser :: AgentClient -> NonEmpty (ServerCfg 'PSMP) -> NonEmpty (ServerCfg 'PXFTP) -> AE UserId
 createUser c = withAgentEnv c .: createUser' c
 {-# INLINE createUser #-}
 
@@ -600,11 +604,13 @@ logConnection c connected =
   let event = if connected then "connected to" else "disconnected from"
    in logInfo $ T.unwords ["client", tshow (clientId c), event, "Agent"]
 
-createUser' :: AgentClient -> NonEmpty SMPServerWithAuth -> NonEmpty XFTPServerWithAuth -> AM UserId
+createUser' :: AgentClient -> NonEmpty (ServerCfg 'PSMP) -> NonEmpty (ServerCfg 'PXFTP) -> AM UserId
 createUser' c smp xftp = do
+  liftIO $ checkUserServers "createUser SMP" smp
+  liftIO $ checkUserServers "createUser XFTP" xftp
   userId <- withStore' c createUserRecord
-  atomically $ TM.insert userId smp $ smpServers c
-  atomically $ TM.insert userId xftp $ xftpServers c
+  atomically $ TM.insert userId (mkUserServers smp) $ smpServers c
+  atomically $ TM.insert userId (mkUserServers xftp) $ xftpServers c
   pure userId
 
 deleteUser' :: AgentClient -> UserId -> Bool -> AM ()
@@ -1815,10 +1821,17 @@ connectionStats = \case
           ratchetSyncSupported = connAgentVersion >= ratchetSyncSMPAgentVersion
         }
 
--- | Change servers to be used for creating new queues, in Reader monad
-setProtocolServers :: (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> NonEmpty (ProtoServerWithAuth p) -> IO ()
-setProtocolServers c userId srvs = atomically $ TM.insert userId srvs (userServers c)
-{-# INLINE setProtocolServers #-}
+-- | Change servers to be used for creating new queues.
+-- This function will set all servers as enabled in case all passed servers are disabled.
+setProtocolServers :: forall p. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> NonEmpty (ServerCfg p) -> IO ()
+setProtocolServers c userId srvs = do
+  checkUserServers "setProtocolServers" srvs
+  atomically $ TM.insert userId (mkUserServers srvs) (userServers c)
+
+checkUserServers :: Text -> NonEmpty (ServerCfg p) -> IO ()
+checkUserServers name srvs =
+  unless (any (\ServerCfg {enabled} -> enabled) srvs) $
+    logWarn (name <> ": all passed servers are disabled, using all servers.")
 
 registerNtfToken' :: AgentClient -> DeviceToken -> NotificationsMode -> AM NtfTknStatus
 registerNtfToken' c suppliedDeviceToken suppliedNtfMode =
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 0467c31f8..b8614c460 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -236,6 +236,7 @@ import Simplex.Messaging.Protocol
     ProtoServerWithAuth (..),
     Protocol (..),
     ProtocolServer (..),
+    ProtocolType (..),
     ProtocolTypeI (..),
     QueueId,
     QueueIdsKeys (..),
@@ -289,7 +290,7 @@ data AgentClient = AgentClient
     active :: TVar Bool,
     subQ :: TBQueue ATransmission,
     msgQ :: TBQueue (ServerTransmissionBatch SMPVersion ErrorType BrokerMsg),
-    smpServers :: TMap UserId (NonEmpty SMPServerWithAuth),
+    smpServers :: TMap UserId (UserServers 'PSMP),
     smpClients :: TMap SMPTransportSession SMPClientVar,
     -- smpProxiedRelays:
     -- SMPTransportSession defines connection from proxy to relay,
@@ -297,7 +298,7 @@ data AgentClient = AgentClient
     smpProxiedRelays :: TMap SMPTransportSession SMPServerWithAuth,
     ntfServers :: TVar [NtfServer],
     ntfClients :: TMap NtfTransportSession NtfClientVar,
-    xftpServers :: TMap UserId (NonEmpty XFTPServerWithAuth),
+    xftpServers :: TMap UserId (UserServers 'PXFTP),
     xftpClients :: TMap XFTPTransportSession XFTPClientVar,
     useNetworkConfig :: TVar (NetworkConfig, NetworkConfig), -- (slow, fast) networks
     userNetworkInfo :: TVar UserNetworkInfo,
@@ -456,12 +457,12 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
   active <- newTVar True
   subQ <- newTBQueue qSize
   msgQ <- newTBQueue qSize
-  smpServers <- newTVar smp
+  smpServers <- newTVar $ M.map mkUserServers smp
   smpClients <- TM.empty
   smpProxiedRelays <- TM.empty
   ntfServers <- newTVar ntf
   ntfClients <- TM.empty
-  xftpServers <- newTVar xftp
+  xftpServers <- newTVar $ M.map mkUserServers xftp
   xftpClients <- TM.empty
   useNetworkConfig <- newTVar (slowNetworkConfig netCfg, netCfg)
   userNetworkInfo <- newTVar $ UserNetworkInfo UNOther True
@@ -1069,7 +1070,7 @@ sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDi
         SPFAllow -> True
         SPFAllowProtected -> ipAddressProtected cfg destSrv
         SPFProhibit -> False
-    unknownServer = maybe True (all ((destSrv /=) . protoServer)) <$> TM.lookup userId (userServers c)
+    unknownServer = maybe True (notElem destSrv . knownSrvs) <$> TM.lookup userId (smpServers c)
     sendViaProxy destSess@(_, _, qId) = do
       r <- tryAgentError . withProxySession c destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess) -> do
         r' <- liftClient SMP (clientServer smp) $ sendCmdViaProxy smp proxySess
@@ -1904,7 +1905,7 @@ storeError = \case
   SEDatabaseBusy e -> CRITICAL True $ B.unpack e
   e -> INTERNAL $ show e
 
-userServers :: forall p. (ProtocolTypeI p, UserProtocol p) => AgentClient -> TMap UserId (NonEmpty (ProtoServerWithAuth p))
+userServers :: forall p. (ProtocolTypeI p, UserProtocol p) => AgentClient -> TMap UserId (UserServers p)
 userServers c = case protocolTypeI @p of
   SPSMP -> smpServers c
   SPXFTP -> xftpServers c
@@ -1926,7 +1927,7 @@ getNextServer c userId usedSrvs = withUserServers c userId $ \srvs ->
 withUserServers :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> (NonEmpty (ProtoServerWithAuth p) -> AM a) -> AM a
 withUserServers c userId action =
   atomically (TM.lookup userId $ userServers c) >>= \case
-    Just srvs -> action srvs
+    Just srvs -> action $ enabledSrvs srvs
     _ -> throwE $ INTERNAL "unknown userId - no user servers"
 
 withNextSrv :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> TVar [ProtocolServer p] -> [ProtocolServer p] -> (ProtoServerWithAuth p -> AM a) -> AM a
@@ -1935,7 +1936,7 @@ withNextSrv c userId usedSrvs initUsed action = do
   srvAuth@(ProtoServerWithAuth srv _) <- getNextServer c userId used
   atomically $ do
     srvs_ <- TM.lookup userId $ userServers c
-    let unused = maybe [] ((\\ used) . map protoServer . L.toList) srvs_
+    let unused = maybe [] ((\\ used) . map protoServer . L.toList . enabledSrvs) srvs_
         used' = if null unused then initUsed else srv : used
     writeTVar usedSrvs $! used'
   action srvAuth
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 2ae2ad5c0..0f88508b9 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
@@ -15,7 +16,12 @@ module Simplex.Messaging.Agent.Env.SQLite
     AM,
     AgentConfig (..),
     InitialAgentServers (..),
+    ServerCfg (..),
+    UserServers (..),
     NetworkConfig (..),
+    presetServerCfg,
+    enabledServerCfg,
+    mkUserServers,
     defaultAgentConfig,
     defaultReconnectInterval,
     tryAgentError,
@@ -39,10 +45,14 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Crypto.Random
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson.TH as JQ
 import Data.ByteArray (ScrubbedBytes)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as L
 import Data.Map (Map)
+import Data.Maybe (fromMaybe)
 import Data.Time.Clock (NominalDiffTime, nominalDay)
 import Data.Time.Clock.System (SystemTime (..))
 import Data.Word (Word16)
@@ -59,7 +69,8 @@ import Simplex.Messaging.Crypto.Ratchet (VersionRangeE2E, supportedE2EEncryptVRa
 import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
 import Simplex.Messaging.Notifications.Transport (NTFVersion)
 import Simplex.Messaging.Notifications.Types
-import Simplex.Messaging.Protocol (NtfServer, VersionRangeSMPC, XFTPServer, XFTPServerWithAuth, supportedSMPClientVRange)
+import Simplex.Messaging.Parsers (defaultJSON)
+import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth, ProtocolServer, ProtocolType (..), ProtocolTypeI, VersionRangeSMPC, XFTPServer, supportedSMPClientVRange)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPVersion, TLS, Transport (..))
@@ -74,12 +85,38 @@ type AM' a = ReaderT Env IO a
 type AM a = ExceptT AgentErrorType (ReaderT Env IO) a
 
 data InitialAgentServers = InitialAgentServers
-  { smp :: Map UserId (NonEmpty SMPServerWithAuth),
+  { smp :: Map UserId (NonEmpty (ServerCfg 'PSMP)),
     ntf :: [NtfServer],
-    xftp :: Map UserId (NonEmpty XFTPServerWithAuth),
+    xftp :: Map UserId (NonEmpty (ServerCfg 'PXFTP)),
     netCfg :: NetworkConfig
   }
 
+data ServerCfg p = ServerCfg
+  { server :: ProtoServerWithAuth p,
+    preset :: Bool,
+    tested :: Maybe Bool,
+    enabled :: Bool
+  }
+  deriving (Show)
+
+enabledServerCfg :: ProtoServerWithAuth p -> ServerCfg p
+enabledServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True}
+
+presetServerCfg :: Bool -> ProtoServerWithAuth p -> ServerCfg p
+presetServerCfg enabled server = ServerCfg {server, preset = True, tested = Nothing, enabled}
+
+data UserServers p = UserServers
+  { enabledSrvs :: NonEmpty (ProtoServerWithAuth p),
+    knownSrvs :: NonEmpty (ProtocolServer p)
+  }
+
+-- This function sets all servers as enabled in case all passed servers are disabled.
+mkUserServers :: NonEmpty (ServerCfg p) -> UserServers p
+mkUserServers srvs = UserServers {enabledSrvs, knownSrvs}
+  where
+    enabledSrvs = L.map (\ServerCfg {server} -> server) $ fromMaybe srvs $ L.nonEmpty $ L.filter (\ServerCfg {enabled} -> enabled) srvs
+    knownSrvs = L.map (\ServerCfg {server = ProtoServerWithAuth srv _} -> srv) srvs
+
 data AgentConfig = AgentConfig
   { tcpPort :: Maybe ServiceName,
     rcvAuthAlg :: C.AuthAlg,
@@ -294,3 +331,12 @@ updateRestartCount :: SystemTime -> RestartCount -> RestartCount
 updateRestartCount t (RestartCount minute count) = do
   let min' = systemSeconds t `div` 60
    in RestartCount min' $ if minute == min' then count + 1 else 1
+
+$(pure [])
+
+instance ProtocolTypeI p => ToJSON (ServerCfg p) where
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerCfg)
+  toJSON = $(JQ.mkToJSON defaultJSON ''ServerCfg)
+
+instance ProtocolTypeI p => FromJSON (ServerCfg p) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''ServerCfg)
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index ab78d2ee9..1893ae105 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -980,7 +980,7 @@ testAsyncServerOffline t = withAgentClients2 $ \alice bob -> do
 
 testAllowConnectionClientRestart :: HasCallStack => ATransport -> IO ()
 testAllowConnectionClientRestart t = do
-  let initAgentServersSrv2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer2]}
+  let initAgentServersSrv2 = initAgentServers {smp = userServers [testSMPServer2]}
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg initAgentServersSrv2 testDB2
   withSmpServerStoreLogOn t testPort $ \_ -> do
@@ -1335,7 +1335,7 @@ testExpireMessage t =
 
 testExpireManyMessages :: HasCallStack => ATransport -> IO ()
 testExpireManyMessages t =
-  withAgent 1 agentCfg {messageTimeout = 1.5, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB $ \a ->
+  withAgent 1 agentCfg {messageTimeout = 2, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB $ \a ->
     withAgent 2 agentCfg initAgentServers testDB2 $ \b -> do
       (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ makeConnection a b
       runRight_ $ do
@@ -1344,7 +1344,7 @@ testExpireManyMessages t =
         2 <- sendMessage a bId SMP.noMsgFlags "1"
         3 <- sendMessage a bId SMP.noMsgFlags "2"
         4 <- sendMessage a bId SMP.noMsgFlags "3"
-        liftIO $ threadDelay 1500000
+        liftIO $ threadDelay 2000000
         5 <- sendMessage a bId SMP.noMsgFlags "4" -- this won't expire
         get a =##> \case ("", c, MERR 2 (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
         -- get a =##> \case ("", c, MERRS [5, 6] (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
@@ -1401,7 +1401,7 @@ testExpireMessageQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1} testP
 
 testExpireManyMessagesQuota :: ATransport -> IO ()
 testExpireManyMessagesQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1} testPort $ \_ -> do
-  a <- getSMPAgentClient' 1 agentCfg {quotaExceededTimeout = 1, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB
+  a <- getSMPAgentClient' 1 agentCfg {quotaExceededTimeout = 2, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB
   b <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
   (aId, bId) <- runRight $ do
     (aId, bId) <- makeConnection a b
@@ -1411,7 +1411,7 @@ testExpireManyMessagesQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1}
     3 <- sendMessage a bId SMP.noMsgFlags "2"
     4 <- sendMessage a bId SMP.noMsgFlags "3"
     5 <- sendMessage a bId SMP.noMsgFlags "4"
-    liftIO $ threadDelay 1000000
+    liftIO $ threadDelay 2000000
     6 <- sendMessage a bId SMP.noMsgFlags "5" -- this won't expire
     get a =##> \case ("", c, MERR 3 (SMP _ QUOTA)) -> bId == c; _ -> False
     get a >>= \case
@@ -2226,7 +2226,7 @@ testWaitDeliveryTimeout2 t =
 
 testJoinConnectionAsyncReplyErrorV8 :: HasCallStack => ATransport -> IO ()
 testJoinConnectionAsyncReplyErrorV8 t = do
-  let initAgentServersSrv2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer2]}
+  let initAgentServersSrv2 = initAgentServers {smp = userServers [testSMPServer2]}
   withAgent 1 agentCfgVPrevPQ initAgentServers testDB $ \a ->
     withAgent 2 agentCfgVPrevPQ initAgentServersSrv2 testDB2 $ \b -> do
       (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
@@ -2265,7 +2265,7 @@ testJoinConnectionAsyncReplyErrorV8 t = do
 
 testJoinConnectionAsyncReplyError :: HasCallStack => ATransport -> IO ()
 testJoinConnectionAsyncReplyError t = do
-  let initAgentServersSrv2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer2]}
+  let initAgentServersSrv2 = initAgentServers {smp = userServers [testSMPServer2]}
   withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withAgent 2 agentCfg initAgentServersSrv2 testDB2 $ \b -> do
       (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
@@ -2308,7 +2308,7 @@ testUsers =
   withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
     exchangeGreetings a bId b aId
-    auId <- createUser a [noAuthSrv testSMPServer] [noAuthSrv testXFTPServer]
+    auId <- createUser a [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer]
     (aId', bId') <- makeConnectionForUsers a auId b 1
     exchangeGreetings a bId' b aId'
     deleteUser a auId True
@@ -2323,7 +2323,7 @@ testDeleteUserQuietly =
   withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
     exchangeGreetings a bId b aId
-    auId <- createUser a [noAuthSrv testSMPServer] [noAuthSrv testXFTPServer]
+    auId <- createUser a [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer]
     (aId', bId') <- makeConnectionForUsers a auId b 1
     exchangeGreetings a bId' b aId'
     deleteUser a auId False
@@ -2335,7 +2335,7 @@ testUsersNoServer t = withAgentClientsCfg2 aCfg agentCfg $ \a b -> do
   (aId, bId, auId, _aId', bId') <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
     (aId, bId) <- makeConnection a b
     exchangeGreetings a bId b aId
-    auId <- createUser a [noAuthSrv testSMPServer] [noAuthSrv testXFTPServer]
+    auId <- createUser a [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer]
     (aId', bId') <- makeConnectionForUsers a auId b 1
     exchangeGreetings a bId' b aId'
     pure (aId, bId, auId, aId', bId')
@@ -2759,7 +2759,7 @@ testCreateQueueAuth srvVersion clnt1 clnt2 baseId = do
   pure r
   where
     getClient clientId (clntAuth, clntVersion) db =
-      let servers = initAgentServers {smp = userServers [ProtoServerWithAuth testSMPServer clntAuth]}
+      let servers = initAgentServers {smp = userServers' [ProtoServerWithAuth testSMPServer clntAuth]}
           alpn_ = if clntVersion >= authCmdsSMPVersion then Just supportedSMPHandshakes else Nothing
           smpCfg = defaultClientConfig alpn_ $ V.mkVersionRange (prevVersion basicAuthSMPVersion) clntVersion
           sndAuthAlg = if srvVersion >= authCmdsSMPVersion && clntVersion >= authCmdsSMPVersion then C.AuthAlg C.SX25519 else C.AuthAlg C.SEd25519
@@ -2931,7 +2931,7 @@ testTwoUsers = withAgentClients2 $ \a b -> do
     ("", "", UP _ _) <- nGet a
     a `hasClients` 1
 
-    aUserId2 <- createUser a [noAuthSrv testSMPServer] [noAuthSrv testXFTPServer]
+    aUserId2 <- createUser a [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer]
     (aId2, bId2) <- makeConnectionForUsers a aUserId2 b 1
     exchangeGreetings a bId2 b aId2
     (aId2', bId2') <- makeConnectionForUsers a aUserId2 b 1
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index 7cb2a88c5..e0de57466 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -11,6 +11,7 @@
 module SMPAgentClient where
 
 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 NtfClient (ntfTestPort)
@@ -20,7 +21,7 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Client (ProtocolClientConfig (..), SMPProxyFallback, SMPProxyMode, defaultNetworkConfig, defaultSMPClientConfig)
 import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
-import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth)
+import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth (..), ProtocolServer)
 import Simplex.Messaging.Transport
 import XFTPClient (testXFTPServer)
 
@@ -48,14 +49,14 @@ testNtfServer2 = "ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6
 initAgentServers :: InitialAgentServers
 initAgentServers =
   InitialAgentServers
-    { smp = userServers [noAuthSrv testSMPServer],
+    { smp = userServers [testSMPServer],
       ntf = [testNtfServer],
-      xftp = userServers [noAuthSrv testXFTPServer],
+      xftp = userServers [testXFTPServer],
       netCfg = defaultNetworkConfig {tcpTimeout = 500_000, tcpConnectTimeout = 500_000}
     }
 
 initAgentServers2 :: InitialAgentServers
-initAgentServers2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer, noAuthSrv testSMPServer2]}
+initAgentServers2 = initAgentServers {smp = userServers [testSMPServer, testSMPServer2]}
 
 initAgentServersProxy :: SMPProxyMode -> SMPProxyFallback -> InitialAgentServers
 initAgentServersProxy smpProxyMode smpProxyFallback =
@@ -89,5 +90,11 @@ fastRetryInterval = defaultReconnectInterval {initialInterval = 50_000}
 fastMessageRetryInterval :: RetryInterval2
 fastMessageRetryInterval = RetryInterval2 {riFast = fastRetryInterval, riSlow = fastRetryInterval}
 
-userServers :: NonEmpty (ProtoServerWithAuth p) -> Map UserId (NonEmpty (ProtoServerWithAuth p))
-userServers srvs = M.fromList [(1, srvs)]
+userServers :: NonEmpty (ProtocolServer p) -> Map UserId (NonEmpty (ServerCfg p))
+userServers = userServers' . L.map noAuthSrv
+
+userServers' :: NonEmpty (ProtoServerWithAuth p) -> Map UserId (NonEmpty (ServerCfg p))
+userServers' srvs = M.fromList [(1, L.map (presetServerCfg True) srvs)]
+
+noAuthSrvCfg :: ProtocolServer p -> ServerCfg p
+noAuthSrvCfg = presetServerCfg True . noAuthSrv
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 6452d2677..625dfbda7 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -234,7 +234,7 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b
   where
     msgId = subtract baseId . fst
     aCfg = agentCfg {sndAuthAlg = C.AuthAlg alg, rcvAuthAlg = C.AuthAlg alg}
-    servers (srvs, smpProxyMode, _) = (initAgentServersProxy smpProxyMode SPFAllow) {smp = userServers $ L.map noAuthSrv srvs}
+    servers (srvs, smpProxyMode, _) = (initAgentServersProxy smpProxyMode SPFAllow) {smp = userServers srvs}
 
 agentDeliverMessagesViaProxyConc :: [NonEmpty SMPServer] -> [MsgBody] -> IO ()
 agentDeliverMessagesViaProxyConc agentServers msgs =
@@ -299,7 +299,7 @@ agentDeliverMessagesViaProxyConc agentServers msgs =
       logDebug "run finished"
     pqEnc = CR.PQEncOn
     aCfg = agentCfg {sndAuthAlg = C.AuthAlg C.SEd448, rcvAuthAlg = C.AuthAlg C.SEd448}
-    servers srvs = (initAgentServersProxy SPMAlways SPFAllow) {smp = userServers $ L.map noAuthSrv srvs}
+    servers srvs = (initAgentServersProxy SPMAlways SPFAllow) {smp = userServers srvs}
 
 agentViaProxyVersionError :: IO ()
 agentViaProxyVersionError =
@@ -310,7 +310,7 @@ agentViaProxyVersionError =
         A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
     pure ()
   where
-    servers srvs = (initAgentServersProxy SPMUnknown SPFProhibit) {smp = userServers $ L.map noAuthSrv srvs}
+    servers srvs = (initAgentServersProxy SPMUnknown SPFProhibit) {smp = userServers srvs}
 
 agentViaProxyRetryOffline :: IO ()
 agentViaProxyRetryOffline = do
@@ -372,7 +372,7 @@ agentViaProxyRetryOffline = do
     aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
     baseId = 1
     msgId = subtract baseId . fst
-    servers srv = (initAgentServersProxy SPMAlways SPFProhibit) {smp = userServers $ L.map noAuthSrv [srv]}
+    servers srv = (initAgentServersProxy SPMAlways SPFProhibit) {smp = userServers [srv]}
 
 testNoProxy :: IO ()
 testNoProxy = do

From 8dd54ced0eb344e04298acf4a6b2d71e54cede01 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sat, 13 Jul 2024 10:06:48 +0100
Subject: [PATCH 034/195] agent: retry proxied command on NO_SESSION error, to
 prevent failure of proxied interactive commands (like joining connection)
 (#1227)

---
 src/Simplex/Messaging/Agent/Client.hs | 45 ++++++++++++++++-----------
 src/Simplex/Messaging/Client.hs       |  5 +--
 tests/SMPProxyTests.hs                | 31 +++++++++++++++---
 3 files changed, 57 insertions(+), 24 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index b8614c460..43b3b8064 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -597,10 +597,10 @@ getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
       prs <- atomically TM.empty
       smpConnectClient c tSess prs v
 
-getSMPProxyClient :: AgentClient -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
-getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq} destSess@(userId, destSrv, qId) = do
+getSMPProxyClient :: AgentClient -> Maybe SMPServerWithAuth -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
+getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq} proxySrv_ destSess@(userId, destSrv, qId) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
-  proxySrv <- getNextServer c userId [destSrv]
+  proxySrv <- maybe (getNextServer c userId [destSrv]) pure proxySrv_
   ts <- liftIO getCurrentTime
   atomically (getClientVar proxySrv ts) >>= \(tSess, auth, v) ->
     either (newProxyClient tSess auth ts) (waitForProxyClient tSess auth) v
@@ -993,9 +993,9 @@ withClient_ c tSess@(_, srv, _) action = do
       logServer "<--" c srv "" $ bshow e
       throwE e
 
-withProxySession :: AgentClient -> SMPTransportSession -> SMP.SenderId -> ByteString -> ((SMPConnectedClient, ProxiedRelay) -> AM a) -> AM a
-withProxySession c destSess@(_, destSrv, _) entId cmdStr action = do
-  (cl, sess_) <- getSMPProxyClient c destSess
+withProxySession :: AgentClient -> Maybe SMPServerWithAuth -> SMPTransportSession -> SMP.SenderId -> ByteString -> ((SMPConnectedClient, ProxiedRelay) -> AM a) -> AM a
+withProxySession c proxySrv_ destSess@(_, destSrv, _) entId cmdStr action = do
+  (cl, sess_) <- getSMPProxyClient c proxySrv_ destSess
   logServer ("--> " <> proxySrv cl <> " >") c destSrv entId cmdStr
   case sess_ of
     Right sess -> do
@@ -1053,7 +1053,7 @@ sendOrProxySMPCommand ::
   AM (Maybe SMPServer)
 sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
   sess <- liftIO $ mkTransportSession c userId destSrv senderId
-  ifM (atomically shouldUseProxy) (sendViaProxy sess) (sendDirectly sess $> Nothing)
+  ifM (atomically shouldUseProxy) (sendViaProxy Nothing sess) (sendDirectly sess $> Nothing)
   where
     shouldUseProxy = do
       cfg <- getNetworkConfig c
@@ -1071,22 +1071,31 @@ sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDi
         SPFAllowProtected -> ipAddressProtected cfg destSrv
         SPFProhibit -> False
     unknownServer = maybe True (notElem destSrv . knownSrvs) <$> TM.lookup userId (smpServers c)
-    sendViaProxy destSess@(_, _, qId) = do
-      r <- tryAgentError . withProxySession c destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess) -> do
+    sendViaProxy :: Maybe SMPServerWithAuth -> SMPTransportSession -> AM (Maybe SMPServer)
+    sendViaProxy proxySrv_ destSess@(_, _, qId) = do
+      r <- tryAgentError . withProxySession c proxySrv_ destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess@ProxiedRelay {prBasicAuth}) -> do
         r' <- liftClient SMP (clientServer smp) $ sendCmdViaProxy smp proxySess
+        let proxySrv = protocolClientServer' smp
         case r' of
-          Right () -> pure . Just $ protocolClientServer' smp
+          Right () -> pure $ Just proxySrv
           Left proxyErr -> do
             case proxyErr of
-              (ProxyProtocolError (SMP.PROXY SMP.NO_SESSION)) -> atomically deleteRelaySession
-              _ -> pure ()
-            throwE
-              PROXY
-                { proxyServer = protocolClientServer smp,
-                  relayServer = B.unpack $ strEncode destSrv,
-                  proxyErr
-                }
+              ProxyProtocolError (SMP.PROXY SMP.NO_SESSION) -> do
+                atomically deleteRelaySession
+                case proxySrv_ of
+                  Just _ -> proxyError
+                  -- sendViaProxy is called recursively here to re-create the session via the same server
+                  -- to avoid failure in interactive calls that don't retry after the session disconnection.
+                  Nothing -> sendViaProxy (Just $ ProtoServerWithAuth proxySrv prBasicAuth) destSess
+              _ -> proxyError
             where
+              proxyError =
+                throwE
+                  PROXY
+                    { proxyServer = protocolClientServer smp,
+                      relayServer = B.unpack $ strEncode destSrv,
+                      proxyErr
+                    }
               -- checks that the current proxied relay session is the same one that was used to send the message and removes it
               deleteRelaySession =
                 ( TM.lookup destSess (smpProxiedRelays c)
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 1837a256b..4b1e673b0 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -823,7 +823,7 @@ connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, t
         PKEY sId vr (chain, key) ->
           case supportedClientSMPRelayVRange `compatibleVersion` vr of
             Nothing -> throwE $ transportErr TEVersion
-            Just (Compatible v) -> liftEitherWith (const $ transportErr $ TEHandshake IDENTITY) $ ProxiedRelay sId v <$> validateRelay chain key
+            Just (Compatible v) -> liftEitherWith (const $ transportErr $ TEHandshake IDENTITY) $ ProxiedRelay sId v proxyAuth <$> validateRelay chain key
         r -> throwE $ unexpectedResponse r
   | otherwise = throwE $ PCETransportError TEVersion
   where
@@ -842,6 +842,7 @@ connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, t
 data ProxiedRelay = ProxiedRelay
   { prSessionId :: SessionId,
     prVersion :: VersionSMP,
+    prBasicAuth :: Maybe BasicAuth, -- auth is included here to allow reconnecting via the same proxy after NO_SESSION error
     prServerKey :: C.PublicKeyX25519
   }
 
@@ -902,7 +903,7 @@ proxySMPCommand ::
   SenderId ->
   Command 'Sender ->
   ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v serverKey) spKey sId command = do
+proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v _ serverKey) spKey sId command = do
   -- prepare params
   let serverThAuth = (\ta -> ta {serverPeerPubKey = serverKey}) <$> thAuth proxyThParams
       serverThParams = smpTHParamsSetVersion v proxyThParams {sessionId, thAuth = serverThAuth}
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 625dfbda7..7505ef977 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -34,7 +34,8 @@ import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
-import Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Protocol (EncRcvMsgBody (..), MsgBody, RcvMessage (..), SubscriptionMode (..), maxMessageLength, noMsgFlags)
+import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Util (bshow, tshow)
@@ -122,6 +123,8 @@ smpProxyTests = do
           agentViaProxyVersionError
         it "retries sending when destination or proxy relay is offline" $
           agentViaProxyRetryOffline
+        it "retries sending when destination relay session disconnects in proxy" $
+          agentViaProxyRetryNoSession
       describe "stress test 1k" $ do
         let deliver nAgents nMsgs = agentDeliverMessagesViaProxyConc (replicate nAgents [srv1]) (map bshow [1 :: Int .. nMsgs])
         it "2 agents, 250 messages" . oneServer $ deliver 2 250
@@ -157,7 +160,7 @@ deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do
   -- prepare receiving queue
   (rPub, rPriv) <- atomically $ C.generateAuthKeyPair alg g
   (rdhPub, rdhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-  QIK {rcvId, sndId, rcvPublicDhKey = srvDh} <- runExceptT' $ createSMPQueue rc (rPub, rPriv) rdhPub (Just "correct") SMSubscribe False
+  SMP.QIK {rcvId, sndId, rcvPublicDhKey = srvDh} <- runExceptT' $ createSMPQueue rc (rPub, rPriv) rdhPub (Just "correct") SMSubscribe False
   let dec = decryptMsgV3 $ C.dh' srvDh rdhPriv
   -- get proxy session
   sess0 <- runExceptT' $ connectSMPProxiedRelay pc relayServ (Just "correct")
@@ -374,18 +377,38 @@ agentViaProxyRetryOffline = do
     msgId = subtract baseId . fst
     servers srv = (initAgentServersProxy SPMAlways SPFProhibit) {smp = userServers [srv]}
 
+agentViaProxyRetryNoSession :: IO ()
+agentViaProxyRetryNoSession = do
+  let srv1 = SMPServer testHost testPort testKeyHash
+      srv2 = SMPServer testHost testPort2 testKeyHash
+  withAgent 1 agentCfg (servers srv1) testDB $ \a ->
+    withAgent 2 agentCfg (servers srv2) testDB2 $ \b -> do
+      withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ -> do
+        (aId, _) <- withServer2 $ \_ -> runRight $ makeConnection a b
+        nGet b =##> \case ("", "", DOWN _ [c]) -> c == aId; _ -> False
+        withServer2 $ \_ -> do
+          nGet b =##> \case ("", "", UP _ [c]) -> c == aId; _ -> False
+          -- to test retry in case of NO_SESSION error,
+          -- the client using server 1 as proxy and server 2 as destination
+          -- should be joining the connection, so the order is swapped here.
+          _ <- runRight $ makeConnection b a
+          pure ()
+  where
+    withServer2 = withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just testStoreLogFile2, storeMsgsFile = Just testStoreMsgsFile2} testPort2
+    servers srv = (initAgentServersProxy SPMAlways SPFProhibit) {smp = userServers [srv]}
+
 testNoProxy :: IO ()
 testNoProxy = do
   withSmpServerConfigOn (transport @TLS) cfg testPort2 $ \_ -> do
     testSMPClient_ "127.0.0.1" testPort2 proxyVRangeV8 $ \(th :: THandleSMP TLS 'TClient) -> do
-      (_, _, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", PRXY testSMPServer Nothing)
+      (_, _, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", SMP.PRXY testSMPServer Nothing)
       reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
 
 testProxyAuth :: IO ()
 testProxyAuth = do
   withSmpServerConfigOn (transport @TLS) proxyCfgAuth testPort $ \_ -> do
     testSMPClient_ "127.0.0.1" testPort proxyVRangeV8 $ \(th :: THandleSMP TLS 'TClient) -> do
-      (_, _s, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", PRXY testSMPServer2 $ Just "wrong")
+      (_, _s, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", SMP.PRXY testSMPServer2 $ Just "wrong")
       reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
   where
     proxyCfgAuth = proxyCfg {newQueueBasicAuth = Just "correct"}

From 492d2f86bc5fa23f33f0b5e743c9b44e1d19049b Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sat, 13 Jul 2024 22:34:10 +0100
Subject: [PATCH 035/195] smp server: additional control port commands to
 monitor server state (#1228)

* smp server: additional control port commands to monitor server state

* fix

* space
---
 src/Simplex/Messaging/Server.hs         | 46 ++++++++++++++++++++++---
 src/Simplex/Messaging/Server/Control.hs |  4 +++
 2 files changed, 46 insertions(+), 4 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 014bcd366..d88b2349a 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -6,7 +6,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
@@ -60,6 +59,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
+import qualified Data.Set as S
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
@@ -377,7 +377,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                   let age = systemSeconds now - systemSeconds createdAt
                   subscriptions' <- bshow . M.size <$> readTVarIO subscriptions
                   hPutStrLn h . B.unpack $ B.intercalate "," [bshow cid, encode sessionId, connected', strEncode createdAt, rcvActiveAt', sndActiveAt', bshow age, subscriptions']
-              CPStats -> withAdminRole $ do
+              CPStats -> withUserRole $ do
                 ss <- unliftIO u $ asks serverStats
                 let putStat :: Show a => ByteString -> (ServerStats -> TVar a) -> IO ()
                     putStat label var = readTVarIO (var ss) >>= \v -> B.hPutStr h $ label <> ": " <> bshow v <> "\n"
@@ -391,6 +391,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                 putStat "qDeletedAll" qDeletedAll
                 putStat "qDeletedNew" qDeletedNew
                 putStat "qDeletedSecured" qDeletedSecured
+                readTVarIO (day $ activeQueues ss) >>= \v -> B.hPutStr h $ "dayMsgQueues" <> ": " <> bshow (S.size v) <> "\n"
                 putStat "msgSent" msgSent
                 putStat "msgRecv" msgRecv
                 putStat "msgSentNtf" msgSentNtf
@@ -414,7 +415,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
 #else
                 hPutStrLn h "Not available on GHC 8.10"
 #endif
-              CPSockets -> withAdminRole $ do
+              CPSockets -> withUserRole $ do
                 (accepted', closed', active') <- unliftIO u $ asks sockets
                 (accepted, closed, active) <- atomically $ (,,) <$> readTVar accepted' <*> readTVar closed' <*> readTVar active'
                 hPutStrLn h "Sockets: "
@@ -436,6 +437,43 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
 #else
                 hPutStrLn h "Not available on GHC 8.10"
 #endif
+              CPServerInfo -> readTVarIO role >>= \case
+                CPRNone -> do
+                  logError "Unauthorized control port command"
+                  hPutStrLn h "AUTH"
+                r -> do
+#if MIN_VERSION_base(4,18,0)
+                  threads <- liftIO listThreads
+                  hPutStrLn h $ "Threads: " <> show (length threads)
+#else
+                  hPutStrLn h "Threads: not available on GHC 8.10"
+#endif
+                  Env {clients, server = Server {subscribers, notifiers}} <- unliftIO u ask
+                  activeClients <- readTVarIO clients
+                  hPutStrLn h $ "Clients: " <> show (IM.size activeClients)
+                  when (r == CPRAdmin) $ do
+                    (smpSubCnt, smpClCnt) <- countClientSubs subscriptions activeClients
+                    (ntfSubCnt, ntfClCnt) <- countClientSubs ntfSubscriptions activeClients
+                    hPutStrLn h $ "SMP subscriptions (via clients, slow): " <> show smpSubCnt
+                    hPutStrLn h $ "SMP subscribed clients (via clients, slow): " <> show smpClCnt
+                    hPutStrLn h $ "Ntf subscriptions (via clients, slow): " <> show ntfSubCnt
+                    hPutStrLn h $ "Ntf subscribed clients (via clients, slow): " <> show ntfClCnt
+                  activeSubs <- readTVarIO subscribers
+                  activeNtfSubs <- readTVarIO notifiers
+                  hPutStrLn h $ "SMP subscriptions: " <> show (M.size activeSubs)
+                  hPutStrLn h $ "SMP subscribed clients: " <> show (countSubClients activeSubs)
+                  hPutStrLn h $ "Ntf subscriptions: " <> show (M.size activeNtfSubs)
+                  hPutStrLn h $ "Ntf subscribed clients: " <> show (countSubClients activeNtfSubs)
+                  where
+                    countClientSubs :: (Client -> TMap QueueId a) -> IM.IntMap Client -> IO (Int, Int)
+                    countClientSubs subSel = foldM addSubs (0, 0)
+                      where
+                        addSubs :: (Int, Int) -> Client -> IO (Int, Int)
+                        addSubs (subCnt, clCnt) cl = do
+                          subs <- readTVarIO $ subSel cl
+                          let cnt = M.size subs
+                          pure (subCnt + cnt, clCnt + if cnt == 0 then 0 else 1)
+                    countSubClients = S.size . M.foldr' (S.insert . clientId) S.empty
               CPDelete queueId' -> withUserRole $ unliftIO u $ do
                 st <- asks queueStore
                 ms <- asks msgStore
@@ -455,7 +493,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                 hPutStrLn h "saving server state..."
                 unliftIO u $ saveServer True
                 hPutStrLn h "server state saved!"
-              CPHelp -> hPutStrLn h "commands: stats, stats-rts, clients, sockets, socket-threads, threads, delete, save, help, quit"
+              CPHelp -> hPutStrLn h "commands: stats, stats-rts, clients, sockets, socket-threads, threads, server-info, delete, save, help, quit"
               CPQuit -> pure ()
               CPSkip -> pure ()
               where
diff --git a/src/Simplex/Messaging/Server/Control.hs b/src/Simplex/Messaging/Server/Control.hs
index 9463fa777..b4c74e4ac 100644
--- a/src/Simplex/Messaging/Server/Control.hs
+++ b/src/Simplex/Messaging/Server/Control.hs
@@ -9,6 +9,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth)
 
 data CPClientRole = CPRNone | CPRUser | CPRAdmin
+  deriving (Eq)
 
 data ControlProtocol
   = CPAuth BasicAuth
@@ -20,6 +21,7 @@ data ControlProtocol
   | CPThreads
   | CPSockets
   | CPSocketThreads
+  | CPServerInfo
   | CPDelete ByteString
   | CPSave
   | CPHelp
@@ -37,6 +39,7 @@ instance StrEncoding ControlProtocol where
     CPThreads -> "threads"
     CPSockets -> "sockets"
     CPSocketThreads -> "socket-threads"
+    CPServerInfo -> "server-info"
     CPDelete bs -> "delete " <> strEncode bs
     CPSave -> "save"
     CPHelp -> "help"
@@ -53,6 +56,7 @@ instance StrEncoding ControlProtocol where
       "threads" -> pure CPThreads
       "sockets" -> pure CPSockets
       "socket-threads" -> pure CPSocketThreads
+      "server-info" -> pure CPServerInfo
       "delete" -> CPDelete <$> (A.space *> strP)
       "save" -> pure CPSave
       "help" -> pure CPHelp

From d4fa0af350dc44edbeaeff1d4881be1c830cb94b Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 14 Jul 2024 17:57:34 +0100
Subject: [PATCH 036/195] ntf: additional tests for token registration when
 server and device are restarted (#1230)

* ntf: additional tests for token registration when server and device are restarted

* test response timeouts
---
 tests/AgentTests/NotificationTests.hs | 152 ++++++++++++++++++++++++--
 1 file changed, 141 insertions(+), 11 deletions(-)

diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index a104c6cf5..92d97d641 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
@@ -49,6 +50,7 @@ import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Text.Encoding (encodeUtf8)
+import Database.SQLite.Simple.QQ (sql)
 import NtfClient
 import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testNtfServer, testNtfServer2)
 import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn)
@@ -56,13 +58,14 @@ import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMes
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore')
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, Env (..), InitialAgentServers)
 import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, SENT)
-import Simplex.Messaging.Agent.Store.SQLite (closeSQLiteStore, getSavedNtfToken, reopenSQLiteStore)
+import Simplex.Messaging.Agent.Store.SQLite (closeSQLiteStore, getSavedNtfToken, reopenSQLiteStore, withTransaction)
+import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
 import Simplex.Messaging.Notifications.Server.Push.APNS
-import Simplex.Messaging.Notifications.Types (NtfToken (..))
+import Simplex.Messaging.Notifications.Types (NtfTknAction (..), NtfToken (..))
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgFlags (MsgFlags), NtfServer, ProtocolServer (..), SMPMsgMeta (..), SubscriptionMode (..))
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
@@ -88,9 +91,21 @@ notificationTests t = do
     it "should allow the second registration with different credentials and delete the first after verification" $
       withAPNSMockServer $ \apns ->
         withNtfServer t $ testNtfTokenSecondRegistration apns
-    it "should re-register token when notification server is restarted" $
+    it "should verify token after notification server is restarted" $
       withAPNSMockServer $ \apns ->
         testNtfTokenServerRestart t apns
+    it "should re-verify token after notification server is restarted" $
+      withAPNSMockServer $ \apns ->
+        testNtfTokenServerRestartReverify t apns
+    it "should re-verify token after notification server is restarted when first request timed-out" $
+      withAPNSMockServer $ \apns ->
+        testNtfTokenServerRestartReverifyTimeout t apns
+    it "should re-register token when notification server is restarted" $
+      withAPNSMockServer $ \apns ->
+        testNtfTokenServerRestartReregister t apns
+    it "should re-register token when notification server is restarted when first request timed-out" $
+      withAPNSMockServer $ \apns ->
+        testNtfTokenServerRestartReregisterTimeout t apns
     it "should work with multiple configured servers" $
       withAPNSMockServer $ \apns ->
         testNtfTokenMultipleServers t apns
@@ -251,7 +266,7 @@ testNtfTokenServerRestart :: ATransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestart t APNSMockServer {apnsQ} = do
   let tkn = DeviceToken PPApnsTest "abcd"
   ntfData <- withAgent 1 agentCfg initAgentServers testDB $ \a ->
-    withNtfServer t . runRight $ do
+    withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
       APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
         atomically $ readTBQueue apnsQ
@@ -262,16 +277,131 @@ testNtfTokenServerRestart t APNSMockServer {apnsQ} = do
   withAgent 2 agentCfg initAgentServers testDB $ \a' ->
     -- server stopped before token is verified, so now the attempt to verify it will return AUTH error but re-register token,
     -- so that repeat verification happens without restarting the clients, when notification arrives
-    withNtfServer t . runRight_ $ do
+    withNtfServerStoreLog t $ \_ -> runRight_ $ do
       verification <- ntfData .-> "verification"
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
-      Left (NTF _ AUTH) <- tryE $ verifyNtfToken a' tkn nonce verification
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
+      verifyNtfToken a' tkn nonce verification
+      NTActive <- checkNtfToken a' tkn
+      pure ()
+
+testNtfTokenServerRestartReverify :: ATransport -> APNSMockServer -> IO ()
+testNtfTokenServerRestartReverify t APNSMockServer {apnsQ} = do
+  let tkn = DeviceToken PPApnsTest "abcd"
+  withAgent 1 agentCfg initAgentServers testDB $ \a -> do
+    ntfData <- withNtfServerStoreLog t $ \_ -> runRight $ do
+      NTRegistered <- registerNtfToken a tkn NMPeriodic
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
         atomically $ readTBQueue apnsQ
-      verification' <- ntfData' .-> "verification"
-      nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
-      liftIO $ sendApnsResponse' APNSRespOk
-      verifyNtfToken a' tkn nonce' verification'
+      liftIO $ sendApnsResponse APNSRespOk
+      pure ntfData
+    runRight_ $ do
+      verification <- ntfData .-> "verification"
+      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      Left (BROKER _ NETWORK) <- tryE $ verifyNtfToken a tkn nonce verification
+      pure ()
+  threadDelay 1000000
+  withAgent 2 agentCfg initAgentServers testDB $ \a' ->
+    -- server stopped before token is verified, so now the attempt to verify it will return AUTH error but re-register token,
+    -- so that repeat verification happens without restarting the clients, when notification arrives
+    withNtfServerStoreLog t $ \_ -> runRight_ $ do
+      NTActive <- registerNtfToken a' tkn NMPeriodic
+      NTActive <- checkNtfToken a' tkn
+      pure ()
+
+testNtfTokenServerRestartReverifyTimeout :: ATransport -> APNSMockServer -> IO ()
+testNtfTokenServerRestartReverifyTimeout t APNSMockServer {apnsQ} = do
+  let tkn = DeviceToken PPApnsTest "abcd"
+  withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
+    (nonce, verification) <- withNtfServerStoreLog t $ \_ -> runRight $ do
+      NTRegistered <- registerNtfToken a tkn NMPeriodic
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
+      verification <- ntfData .-> "verification"
+      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      verifyNtfToken a tkn nonce verification
+      pure (nonce, verification)
+    -- this emulates the situation when server verified token but the client did not receive the response
+    Just NtfToken {ntfTknStatus = NTActive, ntfTknAction = Just NTACheck, ntfDhSecret = Just dhSecret} <- withTransaction store getSavedNtfToken
+    Right code <- pure $ NtfRegCode <$> C.cbDecrypt dhSecret nonce verification
+    withTransaction store $ \db ->
+      DB.execute
+        db
+        [sql|
+          UPDATE ntf_tokens
+          SET tkn_status = ?, tkn_action = ?
+          WHERE provider = ? AND device_token = ?
+        |]
+        (NTConfirmed, Just (NTAVerify code), PPApnsTest, "abcd" :: ByteString)
+    Just NtfToken {ntfTknStatus = NTConfirmed, ntfTknAction = Just (NTAVerify _)} <- withTransaction store getSavedNtfToken
+    pure ()
+  threadDelay 1000000
+  withAgent 2 agentCfg initAgentServers testDB $ \a' ->
+    -- server stopped before token is verified, so now the attempt to verify it will return AUTH error but re-register token,
+    -- so that repeat verification happens without restarting the clients, when notification arrives
+    withNtfServerStoreLog t $ \_ -> runRight_ $ do
+      NTActive <- registerNtfToken a' tkn NMPeriodic
+      NTActive <- checkNtfToken a' tkn
+      pure ()
+
+testNtfTokenServerRestartReregister :: ATransport -> APNSMockServer -> IO ()
+testNtfTokenServerRestartReregister t APNSMockServer {apnsQ} = do
+  let tkn = DeviceToken PPApnsTest "abcd"
+  withAgent 1 agentCfg initAgentServers testDB $ \a ->
+    withNtfServerStoreLog t $ \_ -> runRight $ do
+      NTRegistered <- registerNtfToken a tkn NMPeriodic
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
+  -- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server
+  threadDelay 1000000
+  withAgent 2 agentCfg initAgentServers testDB $ \a' ->
+    -- server stopped before token is verified, and client might have lost verification notification.
+    -- so that repeat registration happens when client is restarted.
+    withNtfServerStoreLog t $ \_ -> runRight_ $ do
+      NTRegistered <- registerNtfToken a' tkn NMPeriodic
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
+      verification <- ntfData .-> "verification"
+      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      verifyNtfToken a' tkn nonce verification
+      NTActive <- checkNtfToken a' tkn
+      pure ()
+
+testNtfTokenServerRestartReregisterTimeout :: ATransport -> APNSMockServer -> IO ()
+testNtfTokenServerRestartReregisterTimeout t APNSMockServer {apnsQ} = do
+  let tkn = DeviceToken PPApnsTest "abcd"
+  withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
+    withNtfServerStoreLog t $ \_ -> runRight $ do
+      NTRegistered <- registerNtfToken a tkn NMPeriodic
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
+    -- this emulates the situation when server registered token but the client did not receive the response
+    withTransaction store $ \db ->
+      DB.execute
+        db
+        [sql|
+          UPDATE ntf_tokens
+          SET tkn_id = NULL, tkn_dh_secret = NULL, tkn_status = ?, tkn_action = ?
+          WHERE provider = ? AND device_token = ?
+        |]
+        (NTNew, Just NTARegister, PPApnsTest, "abcd" :: ByteString)
+    Just NtfToken {ntfTokenId = Nothing, ntfTknStatus = NTNew, ntfTknAction = Just NTARegister} <- withTransaction store getSavedNtfToken
+    pure ()
+  threadDelay 1000000
+  withAgent 2 agentCfg initAgentServers testDB $ \a' ->
+    -- server stopped before token is verified, and client might have lost verification notification.
+    -- so that repeat registration happens when client is restarted.
+    withNtfServerStoreLog t $ \_ -> runRight_ $ do
+      NTRegistered <- registerNtfToken a' tkn NMPeriodic
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
+      verification <- ntfData .-> "verification"
+      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      verifyNtfToken a' tkn nonce verification
       NTActive <- checkNtfToken a' tkn
       pure ()
 

From 291039159fbba8e3aa0ba244890a4f1085756cfc Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 14 Jul 2024 23:19:02 +0100
Subject: [PATCH 037/195] ntf server: use SOCKS proxy to connect to onion-only
 SMP servers (#1229)

* ntf server: use SOCKS proxy to connect to onion-only SMP servers

* fix test
---
 src/Simplex/Messaging/Client.hs               |  2 +-
 .../Messaging/Notifications/Server/Main.hs    | 23 ++++++++++++++++++-
 src/Simplex/Messaging/Server/CLI.hs           |  7 ++++++
 src/Simplex/Messaging/Server/Main.hs          |  5 ----
 tests/AgentTests/FunctionalAPITests.hs        |  3 +--
 5 files changed, 31 insertions(+), 9 deletions(-)

diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 4b1e673b0..4cfef92dd 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -240,7 +240,7 @@ data SocksMode
   = -- | always use SOCKS proxy when enabled
     SMAlways
   | -- | use SOCKS proxy only for .onion hosts when no public host is available
-    -- This mode is used in SMP proxy to minimize SOCKS proxy usage.
+    -- This mode is used in SMP proxy and in notifications server to minimize SOCKS proxy usage.
     SMOnion
   deriving (Eq, Show)
 
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index 351fe6d72..477b12bfc 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -7,6 +7,7 @@
 
 module Simplex.Messaging.Notifications.Server.Main where
 
+import Control.Monad ((<$!>))
 import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
 import Data.Maybe (fromMaybe)
@@ -14,6 +15,7 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
+import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Server (runNtfServer)
@@ -87,6 +89,14 @@ ntfServerCLI cfgPath logPath =
             <> ("port: " <> T.pack defaultServerPort <> "\n")
             <> "log_tls_errors: off\n"
             <> "websockets: off\n\n\
+               \[SUBSCRIBER]\n\
+               \# Network configuration for notification server client.\n\
+               \# SOCKS proxy port for subscribing to SMP servers.\n\
+               \# You may need a separate instance of SOCKS proxy for incoming single-hop requests.\n\
+               \# socks_proxy: localhost:9050\n\n\
+               \# `socks_mode` can be 'onion' for SOCKS proxy to be used for .onion destination hosts only (default)\n\
+               \# or 'always' to be used for all destination hosts (can be used if it is an .onion server).\n\
+               \# socks_mode: onion\n\n\
                \[INACTIVE_CLIENTS]\n\
                \# TTL and interval to check inactive clients\n\
                \disconnect: off\n"
@@ -115,7 +125,18 @@ ntfServerCLI cfgPath logPath =
               clientQSize = 64,
               subQSize = 512,
               pushQSize = 1048,
-              smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 0},
+              smpAgentCfg =
+                defaultSMPClientAgentConfig
+                  { smpCfg =
+                      (smpCfg defaultSMPClientAgentConfig)
+                        { networkConfig =
+                            defaultNetworkConfig
+                              { socksProxy = either error id <$!> strDecodeIni "SUBSCRIBER" "socks_proxy" ini,
+                                socksMode = either (const SMOnion) textToSocksMode $ lookupValue "SUBSCRIBER" "socks_mode" ini
+                              }
+                        },
+                    persistErrorInterval = 0 -- seconds
+                  },
               apnsConfig = defaultAPNSPushClientConfig,
               subsBatchSize = 900,
               inactiveClientExpiration =
diff --git a/src/Simplex/Messaging/Server/CLI.hs b/src/Simplex/Messaging/Server/CLI.hs
index 956b30816..c22c1a161 100644
--- a/src/Simplex/Messaging/Server/CLI.hs
+++ b/src/Simplex/Messaging/Server/CLI.hs
@@ -24,6 +24,7 @@ import qualified Data.X509.File as XF
 import Data.X509.Validation (Fingerprint (..))
 import Network.Socket (HostName, ServiceName)
 import Options.Applicative
+import Simplex.Messaging.Client (SocksMode (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI)
 import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..))
@@ -301,3 +302,9 @@ clearDirIfExists path = whenM (doesDirectoryExist path) $ listDirectory path >>=
 
 getEnvPath :: String -> FilePath -> IO FilePath
 getEnvPath name def = maybe def (\case "" -> def; f -> f) <$> lookupEnv name
+
+textToSocksMode :: Text -> SocksMode
+textToSocksMode = \case
+  "always" -> SMAlways
+  "onion" -> SMOnion
+  s -> error . T.unpack $ "Invalid socks_mode: " <> s
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 04e14544c..a135565bf 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -317,11 +317,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
               serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini,
               information = serverPublicInfo ini
             }
-        textToSocksMode :: Text -> SocksMode
-        textToSocksMode = \case
-          "always" -> SMAlways
-          "onion" -> SMOnion
-          s -> error . T.unpack $ "Invalid socks_mode: " <> s
         textToHostMode :: Text -> HostMode
         textToHostMode = \case
           "public" -> HMPublic
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 1893ae105..3f70ad6ab 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -1347,12 +1347,11 @@ testExpireManyMessages t =
         liftIO $ threadDelay 2000000
         5 <- sendMessage a bId SMP.noMsgFlags "4" -- this won't expire
         get a =##> \case ("", c, MERR 2 (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
-        -- get a =##> \case ("", c, MERRS [5, 6] (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
         let expected c e = bId == c && (e == TIMEOUT || e == NETWORK)
         get a >>= \case
           ("", c, MERR 3 (BROKER _ e)) -> do
             liftIO $ expected c e `shouldBe` True
-            get a =##> \case ("", c', MERR 4 (BROKER _ e')) -> expected c' e'; ("", c', MERRS [6] (BROKER _ e')) -> expected c' e'; _ -> False
+            get a =##> \case ("", c', MERR 4 (BROKER _ e')) -> expected c' e'; ("", c', MERRS [4] (BROKER _ e')) -> expected c' e'; _ -> False
           ("", c, MERRS [3] (BROKER _ e)) -> do
             liftIO $ expected c e `shouldBe` True
             get a =##> \case ("", c', MERR 4 (BROKER _ e')) -> expected c' e'; _ -> False

From 1bdfc8ae00c201eaad97d13c7ab55bd7539984f4 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 14 Jul 2024 23:21:14 +0100
Subject: [PATCH 038/195] 6.0.0.1

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index fbf95a7e5..303e84ef7 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.0.0
+version: 6.0.0.1
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index b7b1ca76c..0bfd62ce3 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.0.0
+version:        6.0.0.1
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 784d36d691381290e72884cc30c59ce646166134 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 15 Jul 2024 20:28:24 +0100
Subject: [PATCH 039/195] socks mode encoding (#1231)

* socks mode encoding

* test delays

* test delay

* unused import
---
 src/Simplex/Messaging/Client.hs                    | 10 ++++++++++
 src/Simplex/Messaging/Notifications/Server/Main.hs |  2 +-
 src/Simplex/Messaging/Server/CLI.hs                |  7 -------
 src/Simplex/Messaging/Server/Main.hs               |  2 +-
 tests/AgentTests/NotificationTests.hs              |  6 +++---
 5 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 4cfef92dd..80fd65ffc 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -244,6 +244,16 @@ data SocksMode
     SMOnion
   deriving (Eq, Show)
 
+instance StrEncoding SocksMode where
+  strEncode = \case
+    SMAlways -> "always"
+    SMOnion -> "onion"
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "always" -> pure SMAlways
+      "onion" -> pure SMOnion
+      _ -> fail "Invalid Socks mode"
+
 -- | network configuration for the client
 data NetworkConfig = NetworkConfig
   { -- | use SOCKS5 proxy
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index 477b12bfc..dadeb82fc 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -132,7 +132,7 @@ ntfServerCLI cfgPath logPath =
                         { networkConfig =
                             defaultNetworkConfig
                               { socksProxy = either error id <$!> strDecodeIni "SUBSCRIBER" "socks_proxy" ini,
-                                socksMode = either (const SMOnion) textToSocksMode $ lookupValue "SUBSCRIBER" "socks_mode" ini
+                                socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini
                               }
                         },
                     persistErrorInterval = 0 -- seconds
diff --git a/src/Simplex/Messaging/Server/CLI.hs b/src/Simplex/Messaging/Server/CLI.hs
index c22c1a161..956b30816 100644
--- a/src/Simplex/Messaging/Server/CLI.hs
+++ b/src/Simplex/Messaging/Server/CLI.hs
@@ -24,7 +24,6 @@ import qualified Data.X509.File as XF
 import Data.X509.Validation (Fingerprint (..))
 import Network.Socket (HostName, ServiceName)
 import Options.Applicative
-import Simplex.Messaging.Client (SocksMode (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI)
 import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..))
@@ -302,9 +301,3 @@ clearDirIfExists path = whenM (doesDirectoryExist path) $ listDirectory path >>=
 
 getEnvPath :: String -> FilePath -> IO FilePath
 getEnvPath name def = maybe def (\case "" -> def; f -> f) <$> lookupEnv name
-
-textToSocksMode :: Text -> SocksMode
-textToSocksMode = \case
-  "always" -> SMAlways
-  "onion" -> SMOnion
-  s -> error . T.unpack $ "Invalid socks_mode: " <> s
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index a135565bf..784d0504a 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -305,7 +305,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
                           networkConfig =
                             defaultNetworkConfig
                               { socksProxy = either error id <$!> strDecodeIni "PROXY" "socks_proxy" ini,
-                                socksMode = either (const SMOnion) textToSocksMode $ lookupValue "PROXY" "socks_mode" ini,
+                                socksMode = maybe SMOnion (either error id) $! strDecodeIni "PROXY" "socks_mode" ini,
                                 hostMode = either (const HMPublic) textToHostMode $ lookupValue "PROXY" "host_mode" ini,
                                 requiredHostMode = fromMaybe False $ iniOnOff "PROXY" "required_host_mode" ini
                               }
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 92d97d641..fd737e913 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -507,14 +507,14 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
   threadDelay 500000
   suspendAgent alice 0
   closeSQLiteStore store
-  threadDelay 500000
+  threadDelay 1000000
 
   -- aliceNtf client doesn't have subscription and is allowed to get notification message
   withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do
     (_, [SMPMsgMeta {msgFlags = MsgFlags True}]) <- getNotificationMessage aliceNtf nonce message
     pure ()
 
-  threadDelay 500000
+  threadDelay 1000000
   reopenSQLiteStore store
   foregroundAgent alice
   threadDelay 500000
@@ -524,7 +524,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
     ackMessage alice bobId (baseId + 1) Nothing
     -- delete notification subscription
     toggleConnectionNtfs alice bobId False
-    liftIO $ threadDelay 250000
+    liftIO $ threadDelay 500000
     -- send message
     2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
     get bob ##> ("", aliceId, SENT $ baseId + 2)

From b40d55c358ebabeb6cf1eca8e64016e2bae09a15 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 15 Jul 2024 20:30:39 +0100
Subject: [PATCH 040/195] 6.0.0.2

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index 303e84ef7..2604ad56e 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.0.1
+version: 6.0.0.2
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 0bfd62ce3..6c8c924d5 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.0.1
+version:        6.0.0.2
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 8d56b0ba8519bdc68a3777d8d0672fbe01957479 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 17 Jul 2024 13:01:17 +0100
Subject: [PATCH 041/195] agent: allow starting only XFTP sending workers
 (#1232)

* agent: allow starting only XFTP sending workers

* use Bool param

* flip bool

* update
---
 src/Simplex/FileTransfer/Agent.hs | 15 ++++++++++++---
 src/Simplex/Messaging/Agent.hs    |  7 ++++++-
 2 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 4683143c5..725444086 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -12,6 +12,7 @@
 
 module Simplex.FileTransfer.Agent
   ( startXFTPWorkers,
+    startXFTPSndWorkers,
     closeXFTPAgent,
     toFSFilePath,
     -- Receiving files
@@ -82,13 +83,21 @@ import UnliftIO.Directory
 import qualified UnliftIO.Exception as E
 
 startXFTPWorkers :: AgentClient -> Maybe FilePath -> AM ()
-startXFTPWorkers c workDir = do
+startXFTPWorkers = startXFTPWorkers_ True
+{-# INLINE startXFTPWorkers #-}
+
+startXFTPSndWorkers :: AgentClient -> Maybe FilePath -> AM ()
+startXFTPSndWorkers = startXFTPWorkers_ False
+{-# INLINE startXFTPSndWorkers #-}
+
+startXFTPWorkers_ :: Bool -> AgentClient -> Maybe FilePath -> AM ()
+startXFTPWorkers_ allWorkers c workDir = do
   wd <- asks $ xftpWorkDir . xftpAgent
   atomically $ writeTVar wd workDir
   cfg <- asks config
-  startRcvFiles cfg
+  when allWorkers $ startRcvFiles cfg
   startSndFiles cfg
-  startDelFiles cfg
+  when allWorkers $ startDelFiles cfg
   where
     startRcvFiles :: AgentConfig -> AM ()
     startRcvFiles AgentConfig {rcvFilesTTL} = do
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index c08e04298..94ed7f44f 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -92,6 +92,7 @@ module Simplex.Messaging.Agent
     getNtfTokenData,
     toggleConnectionNtfs,
     xftpStartWorkers,
+    xftpStartSndWorkers,
     xftpReceiveFile,
     xftpDeleteRcvFile,
     xftpDeleteRcvFiles,
@@ -146,7 +147,7 @@ import Data.Time.Clock
 import Data.Time.Clock.System (systemToUTCTime)
 import Data.Traversable (mapAccumL)
 import Data.Word (Word16)
-import Simplex.FileTransfer.Agent (closeXFTPAgent, deleteSndFileInternal, deleteSndFileRemote, deleteSndFilesInternal, deleteSndFilesRemote, startXFTPWorkers, toFSFilePath, xftpDeleteRcvFile', xftpDeleteRcvFiles', xftpReceiveFile', xftpSendDescription', xftpSendFile')
+import Simplex.FileTransfer.Agent (closeXFTPAgent, deleteSndFileInternal, deleteSndFileRemote, deleteSndFilesInternal, deleteSndFilesRemote, startXFTPSndWorkers, startXFTPWorkers, toFSFilePath, xftpDeleteRcvFile', xftpDeleteRcvFiles', xftpReceiveFile', xftpSendDescription', xftpSendFile')
 import Simplex.FileTransfer.Description (ValidFileDescription)
 import Simplex.FileTransfer.Protocol (FileParty (..))
 import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
@@ -522,6 +523,10 @@ xftpStartWorkers :: AgentClient -> Maybe FilePath -> AE ()
 xftpStartWorkers c = withAgentEnv c . startXFTPWorkers c
 {-# INLINE xftpStartWorkers #-}
 
+xftpStartSndWorkers :: AgentClient -> Maybe FilePath -> AE ()
+xftpStartSndWorkers c = withAgentEnv c . startXFTPSndWorkers c
+{-# INLINE xftpStartSndWorkers #-}
+
 -- | Receive XFTP file
 xftpReceiveFile :: AgentClient -> UserId -> ValidFileDescription 'FRecipient -> Maybe CryptoFileArgs -> Bool -> AE RcvFileId
 xftpReceiveFile c = withAgentEnv c .:: xftpReceiveFile' c

From e59a098e667d49f2c4981f856a7e50df00c7f4e2 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Thu, 18 Jul 2024 10:59:48 +0100
Subject: [PATCH 042/195] smp server: remove subscriptions from the clients
 when queues are deleted (#1234)

* smp server: remove subscriptions from the clients when queues are deleted

* remove ntf subscriptions, update stats

* add GET stats
---
 src/Simplex/Messaging/Server.hs         | 208 +++++++++++++++---------
 src/Simplex/Messaging/Server/Env/STM.hs |   6 +-
 src/Simplex/Messaging/Server/Stats.hs   |  70 ++++++++
 tests/ServerTests.hs                    |   6 +-
 4 files changed, 212 insertions(+), 78 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index d88b2349a..1d7398b43 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -158,7 +158,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       forall s.
       Server ->
       String ->
-      (Server -> TQueue (QueueId, Client)) ->
+      (Server -> TQueue (QueueId, Client, Subscribed)) ->
       (Server -> TMap QueueId Client) ->
       (Client -> TMap QueueId s) ->
       (s -> IO ()) ->
@@ -172,14 +172,16 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       where
         updateSubscribers :: STM (Maybe (QueueId, Client))
         updateSubscribers = do
-          (qId, clnt) <- readTQueue $ subQ s
-          let clientToBeNotified c' =
-                if sameClientId clnt c'
-                  then pure Nothing
-                  else do
+          (qId, clnt, subscribed) <- readTQueue $ subQ s
+          let updateSub
+                | subscribed = TM.lookupInsert qId clnt (subs s)
+                | otherwise = TM.lookupDelete qId (subs s)
+              clientToBeNotified c'
+                | sameClientId clnt c' = pure Nothing
+                | otherwise = do
                     yes <- readTVar $ connected c'
                     pure $ if yes then Just (qId, c') else Nothing
-          TM.lookupInsert qId clnt (subs s) $>>= clientToBeNotified
+          updateSub $>>= clientToBeNotified
         endPreviousSubscriptions :: (QueueId, Client) -> M (Maybe s)
         endPreviousSubscriptions (qId, c) = do
           forkClient c (label <> ".endPreviousSubscriptions") $
@@ -229,7 +231,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
       liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
       liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
-      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubAuth, qSubDuplicate, qSubProhibited, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv} <- asks serverStats
+      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubNoMsg, qSubAuth, qSubDuplicate, qSubProhibited, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv} <- asks serverStats
       let interval = 1000000 * logInterval
       forever $ do
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
@@ -242,6 +244,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           qDeletedNew' <- atomically $ swapTVar qDeletedNew 0
           qDeletedSecured' <- atomically $ swapTVar qDeletedSecured 0
           qSub' <- atomically $ swapTVar qSub 0
+          qSubNoMsg' <- atomically $ swapTVar qSubNoMsg 0
           qSubAuth' <- atomically $ swapTVar qSubAuth 0
           qSubDuplicate' <- atomically $ swapTVar qSubDuplicate 0
           qSubProhibited' <- atomically $ swapTVar qSubProhibited 0
@@ -250,6 +253,12 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           msgSentQuota' <- atomically $ swapTVar msgSentQuota 0
           msgSentLarge' <- atomically $ swapTVar msgSentLarge 0
           msgRecv' <- atomically $ swapTVar msgRecv 0
+          msgRecvGet' <- atomically $ swapTVar msgRecvGet 0
+          msgGet' <- atomically $ swapTVar msgGet 0
+          msgGetNoMsg' <- atomically $ swapTVar msgGetNoMsg 0
+          msgGetAuth' <- atomically $ swapTVar msgGetAuth 0
+          msgGetDuplicate' <- atomically $ swapTVar msgGetDuplicate 0
+          msgGetProhibited' <- atomically $ swapTVar msgGetProhibited 0
           msgExpired' <- atomically $ swapTVar msgExpired 0
           ps <- atomically $ periodStatCounts activeQueues ts
           msgSentNtf' <- atomically $ swapTVar msgSentNtf 0
@@ -302,7 +311,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                        show msgSentLarge',
                        show msgNtfs',
                        show msgNtfNoSub',
-                       show msgNtfLost'
+                       show msgNtfLost',
+                       show qSubNoMsg',
+                       show msgRecvGet',
+                       show msgGet',
+                       show msgGetNoMsg',
+                       show msgGetAuth',
+                       show msgGetDuplicate',
+                       show msgGetProhibited'
                      ]
               )
         liftIO $ threadDelay' interval
@@ -394,6 +410,12 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                 readTVarIO (day $ activeQueues ss) >>= \v -> B.hPutStr h $ "dayMsgQueues" <> ": " <> bshow (S.size v) <> "\n"
                 putStat "msgSent" msgSent
                 putStat "msgRecv" msgRecv
+                putStat "msgRecvGet" msgRecvGet
+                putStat "msgGet" msgGet
+                putStat "msgGetNoMsg" msgGetNoMsg
+                putStat "msgGetAuth" msgGetAuth
+                putStat "msgGetDuplicate" msgGetDuplicate
+                putStat "msgGetProhibited" msgGetProhibited
                 putStat "msgSentNtf" msgSentNtf
                 putStat "msgRecvNtf" msgRecvNtf
                 putStat "qCount" qCount
@@ -452,9 +474,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                   activeClients <- readTVarIO clients
                   hPutStrLn h $ "Clients: " <> show (IM.size activeClients)
                   when (r == CPRAdmin) $ do
-                    (smpSubCnt, smpClCnt) <- countClientSubs subscriptions activeClients
-                    (ntfSubCnt, ntfClCnt) <- countClientSubs ntfSubscriptions activeClients
+                    (smpSubCnt, smpSubCntByGroup, smpClCnt) <- countClientSubs subscriptions countSMPSubs activeClients
+                    (ntfSubCnt, _, ntfClCnt) <- countClientSubs ntfSubscriptions (\_ -> pure (0, 0, 0, 0)) activeClients
                     hPutStrLn h $ "SMP subscriptions (via clients, slow): " <> show smpSubCnt
+                    hPutStrLn h $ "SMP subscriptions (by group: NoSub, SubPending, SubThread, ProhibitSub): " <> show smpSubCntByGroup
                     hPutStrLn h $ "SMP subscribed clients (via clients, slow): " <> show smpClCnt
                     hPutStrLn h $ "Ntf subscriptions (via clients, slow): " <> show ntfSubCnt
                     hPutStrLn h $ "Ntf subscribed clients (via clients, slow): " <> show ntfClCnt
@@ -465,14 +488,25 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                   hPutStrLn h $ "Ntf subscriptions: " <> show (M.size activeNtfSubs)
                   hPutStrLn h $ "Ntf subscribed clients: " <> show (countSubClients activeNtfSubs)
                   where
-                    countClientSubs :: (Client -> TMap QueueId a) -> IM.IntMap Client -> IO (Int, Int)
-                    countClientSubs subSel = foldM addSubs (0, 0)
+                    countClientSubs :: (Client -> TMap QueueId a) -> (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap Client -> IO (Int, (Int, Int, Int, Int), Int)
+                    countClientSubs subSel countSubs = foldM addSubs (0, (0, 0, 0, 0), 0)
                       where
-                        addSubs :: (Int, Int) -> Client -> IO (Int, Int)
-                        addSubs (subCnt, clCnt) cl = do
+                        addSubs :: (Int, (Int, Int, Int, Int), Int) -> Client -> IO (Int, (Int, Int, Int, Int), Int)
+                        addSubs (subCnt, (c1, c2, c3, c4), clCnt) cl = do
                           subs <- readTVarIO $ subSel cl
+                          (c1', c2', c3', c4') <- countSubs subs
                           let cnt = M.size subs
-                          pure (subCnt + cnt, clCnt + if cnt == 0 then 0 else 1)
+                              cnts' = (c1 + c1', c2 + c2', c3 + c3', c4 + c4')
+                          pure (subCnt + cnt, cnts', clCnt + if cnt == 0 then 0 else 1)
+                    countSMPSubs :: M.Map QueueId Sub -> IO (Int, Int, Int, Int)
+                    countSMPSubs = foldM countSubs (0, 0, 0, 0)
+                      where
+                        countSubs (c1, c2, c3, c4) Sub {subThread} =
+                          readTVarIO subThread >>= \st -> pure $ case st of
+                            NoSub -> (c1 + 1, c2, c3, c4)
+                            SubPending -> (c1, c2 + 1, c3, c4)
+                            SubThread _ -> (c1, c2, c3 + 1, c4)
+                            ProhibitSub -> (c1, c2, c3, c4 + 1)
                     countSubClients = S.size . M.foldr' (S.insert . clientId) S.empty
               CPDelete queueId' -> withUserRole $ unliftIO u $ do
                 st <- asks queueStore
@@ -531,19 +565,22 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
     noSubscriptions c = atomically $ (&&) <$> TM.null (subscriptions c) <*> TM.null (ntfSubscriptions c)
 
 clientDisconnected :: Client -> M ()
-clientDisconnected c@Client {clientId, subscriptions, connected, sessionId, endThreads} = do
+clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, connected, sessionId, endThreads} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " disc"
-  subs <- atomically $ do
+  (subs, ntfSubs) <- atomically $ do
     writeTVar connected False
-    swapTVar subscriptions M.empty
+    (,) <$> swapTVar subscriptions M.empty <*> swapTVar ntfSubscriptions M.empty
   liftIO $ mapM_ cancelSub subs
-  srvSubs <- asks $ subscribers . server
-  atomically $ modifyTVar' srvSubs $ \cs ->
-    M.foldrWithKey (\sub _ -> M.update deleteCurrentClient sub) cs subs
+  Server {subscribers, notifiers} <- asks server
+  updateSubscribers subs subscribers
+  updateSubscribers ntfSubs notifiers
   asks clients >>= atomically . (`modifyTVar'` IM.delete clientId)
   tIds <- atomically $ swapTVar endThreads IM.empty
   liftIO $ mapM_ (mapM_ killThread <=< deRefWeak) tIds
   where
+    updateSubscribers subs srvSubs = do
+      atomically $ modifyTVar' srvSubs $ \cs ->
+        M.foldrWithKey (\sub _ -> M.update deleteCurrentClient sub) cs subs
     deleteCurrentClient :: Client -> Maybe Client
     deleteCurrentClient c'
       | sameClientId c c' = Nothing
@@ -579,8 +616,9 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
               VRVerified qr -> pure $ Right (qr, (corrId, entId, cmd))
               VRFailed -> do
                 case cmd of
-                  Cmd _ SEND {} -> atomically $ modifyTVar' (msgSentAuth stats) (+ 1)
-                  Cmd _ SUB -> atomically $ modifyTVar' (qSubAuth stats) (+ 1)
+                  Cmd _ SEND {} -> incStat $ msgSentAuth stats
+                  Cmd _ SUB -> incStat $ qSubAuth stats
+                  Cmd _ GET -> incStat $ msgGetAuth stats
                   _ -> pure ()
                 pure $ Left (corrId, entId, ERR AUTH)
     write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
@@ -808,8 +846,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
     transportErr = PROXY . BROKER . TRANSPORT
     mkIncProxyStats :: MonadIO m => ProxyStats -> ProxyStats -> OwnServer -> (ProxyStats -> TVar Int) -> m ()
     mkIncProxyStats ps psOwn own sel = do
-      atomically $ modifyTVar' (sel ps) (+ 1)
-      when own $ atomically $ modifyTVar' (sel psOwn) (+ 1)
+      incStat $ sel ps
+      when own $ incStat $ sel psOwn
     processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
     processCommand (qr_, (corrId, queueId, cmd)) = case cmd of
       Cmd SProxiedClient command -> processProxiedCmd (corrId, queueId, command)
@@ -878,8 +916,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 Right _ -> do
                   withLog (`logCreateById` rId)
                   stats <- asks serverStats
-                  atomically $ modifyTVar' (qCreated stats) (+ 1)
-                  atomically $ modifyTVar' (qCount stats) (+ 1)
+                  incStat $ qCreated stats
+                  incStat $ qCount stats
                   case subMode of
                     SMOnlyCreate -> pure ()
                     SMSubscribe -> void $ subscribeQueue qr rId
@@ -901,7 +939,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           withLog $ \s -> logSecureQueue s rId sKey
           st <- asks queueStore
           stats <- asks serverStats
-          atomically $ modifyTVar' (qSecured stats) (+ 1)
+          incStat $ qSecured stats
           atomically $ either ERR (const OK) <$> secureQueue st rId sKey
 
         addQueueNotifier_ :: QueueStore -> NtfPublicAuthKey -> RcvNtfPublicDhKey -> M (Transmission BrokerMsg)
@@ -925,7 +963,12 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
         deleteQueueNotifier_ :: QueueStore -> M (Transmission BrokerMsg)
         deleteQueueNotifier_ st = do
           withLog (`logDeleteNotifier` queueId)
-          okResp <$> atomically (deleteQueueNotifier st queueId)
+          atomically (deleteQueueNotifier st queueId) >>= \case
+            Right () -> do
+              -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
+              atomically $ writeTQueue ntfSubscribedQ (queueId, clnt, False)
+              pure ok
+            Left e -> pure $ err e
 
         suspendQueue_ :: QueueStore -> M (Transmission BrokerMsg)
         suspendQueue_ st = do
@@ -934,60 +977,69 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
 
         subscribeQueue :: QueueRec -> RecipientId -> M (Transmission BrokerMsg)
         subscribeQueue qr rId = do
-          stats <- asks serverStats
           atomically (TM.lookup rId subscriptions) >>= \case
-            Nothing -> do
-              atomically $ modifyTVar' (qSub stats) (+ 1)
-              newSub >>= deliver
-            Just s@Sub {subThread} ->
+            Nothing -> newSub >>= deliver True
+            Just s@Sub {subThread} -> do
+              stats <- asks serverStats
               readTVarIO subThread >>= \case
                 ProhibitSub -> do
                   -- cannot use SUB in the same connection where GET was used
-                  atomically $ modifyTVar' (qSubProhibited stats) (+ 1)
+                  incStat $ qSubProhibited stats
                   pure (corrId, rId, ERR $ CMD PROHIBITED)
                 _ -> do
-                  atomically $ modifyTVar' (qSubDuplicate stats) (+ 1)
-                  atomically (tryTakeTMVar $ delivered s) >> deliver s
+                  incStat $ qSubDuplicate stats
+                  atomically (tryTakeTMVar $ delivered s) >> deliver False s
           where
             newSub :: M Sub
             newSub = time "SUB newSub" . atomically $ do
-              writeTQueue subscribedQ (rId, clnt)
+              writeTQueue subscribedQ (rId, clnt, True)
               sub <- newSubscription NoSub
               TM.insert rId sub subscriptions
               pure sub
-            deliver :: Sub -> M (Transmission BrokerMsg)
-            deliver sub = do
+            deliver :: Bool -> Sub -> M (Transmission BrokerMsg)
+            deliver inc sub = do
               q <- getStoreMsgQueue "SUB" rId
               msg_ <- atomically $ tryPeekMsg q
+              when inc $ do
+                stats <- asks serverStats
+                incStat $ (if isJust msg_ then qSub else qSubNoMsg) stats
               deliverMessage "SUB" qr rId sub msg_
 
         getMessage :: QueueRec -> M (Transmission BrokerMsg)
         getMessage qr = time "GET" $ do
           atomically (TM.lookup queueId subscriptions) >>= \case
             Nothing ->
-              atomically newSub >>= getMessage_
+              atomically newSub >>= (`getMessage_` Nothing)
             Just s@Sub {subThread} ->
               readTVarIO subThread >>= \case
                 ProhibitSub ->
                   atomically (tryTakeTMVar $ delivered s)
-                    >> getMessage_ s
+                    >>= getMessage_ s
                 -- cannot use GET in the same connection where there is an active subscription
-                _ -> pure (corrId, queueId, ERR $ CMD PROHIBITED)
+                _ -> do
+                  stats <- asks serverStats
+                  incStat $ msgGetProhibited stats
+                  pure (corrId, queueId, ERR $ CMD PROHIBITED)
           where
             newSub :: STM Sub
             newSub = do
               s <- newSubscription ProhibitSub
               TM.insert queueId s subscriptions
               pure s
-            getMessage_ :: Sub -> M (Transmission BrokerMsg)
-            getMessage_ s = do
+            getMessage_ :: Sub -> Maybe MsgId -> M (Transmission BrokerMsg)
+            getMessage_ s delivered_ = do
               q <- getStoreMsgQueue "GET" queueId
-              atomically $
-                tryPeekMsg q >>= \case
-                  Just msg ->
-                    let encMsg = encryptMsg qr msg
-                     in setDelivered s msg $> (corrId, queueId, MSG encMsg)
-                  _ -> pure (corrId, queueId, OK)
+              stats <- asks serverStats
+              (statCnt, r) <-
+                atomically $
+                  tryPeekMsg q >>= \case
+                    Just msg ->
+                      let encMsg = encryptMsg qr msg
+                          cnt = if isJust delivered_ then msgGetDuplicate else msgGet
+                       in setDelivered s msg $> (cnt, (corrId, queueId, MSG encMsg))
+                    _ -> pure (msgGetNoMsg, (corrId, queueId, OK))
+              incStat $ statCnt stats
+              pure r
 
         withQueue :: (QueueRec -> M (Transmission BrokerMsg)) -> M (Transmission BrokerMsg)
         withQueue action = maybe (pure $ err AUTH) action qr_
@@ -995,7 +1047,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
         subscribeNotifications :: M (Transmission BrokerMsg)
         subscribeNotifications = time "NSUB" . atomically $ do
           unlessM (TM.member queueId ntfSubscriptions) $ do
-            writeTQueue ntfSubscribedQ (queueId, clnt)
+            writeTQueue ntfSubscribedQ (queueId, clnt, True)
             TM.insert queueId () ntfSubscriptions
           pure ok
 
@@ -1010,11 +1062,11 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                   case st of
                     ProhibitSub -> do
                       deletedMsg_ <- atomically $ tryDelMsg q msgId
-                      mapM_ updateStats deletedMsg_
+                      mapM_ (updateStats True) deletedMsg_
                       pure ok
                     _ -> do
                       (deletedMsg_, msg_) <- atomically $ tryDelPeekMsg q msgId
-                      mapM_ updateStats deletedMsg_
+                      mapM_ (updateStats False) deletedMsg_
                       deliverMessage "ACK" qr queueId sub msg_
                 _ -> pure $ err NO_MSG
           where
@@ -1024,29 +1076,30 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 if msgId == msgId' || B.null msgId
                   then Just <$> readTVar subThread
                   else putTMVar delivered msgId' $> Nothing
-            updateStats :: Message -> M ()
-            updateStats = \case
+            updateStats :: Bool -> Message -> M ()
+            updateStats isGet = \case
               MessageQuota {} -> pure ()
               Message {msgFlags} -> do
                 stats <- asks serverStats
-                atomically $ modifyTVar' (msgRecv stats) (+ 1)
+                incStat $ msgRecv stats
+                when isGet $ incStat $ msgRecvGet stats
                 atomically $ modifyTVar' (msgCount stats) (subtract 1)
                 atomically $ updatePeriodStats (activeQueues stats) queueId
                 when (notification msgFlags) $ do
-                  atomically $ modifyTVar' (msgRecvNtf stats) (+ 1)
+                  incStat $ msgRecvNtf stats
                   atomically $ updatePeriodStats (activeQueuesNtf stats) queueId
 
         sendMessage :: QueueRec -> MsgFlags -> MsgBody -> M (Transmission BrokerMsg)
         sendMessage qr msgFlags msgBody
           | B.length msgBody > maxMessageLength thVersion = do
               stats <- asks serverStats
-              atomically $ modifyTVar' (msgSentLarge stats) (+ 1)
+              incStat $ msgSentLarge stats
               pure $ err LARGE_MSG
           | otherwise = do
               stats <- asks serverStats
               case status qr of
                 QueueOff -> do
-                  atomically $ modifyTVar' (msgSentAuth stats) (+ 1)
+                  incStat $ msgSentAuth stats
                   pure $ err AUTH
                 QueueActive ->
                   case C.maxLenBS msgBody of
@@ -1058,7 +1111,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                         atomically . writeMsg q =<< mkMessage body
                       case msg_ of
                         Nothing -> do
-                          atomically $ modifyTVar' (msgSentQuota stats) (+ 1)
+                          incStat $ msgSentQuota stats
                           pure $ err QUOTA
                         Just (msg, wasEmpty) -> time "SEND ok" $ do
                           when wasEmpty $ tryDeliverMessage msg
@@ -1066,16 +1119,16 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                             forM_ (notifier qr) $ \ntf -> do
                               asks random >>= atomically . trySendNotification ntf msg >>= \case
                                 Nothing -> do
-                                  atomically $ modifyTVar' (msgNtfNoSub stats) (+ 1)
+                                  incStat $ msgNtfNoSub stats
                                   logWarn "No notification subscription"
                                 Just False -> do
-                                  atomically $ modifyTVar' (msgNtfLost stats) (+ 1)
+                                  incStat $ msgNtfLost stats
                                   logWarn "Dropped message notification"
-                                Just True -> atomically $ modifyTVar' (msgNtfs stats) (+ 1)
-                            atomically $ modifyTVar' (msgSentNtf stats) (+ 1)
+                                Just True -> incStat $ msgNtfs stats
+                            incStat $ msgSentNtf stats
                             atomically $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
-                          atomically $ modifyTVar' (msgSent stats) (+ 1)
-                          atomically $ modifyTVar' (msgCount stats) (+ 1)
+                          incStat $ msgSent stats
+                          incStat $ msgCount stats
                           atomically $ updatePeriodStats (activeQueues stats) (recipientId qr)
                           pure ok
           where
@@ -1197,7 +1250,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           let fr = FwdResponse {fwdCorrId, fwdResponse = r2}
               r3 = EncFwdResponse $ C.cbEncryptNoPad sessSecret (C.reverseNonce proxyNonce) (smpEncode fr)
           stats <- asks serverStats
-          atomically $ modifyTVar' (pMsgFwdsRecv stats) (+ 1)
+          incStat $ pMsgFwdsRecv stats
           pure $ RRES r3
           where
             rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
@@ -1254,7 +1307,12 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           withLog (`logDeleteQueue` queueId)
           ms <- asks msgStore
           atomically (deleteQueue st queueId $>>= \q -> delMsgQueue ms queueId $> Right q) >>= \case
-            Right q -> updateDeletedStats q $> ok
+            Right q -> do
+              -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
+              atomically $ writeTQueue subscribedQ (queueId, clnt, False)
+              atomically $ writeTQueue ntfSubscribedQ (queueId, clnt, False)
+              updateDeletedStats q
+              pure ok
             Left e -> pure $ err e
 
         getQueueInfo :: QueueRec -> M (Transmission BrokerMsg)
@@ -1290,9 +1348,13 @@ updateDeletedStats :: QueueRec -> M ()
 updateDeletedStats q = do
   stats <- asks serverStats
   let delSel = if isNothing (senderKey q) then qDeletedNew else qDeletedSecured
-  atomically $ modifyTVar' (delSel stats) (+ 1)
-  atomically $ modifyTVar' (qDeletedAll stats) (+ 1)
-  atomically $ modifyTVar' (qCount stats) (subtract 1)
+  incStat $ delSel stats
+  incStat $ qDeletedAll stats
+  incStat $ qCount stats
+
+incStat :: MonadIO m => TVar Int -> m ()
+incStat v = atomically $ modifyTVar' v (+ 1)
+{-# INLINE incStat #-}
 
 withLog :: (StoreLog 'WriteMode -> IO a) -> M ()
 withLog action = do
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index b40e9fc16..dc77b7481 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -128,10 +128,12 @@ data Env = Env
     proxyAgent :: ProxyAgent -- senders served on this proxy
   }
 
+type Subscribed = Bool
+
 data Server = Server
-  { subscribedQ :: TQueue (RecipientId, Client),
+  { subscribedQ :: TQueue (RecipientId, Client, Subscribed),
     subscribers :: TMap RecipientId Client,
-    ntfSubscribedQ :: TQueue (NotifierId, Client),
+    ntfSubscribedQ :: TQueue (NotifierId, Client, Subscribed),
     notifiers :: TMap NotifierId Client,
     savingLock :: Lock
   }
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index f2716c9c3..2f4ed0613 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -27,6 +27,7 @@ data ServerStats = ServerStats
     qDeletedNew :: TVar Int,
     qDeletedSecured :: TVar Int,
     qSub :: TVar Int,
+    qSubNoMsg :: TVar Int,
     qSubAuth :: TVar Int,
     qSubDuplicate :: TVar Int,
     qSubProhibited :: TVar Int,
@@ -35,6 +36,12 @@ data ServerStats = ServerStats
     msgSentQuota :: TVar Int,
     msgSentLarge :: TVar Int,
     msgRecv :: TVar Int,
+    msgRecvGet :: TVar Int,
+    msgGet :: TVar Int,
+    msgGetNoMsg :: TVar Int,
+    msgGetAuth :: TVar Int,
+    msgGetDuplicate :: TVar Int,
+    msgGetProhibited :: TVar Int,
     msgExpired :: TVar Int,
     activeQueues :: PeriodStats RecipientId,
     msgSentNtf :: TVar Int, -- sent messages with NTF flag
@@ -60,6 +67,7 @@ data ServerStatsData = ServerStatsData
     _qDeletedNew :: Int,
     _qDeletedSecured :: Int,
     _qSub :: Int,
+    _qSubNoMsg :: Int,
     _qSubAuth :: Int,
     _qSubDuplicate :: Int,
     _qSubProhibited :: Int,
@@ -68,6 +76,12 @@ data ServerStatsData = ServerStatsData
     _msgSentQuota :: Int,
     _msgSentLarge :: Int,
     _msgRecv :: Int,
+    _msgRecvGet :: Int,
+    _msgGet :: Int,
+    _msgGetNoMsg :: Int,
+    _msgGetAuth :: Int,
+    _msgGetDuplicate :: Int,
+    _msgGetProhibited :: Int,
     _msgExpired :: Int,
     _activeQueues :: PeriodStatsData RecipientId,
     _msgSentNtf :: Int,
@@ -95,6 +109,7 @@ newServerStats ts = do
   qDeletedNew <- newTVar 0
   qDeletedSecured <- newTVar 0
   qSub <- newTVar 0
+  qSubNoMsg <- newTVar 0
   qSubAuth <- newTVar 0
   qSubDuplicate <- newTVar 0
   qSubProhibited <- newTVar 0
@@ -103,6 +118,12 @@ newServerStats ts = do
   msgSentQuota <- newTVar 0
   msgSentLarge <- newTVar 0
   msgRecv <- newTVar 0
+  msgRecvGet <- newTVar 0
+  msgGet <- newTVar 0
+  msgGetNoMsg <- newTVar 0
+  msgGetAuth <- newTVar 0
+  msgGetDuplicate <- newTVar 0
+  msgGetProhibited <- newTVar 0
   msgExpired <- newTVar 0
   activeQueues <- newPeriodStats
   msgSentNtf <- newTVar 0
@@ -127,6 +148,7 @@ newServerStats ts = do
         qDeletedNew,
         qDeletedSecured,
         qSub,
+        qSubNoMsg,
         qSubAuth,
         qSubDuplicate,
         qSubProhibited,
@@ -135,6 +157,12 @@ newServerStats ts = do
         msgSentQuota,
         msgSentLarge,
         msgRecv,
+        msgRecvGet,
+        msgGet,
+        msgGetNoMsg,
+        msgGetAuth,
+        msgGetDuplicate,
+        msgGetProhibited,
         msgExpired,
         activeQueues,
         msgSentNtf,
@@ -161,6 +189,7 @@ getServerStatsData s = do
   _qDeletedNew <- readTVar $ qDeletedNew s
   _qDeletedSecured <- readTVar $ qDeletedSecured s
   _qSub <- readTVar $ qSub s
+  _qSubNoMsg <- readTVar $ qSubNoMsg s
   _qSubAuth <- readTVar $ qSubAuth s
   _qSubDuplicate <- readTVar $ qSubDuplicate s
   _qSubProhibited <- readTVar $ qSubProhibited s
@@ -169,6 +198,12 @@ getServerStatsData s = do
   _msgSentQuota <- readTVar $ msgSentQuota s
   _msgSentLarge <- readTVar $ msgSentLarge s
   _msgRecv <- readTVar $ msgRecv s
+  _msgRecvGet <- readTVar $ msgRecvGet s
+  _msgGet <- readTVar $ msgGet s
+  _msgGetNoMsg <- readTVar $ msgGetNoMsg s
+  _msgGetAuth <- readTVar $ msgGetAuth s
+  _msgGetDuplicate <- readTVar $ msgGetDuplicate s
+  _msgGetProhibited <- readTVar $ msgGetProhibited s
   _msgExpired <- readTVar $ msgExpired s
   _activeQueues <- getPeriodStatsData $ activeQueues s
   _msgSentNtf <- readTVar $ msgSentNtf s
@@ -193,6 +228,7 @@ getServerStatsData s = do
         _qDeletedNew,
         _qDeletedSecured,
         _qSub,
+        _qSubNoMsg,
         _qSubAuth,
         _qSubDuplicate,
         _qSubProhibited,
@@ -201,6 +237,12 @@ getServerStatsData s = do
         _msgSentQuota,
         _msgSentLarge,
         _msgRecv,
+        _msgRecvGet,
+        _msgGet,
+        _msgGetNoMsg,
+        _msgGetAuth,
+        _msgGetDuplicate,
+        _msgGetProhibited,
         _msgExpired,
         _activeQueues,
         _msgSentNtf,
@@ -227,6 +269,7 @@ setServerStats s d = do
   writeTVar (qDeletedNew s) $! _qDeletedNew d
   writeTVar (qDeletedSecured s) $! _qDeletedSecured d
   writeTVar (qSub s) $! _qSub d
+  writeTVar (qSubNoMsg s) $! _qSubNoMsg d
   writeTVar (qSubAuth s) $! _qSubAuth d
   writeTVar (qSubDuplicate s) $! _qSubDuplicate d
   writeTVar (qSubProhibited s) $! _qSubProhibited d
@@ -235,6 +278,12 @@ setServerStats s d = do
   writeTVar (msgSentQuota s) $! _msgSentQuota d
   writeTVar (msgSentLarge s) $! _msgSentLarge d
   writeTVar (msgRecv s) $! _msgRecv d
+  writeTVar (msgRecvGet s) $! _msgRecvGet d
+  writeTVar (msgGet s) $! _msgGet d
+  writeTVar (msgGetNoMsg s) $! _msgGetNoMsg d
+  writeTVar (msgGetAuth s) $! _msgGetAuth d
+  writeTVar (msgGetDuplicate s) $! _msgGetDuplicate d
+  writeTVar (msgGetProhibited s) $! _msgGetProhibited d
   writeTVar (msgExpired s) $! _msgExpired d
   setPeriodStats (activeQueues s) (_activeQueues d)
   writeTVar (msgSentNtf s) $! _msgSentNtf d
@@ -262,6 +311,7 @@ instance StrEncoding ServerStatsData where
         "qDeletedSecured=" <> strEncode (_qDeletedSecured d),
         "qCount=" <> strEncode (_qCount d),
         "qSub=" <> strEncode (_qSub d),
+        "qSubNoMsg=" <> strEncode (_qSubNoMsg d),
         "qSubAuth=" <> strEncode (_qSubAuth d),
         "qSubDuplicate=" <> strEncode (_qSubDuplicate d),
         "qSubProhibited=" <> strEncode (_qSubProhibited d),
@@ -270,6 +320,12 @@ instance StrEncoding ServerStatsData where
         "msgSentQuota=" <> strEncode (_msgSentQuota d),
         "msgSentLarge=" <> strEncode (_msgSentLarge d),
         "msgRecv=" <> strEncode (_msgRecv d),
+        "msgRecvGet=" <> strEncode (_msgRecvGet d),
+        "msgGet=" <> strEncode (_msgGet d),
+        "msgGetNoMsg=" <> strEncode (_msgGetNoMsg d),
+        "msgGetAuth=" <> strEncode (_msgGetAuth d),
+        "msgGetDuplicate=" <> strEncode (_msgGetDuplicate d),
+        "msgGetProhibited=" <> strEncode (_msgGetProhibited d),
         "msgExpired=" <> strEncode (_msgExpired d),
         "msgSentNtf=" <> strEncode (_msgSentNtf d),
         "msgRecvNtf=" <> strEncode (_msgRecvNtf d),
@@ -299,6 +355,7 @@ instance StrEncoding ServerStatsData where
         <|> ((,,) <$> ("qDeletedAll=" *> strP <* A.endOfLine) <*> ("qDeletedNew=" *> strP <* A.endOfLine) <*> ("qDeletedSecured=" *> strP <* A.endOfLine))
     _qCount <- opt "qCount="
     _qSub <- opt "qSub="
+    _qSubNoMsg <- opt "qSubNoMsg="
     _qSubAuth <- opt "qSubAuth="
     _qSubDuplicate <- opt "qSubDuplicate="
     _qSubProhibited <- opt "qSubProhibited="
@@ -307,6 +364,12 @@ instance StrEncoding ServerStatsData where
     _msgSentQuota <- opt "msgSentQuota="
     _msgSentLarge <- opt "msgSentLarge="
     _msgRecv <- "msgRecv=" *> strP <* A.endOfLine
+    _msgRecvGet <- opt "msgRecvGet="
+    _msgGet <- opt "msgGet="
+    _msgGetNoMsg <- opt "msgGetNoMsg="
+    _msgGetAuth <- opt "msgGetAuth="
+    _msgGetDuplicate <- opt "msgGetDuplicate="
+    _msgGetProhibited <- opt "msgGetProhibited="
     _msgExpired <- opt "msgExpired="
     _msgSentNtf <- opt "msgSentNtf="
     _msgRecvNtf <- opt "msgRecvNtf="
@@ -339,6 +402,7 @@ instance StrEncoding ServerStatsData where
           _qDeletedNew,
           _qDeletedSecured,
           _qSub,
+          _qSubNoMsg,
           _qSubAuth,
           _qSubDuplicate,
           _qSubProhibited,
@@ -347,6 +411,12 @@ instance StrEncoding ServerStatsData where
           _msgSentQuota,
           _msgSentLarge,
           _msgRecv,
+          _msgRecvGet,
+          _msgGet,
+          _msgGetNoMsg,
+          _msgGetAuth,
+          _msgGetDuplicate,
+          _msgGetProhibited,
           _msgExpired,
           _msgSentNtf,
           _msgRecvNtf,
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 10516b9f2..9534b7902 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -610,7 +610,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 2
     logSize testStoreMsgsFile `shouldReturn` 5
-    logSize testServerStatsBackupFile `shouldReturn` 55
+    logSize testServerStatsBackupFile `shouldReturn` 62
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
 
@@ -628,7 +628,7 @@ testRestoreMessages at@(ATransport t) =
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
     logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 55
+    logSize testServerStatsBackupFile `shouldReturn` 62
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
@@ -647,7 +647,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     logSize testStoreMsgsFile `shouldReturn` 0
-    logSize testServerStatsBackupFile `shouldReturn` 55
+    logSize testServerStatsBackupFile `shouldReturn` 62
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
 

From 0de596dbcfdb333a703579bb6f05111df335d1b3 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Thu, 18 Jul 2024 11:05:53 +0100
Subject: [PATCH 043/195] 6.0.0.3

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index 2604ad56e..d787d8f8a 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.0.2
+version: 6.0.0.3
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 6c8c924d5..489b77eb5 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.0.2
+version:        6.0.0.3
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 7565ddd91c74010da2f443a76259276e8a429caf Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Thu, 18 Jul 2024 19:54:14 +0400
Subject: [PATCH 044/195] agent: initialize ratchet on processing confirmation
 to support decryption of messages received before allowConnection; return
 SndQueueSecured from joinConnection, acceptContact (#1233)

---
 src/Simplex/Messaging/Agent.hs             |  72 +++---
 src/Simplex/Messaging/Agent/Protocol.hs    |  12 +-
 tests/AgentTests/ConnectionRequestTests.hs |  30 +--
 tests/AgentTests/FunctionalAPITests.hs     | 275 ++++++++++++---------
 tests/AgentTests/NotificationTests.hs      |  10 +-
 tests/SMPProxyTests.hs                     |   9 +-
 6 files changed, 241 insertions(+), 167 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 94ed7f44f..a0079c883 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -339,7 +339,7 @@ prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri
 prepareConnectionToJoin c userId enableNtfs = withAgentEnv c .: newConnToJoin c userId "" enableNtfs
 
 -- | Join SMP agent connection (JOIN command).
-joinConnection :: AgentClient -> UserId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
+joinConnection :: AgentClient -> UserId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
 joinConnection c userId Nothing enableNtfs = withAgentEnv c .:: joinConn c userId "" False enableNtfs
 joinConnection c userId (Just connId) enableNtfs = withAgentEnv c .:: joinConn c userId connId True enableNtfs
 {-# INLINE joinConnection #-}
@@ -350,7 +350,7 @@ allowConnection c = withAgentEnv c .:. allowConnection' c
 {-# INLINE allowConnection #-}
 
 -- | Accept contact after REQ notification (ACPT command)
-acceptContact :: AgentClient -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
+acceptContact :: AgentClient -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
 acceptContact c enableNtfs = withAgentEnv c .:: acceptContact' c "" enableNtfs
 {-# INLINE acceptContact #-}
 
@@ -783,7 +783,7 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of
           cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
       withStore c $ \db -> createNewConn db g cData SCMInvitation
 
-joinConn :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
+joinConn :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (ConnId, SndQueueSecured)
 joinConn c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode = do
   srv <- case cReq of
     CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ ->
@@ -842,7 +842,7 @@ versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport
 versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_
 {-# INLINE versionPQSupport_ #-}
 
-joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ConnId
+joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, SndQueueSecured)
 joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv =
   withInvLock c (strEncode inv) "joinConnSrv" $ do
     (cData, q, _, rc, e2eSndParams) <- startJoinInvitation userId connId Nothing enableNtfs inv pqSup
@@ -859,7 +859,7 @@ joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo p
     -- otherwise we would need to manage retries here to avoid SndQueue recreated with a different key,
     -- similar to how joinConnAsync does that.
     tryError (secureConfirmQueue c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case
-      Right _ -> pure connId'
+      Right sqSecured -> pure (connId', sqSecured)
       Left e -> do
         -- possible improvement: recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md
         void $ withStore' c $ \db -> deleteConn db Nothing connId'
@@ -869,10 +869,10 @@ joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo
     Just (qInfo, vrsn) -> do
       (connId', cReq) <- newConnSrv c userId connId hasNewConn enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv
       void $ sendInvitation c userId qInfo vrsn cReq cInfo
-      pure connId'
+      pure (connId', False)
     Nothing -> throwE $ AGENT A_VERSION
 
-joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ()
+joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured
 joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = do
   SomeConn cType conn <- withStore c (`getConn` connId)
   case conn of
@@ -880,7 +880,7 @@ joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSuppo
     SndConnection _ sq -> doJoin $ Just sq
     _ -> throwE $ CMD PROHIBITED $ "joinConnSrvAsync: bad connection " <> show cType
   where
-    doJoin :: Maybe SndQueue -> AM ()
+    doJoin :: Maybe SndQueue -> AM SndQueueSecured
     doJoin sq_ = do
       (cData, sq, _, rc, e2eSndParams) <- startJoinInvitation userId connId sq_ enableNtfs inv pqSupport
       sq' <- withStore c $ \db -> runExceptT $ do
@@ -907,18 +907,14 @@ createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVers
 allowConnection' :: AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
 allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConnection" $ do
   withStore c (`getConn` connId) >>= \case
-    SomeConn _ (RcvConnection _ rq@RcvQueue {server, rcvId, e2ePrivKey, smpClientVersion = v}) -> do
-      senderKey <- withStore c $ \db -> runExceptT $ do
-        AcceptedConfirmation {ratchetState, senderConf = SMPConfirmation {senderKey, e2ePubKey, smpClientVersion = v'}} <- ExceptT $ acceptConfirmation db confId ownConnInfo
-        liftIO $ createRatchet db connId ratchetState
-        let dhSecret = C.dh' e2ePubKey e2ePrivKey
-        liftIO $ setRcvQueueConfirmedE2E db rq dhSecret $ min v v'
-        pure senderKey
+    SomeConn _ (RcvConnection _ RcvQueue {server, rcvId}) -> do
+      AcceptedConfirmation {senderConf = SMPConfirmation {senderKey}} <-
+        withStore c $ \db -> acceptConfirmation db confId ownConnInfo
       enqueueCommand c "" connId (Just server) . AInternalCommand $ ICAllowSecure rcvId senderKey
     _ -> throwE $ CMD PROHIBITED "allowConnection"
 
 -- | Accept contact (ACPT command) in Reader monad
-acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
+acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (ConnId, SndQueueSecured)
 acceptContact' c connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do
   Invitation {contactConnId, connReq} <- withStore c (`getInvitation` invId)
   withStore c (`getConn` contactConnId) >>= \case
@@ -1155,8 +1151,8 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
           let initUsed = [qServer q]
           usedSrvs <- newTVarIO initUsed
           tryCommand . withNextSrv c userId usedSrvs initUsed $ \srv -> do
-            joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv
-            notify OK
+            sqSecured <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv
+            notify $ JOINED sqSecured
         LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK
         ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK
         SWCH ->
@@ -2492,6 +2488,18 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                           confId <- withStore c $ \db -> do
                             setConnAgentVersion db connId agentVersion
                             when (pqSupport /= pqSupport') $ setConnPQSupport db connId pqSupport'
+                            -- /
+                            -- Starting with agent version 7 (ratchetOnConfSMPAgentVersion),
+                            -- initiating party initializes ratchet on processing confirmation;
+                            -- previously, it initialized ratchet on allowConnection;
+                            -- this is to support decryption of messages that may be received before allowConnection
+                            liftIO $ do
+                              createRatchet db connId rc'
+                              let RcvQueue {smpClientVersion = v, e2ePrivKey = e2ePrivKey'} = rq
+                                  SMPConfirmation {smpClientVersion = v', e2ePubKey = e2ePubKey'} = senderConf
+                                  dhSecret = C.dh' e2ePubKey' e2ePrivKey'
+                              setRcvQueueConfirmedE2E db rq dhSecret $ min v v'
+                            -- /
                             createConfirmation db g newConfirmation
                           let srvs = map qServer $ smpReplyQueues senderConf
                           notify $ CONF confId pqSupport' srvs connInfo
@@ -2775,25 +2783,27 @@ connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _
     Just qInfo' -> do
       -- in case of SKEY retry the connection is already duplex
       sq' <- maybe upgradeConn pure sq_
-      agentSecureSndQueue c sq'
+      void $ agentSecureSndQueue c cData sq'
       enqueueConfirmation c cData sq' ownConnInfo Nothing
       where
         upgradeConn = do
           (sq, _) <- lift $ newSndQueue userId connId qInfo'
           withStore c $ \db -> upgradeRcvConnToDuplex db connId sq
 
-secureConfirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
+secureConfirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM SndQueueSecured
 secureConfirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do
-  agentSecureSndQueue c sq
+  sqSecured <- agentSecureSndQueue c cData sq
   storeConfirmation c cData sq e2eEncryption_ =<< mkAgentConfirmation c cData sq srv connInfo subMode
   lift $ submitPendingMsg c cData sq
+  pure sqSecured
 
-secureConfirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
+secureConfirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM SndQueueSecured
 secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connInfo e2eEncryption_ subMode = do
-  agentSecureSndQueue c sq
+  sqSecured <- agentSecureSndQueue c cData sq
   msg <- mkConfirmation =<< mkAgentConfirmation c cData sq srv connInfo subMode
   void $ sendConfirmation c sq msg
   withStore' c $ \db -> setSndQueueStatus db sq Confirmed
+  pure sqSecured
   where
     mkConfirmation :: AgentMessage -> AM MsgBody
     mkConfirmation aMessage = do
@@ -2806,11 +2816,17 @@ secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv
         (encConnInfo, _) <- agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just pqEnc) currentE2EVersion
         pure . smpEncode $ AgentConfirmation {agentVersion = connAgentVersion, e2eEncryption_, encConnInfo}
 
-agentSecureSndQueue :: AgentClient -> SndQueue -> AM ()
-agentSecureSndQueue c sq@SndQueue {sndSecure, status} =
-  when (sndSecure && status == New) $ do
-    secureSndQueue c sq
-    withStore' c $ \db -> setSndQueueStatus db sq Secured
+agentSecureSndQueue :: AgentClient -> ConnData -> SndQueue -> AM SndQueueSecured
+agentSecureSndQueue c ConnData {connAgentVersion} sq@SndQueue {sndSecure, status}
+  | sndSecure && status == New = do
+      secureSndQueue c sq
+      withStore' c $ \db -> setSndQueueStatus db sq Secured
+      pure initiatorRatchetOnConf
+  -- on repeat JOIN processing (e.g. previous attempt to create reply queue failed)
+  | sndSecure && status == Secured = pure initiatorRatchetOnConf
+  | otherwise = pure False
+  where
+    initiatorRatchetOnConf = connAgentVersion >= ratchetOnConfSMPAgentVersion
 
 mkAgentConfirmation :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> SubscriptionMode -> AM AgentMessage
 mkAgentConfirmation c cData sq srv connInfo subMode = do
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index b123fc1ec..ca9737008 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -42,6 +42,7 @@ module Simplex.Messaging.Agent.Protocol
     deliveryRcptsSMPAgentVersion,
     pqdrSMPAgentVersion,
     sndAuthKeySMPAgentVersion,
+    ratchetOnConfSMPAgentVersion,
     currentSMPAgentVersion,
     supportedSMPAgentVRange,
     e2eEncConnInfoLength,
@@ -49,6 +50,7 @@ module Simplex.Messaging.Agent.Protocol
 
     -- * SMP agent protocol types
     ConnInfo,
+    SndQueueSecured,
     ACommand (..),
     AEvent (..),
     AEvt (..),
@@ -257,11 +259,14 @@ pqdrSMPAgentVersion = VersionSMPA 5
 sndAuthKeySMPAgentVersion :: VersionSMPA
 sndAuthKeySMPAgentVersion = VersionSMPA 6
 
+ratchetOnConfSMPAgentVersion :: VersionSMPA
+ratchetOnConfSMPAgentVersion = VersionSMPA 7
+
 minSupportedSMPAgentVersion :: VersionSMPA
 minSupportedSMPAgentVersion = duplexHandshakeSMPAgentVersion
 
 currentSMPAgentVersion :: VersionSMPA
-currentSMPAgentVersion = VersionSMPA 6
+currentSMPAgentVersion = VersionSMPA 7
 
 supportedSMPAgentVRange :: VersionRangeSMPA
 supportedSMPAgentVRange = mkVersionRange minSupportedSMPAgentVersion currentSMPAgentVersion
@@ -327,6 +332,8 @@ deriving instance Show AEvt
 
 type ConnInfo = ByteString
 
+type SndQueueSecured = Bool
+
 -- | Parameterized type for SMP agent events
 data AEvent (e :: AEntity) where
   INV :: AConnectionRequestUri -> AEvent AEConn
@@ -354,6 +361,7 @@ data AEvent (e :: AEntity) where
   DEL_USER :: Int64 -> AEvent AENone
   STAT :: ConnectionStats -> AEvent AEConn
   OK :: AEvent AEConn
+  JOINED :: SndQueueSecured -> AEvent AEConn
   ERR :: AgentErrorType -> AEvent AEConn
   SUSPENDED :: AEvent AENone
   RFPROG :: Int64 -> Int64 -> AEvent AERcvFile
@@ -422,6 +430,7 @@ data AEventTag (e :: AEntity) where
   DEL_USER_ :: AEventTag AENone
   STAT_ :: AEventTag AEConn
   OK_ :: AEventTag AEConn
+  JOINED_ :: AEventTag AEConn
   ERR_ :: AEventTag AEConn
   SUSPENDED_ :: AEventTag AENone
   -- XFTP commands and responses
@@ -474,6 +483,7 @@ aEventTag = \case
   DEL_USER _ -> DEL_USER_
   STAT _ -> STAT_
   OK -> OK_
+  JOINED _ -> JOINED_
   ERR _ -> ERR_
   SUSPENDED -> SUSPENDED_
   RFPROG {} -> RFPROG_
diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs
index 8684c787c..5d0a2c00a 100644
--- a/tests/AgentTests/ConnectionRequestTests.hs
+++ b/tests/AgentTests/ConnectionRequestTests.hs
@@ -225,23 +225,23 @@ connectionRequestTests =
       queueV1NoPort #== ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
       queueV1NoPort #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#" <> testDhKeyStr)
     it "should serialize and parse connection invitations and contact addresses" $ do
-      connectionRequest #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequest #== ("https://simplex.chat/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequestSK #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStrSK <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequest1 #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queue1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequest2queues #==# ("simplex:/invitation#/?v=2-6&smp=" <> url (queueStr <> ";" <> queueStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequestNew #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueNewStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-6&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest #== ("https://simplex.chat/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestSK #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStrSK <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest1 #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queue1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest2queues #==# ("simplex:/invitation#/?v=2-7&smp=" <> url (queueStr <> ";" <> queueStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestNew #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueNewStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-7&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
       connectionRequestV1 #== ("https://simplex.chat/invitation#/?v=1&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}")
-      contactAddress #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueStr)
-      contactAddress #== ("https://simplex.chat/contact#/?v=2-6&smp=" <> url queueStr)
-      contactAddress2queues #==# ("simplex:/contact#/?v=2-6&smp=" <> url (queueStr <> ";" <> queueStr))
-      contactAddressNew #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueNewStr)
-      contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-6&smp=" <> url (queueNewStr <> ";" <> queueNewStr))
+      connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}")
+      contactAddress #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr)
+      contactAddress #== ("https://simplex.chat/contact#/?v=2-7&smp=" <> url queueStr)
+      contactAddress2queues #==# ("simplex:/contact#/?v=2-7&smp=" <> url (queueStr <> ";" <> queueStr))
+      contactAddressNew #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueNewStr)
+      contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-7&smp=" <> url (queueNewStr <> ";" <> queueNewStr))
       contactAddressV2 #==# ("simplex:/contact#/?v=2&smp=" <> url queueStr)
       contactAddressV2 #== ("https://simplex.chat/contact#/?v=1&smp=" <> url queueStr) -- adjusted to v2
       contactAddressV2 #== ("https://simplex.chat/contact#/?v=1-2&smp=" <> url queueStr) -- adjusted to v2
       contactAddressV2 #== ("https://simplex.chat/contact#/?v=2-2&smp=" <> url queueStr)
-      contactAddressClientData #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}")
+      contactAddressClientData #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}")
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 3f70ad6ab..75593be73 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -244,7 +244,7 @@ inAnyOrder g rs = withFrozenCallStack $ do
 createConnection :: AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> SubscriptionMode -> AE (ConnId, ConnectionRequestUri c)
 createConnection c userId enableNtfs cMode clientData = A.createConnection c userId enableNtfs cMode clientData (IKNoPQ PQSupportOn)
 
-joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE ConnId
+joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
 joinConnection c userId enableNtfs cReq connInfo = A.joinConnection c userId Nothing enableNtfs cReq connInfo PQSupportOn
 
 sendMessage :: AgentClient -> ConnId -> SMP.MsgFlags -> MsgBody -> AE AgentMsgId
@@ -269,13 +269,13 @@ functionalAPITests t = do
     describe "two way concurrently (50)" $ testMatrix2Stress t $ runAgentClientStressTestConc 25
     xdescribe "two way concurrently (1000)" $ testMatrix2Stress t $ runAgentClientStressTestConc 500
   describe "Establishing duplex connection, different PQ settings" $ do
-    testPQMatrix2 t $ runAgentClientTestPQ True
+    testPQMatrix2 t $ runAgentClientTestPQ False True
   describe "Establishing duplex connection v2, different Ratchet versions" $
     testRatchetMatrix2 t runAgentClientTest
   describe "Establish duplex connection via contact address" $
     testMatrix2 t runAgentClientContactTest
   describe "Establish duplex connection via contact address, different PQ settings" $ do
-    testPQMatrix2NoInv t $ runAgentClientContactTestPQ True PQSupportOn
+    testPQMatrix2NoInv t $ runAgentClientContactTestPQ False True PQSupportOn
   describe "Establish duplex connection via contact address v2, different Ratchet versions" $
     testRatchetMatrix2 t runAgentClientContactTest
   describe "Establish duplex connection via contact address, different PQ settings" $ do
@@ -410,29 +410,30 @@ functionalAPITests t = do
     let v4 = prevVersion basicAuthSMPVersion
     forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, currentServerSMPRelayVersion]) $ \v -> do
       let baseId = if v >= sndAuthKeySMPVersion then 1 else 3
+          sqSecured = if v >= sndAuthKeySMPVersion then True else False
       describe ("v" <> show v <> ": with server auth") $ do
         --                                       allow NEW | server auth, v | clnt1 auth, v  | clnt2 auth, v    |  2 - success, 1 - JOIN fail, 0 - NEW fail
-        it "success                " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 2
-        it "disabled               " $ testBasicAuth t False (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 0
-        it "NEW fail, no auth      " $ testBasicAuth t True (Just "abcd", v) (Nothing, v) (Just "abcd", v) baseId `shouldReturn` 0
-        it "NEW fail, bad auth     " $ testBasicAuth t True (Just "abcd", v) (Just "wrong", v) (Just "abcd", v) baseId `shouldReturn` 0
-        it "NEW fail, version      " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v4) (Just "abcd", v) baseId `shouldReturn` 0
-        it "JOIN fail, no auth     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Nothing, v) baseId `shouldReturn` 1
-        it "JOIN fail, bad auth    " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "wrong", v) baseId `shouldReturn` 1
-        it "JOIN fail, version     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v4) baseId `shouldReturn` 1
+        it "success                " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2
+        it "disabled               " $ testBasicAuth t False (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
+        it "NEW fail, no auth      " $ testBasicAuth t True (Just "abcd", v) (Nothing, v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
+        it "NEW fail, bad auth     " $ testBasicAuth t True (Just "abcd", v) (Just "wrong", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
+        it "NEW fail, version      " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v4) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
+        it "JOIN fail, no auth     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Nothing, v) sqSecured baseId `shouldReturn` 1
+        it "JOIN fail, bad auth    " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "wrong", v) sqSecured baseId `shouldReturn` 1
+        it "JOIN fail, version     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v4) sqSecured baseId `shouldReturn` 1
       describe ("v" <> show v <> ": no server auth") $ do
-        it "success     " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v) baseId `shouldReturn` 2
-        it "srv disabled" $ testBasicAuth t False (Nothing, v) (Nothing, v) (Nothing, v) baseId `shouldReturn` 0
-        it "version srv " $ testBasicAuth t True (Nothing, v4) (Nothing, v) (Nothing, v) 3 `shouldReturn` 2
-        it "version fst " $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v) baseId `shouldReturn` 2
-        it "version snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v4) 3 `shouldReturn` 2
-        it "version both" $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v4) 3 `shouldReturn` 2
-        it "version all " $ testBasicAuth t True (Nothing, v4) (Nothing, v4) (Nothing, v4) 3 `shouldReturn` 2
-        it "auth fst    " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Nothing, v) baseId `shouldReturn` 2
-        it "auth fst 2  " $ testBasicAuth t True (Nothing, v4) (Just "abcd", v) (Nothing, v) 3 `shouldReturn` 2
-        it "auth snd    " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Just "abcd", v) baseId `shouldReturn` 2
-        it "auth both   " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 2
-        it "auth, disabled" $ testBasicAuth t False (Nothing, v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 0
+        it "success     " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v) sqSecured baseId `shouldReturn` 2
+        it "srv disabled" $ testBasicAuth t False (Nothing, v) (Nothing, v) (Nothing, v) sqSecured baseId `shouldReturn` 0
+        it "version srv " $ testBasicAuth t True (Nothing, v4) (Nothing, v) (Nothing, v) False 3 `shouldReturn` 2
+        it "version fst " $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v) False baseId `shouldReturn` 2
+        it "version snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v4) sqSecured 3 `shouldReturn` 2
+        it "version both" $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v4) False 3 `shouldReturn` 2
+        it "version all " $ testBasicAuth t True (Nothing, v4) (Nothing, v4) (Nothing, v4) False 3 `shouldReturn` 2
+        it "auth fst    " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Nothing, v) sqSecured baseId `shouldReturn` 2
+        it "auth fst 2  " $ testBasicAuth t True (Nothing, v4) (Just "abcd", v) (Nothing, v) False 3 `shouldReturn` 2
+        it "auth snd    " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2
+        it "auth both   " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2
+        it "auth, disabled" $ testBasicAuth t False (Nothing, v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0
   describe "SMP server test via agent API" $ do
     it "should pass without basic auth" $ testSMPServerConnectionTest t Nothing (noAuthSrv testSMPServer2) `shouldReturn` Nothing
     let srv1 = testSMPServer2 {keyHash = "1234"}
@@ -460,8 +461,8 @@ functionalAPITests t = do
     it "server should respond with queue and subscription information" $
       withSmpServer t testServerQueueInfo
 
-testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> AgentMsgId -> IO Int
-testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 baseId = do
+testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int
+testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 sqSecured baseId = do
   let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = V.mkVersionRange batchCmdsSMPVersion srvVersion}
       canCreate1 = canCreateQueue allowNewQueues srv clnt1
       canCreate2 = canCreateQueue allowNewQueues srv clnt2
@@ -469,7 +470,7 @@ testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 baseId = do
         | canCreate1 && canCreate2 = 2
         | canCreate1 = 1
         | otherwise = 0
-  created <- withSmpServerConfigOn t testCfg testPort $ \_ -> testCreateQueueAuth srvVersion clnt1 clnt2 baseId
+  created <- withSmpServerConfigOn t testCfg testPort $ \_ -> testCreateQueueAuth srvVersion clnt1 clnt2 sqSecured baseId
   created `shouldBe` expected
   pure created
 
@@ -478,43 +479,43 @@ canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =
   let v = basicAuthSMPVersion
    in allowNew && (isNothing srvAuth || (srvVersion >= v && clntVersion >= v && srvAuth == clntAuth))
 
-testMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testMatrix2 :: HasCallStack => ATransport -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2 t runTest = do
-  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
-  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
-  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
-  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 $ runTest PQSupportOff False
-  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff False
-  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff False
+  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True True
+  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn False True
+  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn True False
+  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 $ runTest PQSupportOff False False
+  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff False False
+  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff False False
 
-testMatrix2Stress :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testMatrix2Stress :: HasCallStack => ATransport -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2Stress t runTest = do
-  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aCfg aCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
-  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aProxyCfgV8 aProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
-  it "current" $ withSmpServer t $ runTestCfg2 aCfg aCfg 1 $ runTest PQSupportOn False
-  it "prev" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfgVPrev 3 $ runTest PQSupportOff False
-  it "prev to current" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfg 3 $ runTest PQSupportOff False
-  it "current to prev" $ withSmpServer t $ runTestCfg2 aCfg aCfgVPrev 3 $ runTest PQSupportOff False
+  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aCfg aCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True True
+  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aProxyCfgV8 aProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn False True
+  it "current" $ withSmpServer t $ runTestCfg2 aCfg aCfg 1 $ runTest PQSupportOn True False
+  it "prev" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfgVPrev 3 $ runTest PQSupportOff False False
+  it "prev to current" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfg 3 $ runTest PQSupportOff False False
+  it "current to prev" $ withSmpServer t $ runTestCfg2 aCfg aCfgVPrev 3 $ runTest PQSupportOff False False
   where
     aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
     aProxyCfgV8 = agentProxyCfgV8 {messageRetryInterval = fastMessageRetryInterval}
     aCfgVPrev = agentCfgVPrev {messageRetryInterval = fastMessageRetryInterval}
 
-testBasicMatrix2 :: HasCallStack => ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testBasicMatrix2 :: HasCallStack => ATransport -> (SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testBasicMatrix2 t runTest = do
-  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest
-  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 3 $ runTest
-  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfg 3 $ runTest
-  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrevPQ 3 $ runTest
+  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest True
+  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 3 $ runTest False
+  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfg 3 $ runTest False
+  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrevPQ 3 $ runTest False
 
-testRatchetMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testRatchetMatrix2 :: HasCallStack => ATransport -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testRatchetMatrix2 t runTest = do
-  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
-  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
-  it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
-  it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
-  it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff False
-  it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
+  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True True
+  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn False True
+  it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn True False
+  it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 1 $ runTest PQSupportOff True False
+  it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff True False
+  it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff True False
 
 testServerMatrix2 :: HasCallStack => ATransport -> (InitialAgentServers -> IO ()) -> Spec
 testServerMatrix2 t runTest = do
@@ -589,15 +590,16 @@ withAgentClients3 runTest =
     withAgent 3 agentCfg initAgentServers testDB3 $ \c ->
       runTest a b c
 
-runAgentClientTest :: HasCallStack => PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
-runAgentClientTest pqSupport viaProxy alice bob baseId =
-  runAgentClientTestPQ viaProxy (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId
+runAgentClientTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientTest pqSupport sqSecured viaProxy alice bob baseId =
+  runAgentClientTestPQ sqSecured viaProxy (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId
 
-runAgentClientTestPQ :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
-runAgentClientTestPQ viaProxy (alice, aPQ) (bob, bPQ) baseId =
+runAgentClientTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
+runAgentClientTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId =
   runRight_ $ do
     (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing aPQ SMSubscribe
-    aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" bPQ SMSubscribe
+    (aliceId, sqSecured') <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" bPQ SMSubscribe
+    liftIO $ sqSecured' `shouldBe` sqSecured
     ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
     liftIO $ pqSup' `shouldBe` CR.connPQEncryption aPQ
     allowConnection alice bobId confId "alice's connInfo"
@@ -634,10 +636,10 @@ runAgentClientTestPQ viaProxy (alice, aPQ) (bob, bPQ) baseId =
 pqConnectionMode :: InitialKeys -> PQSupport -> Bool
 pqConnectionMode pqMode1 pqMode2 = supportPQ (CR.connPQEncryption pqMode1) && supportPQ pqMode2
 
-runAgentClientStressTestOneWay :: HasCallStack => Int64 -> PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
-runAgentClientStressTestOneWay n pqSupport viaProxy alice bob baseId = runRight_ $ do
+runAgentClientStressTestOneWay :: HasCallStack => Int64 -> PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientStressTestOneWay n pqSupport sqSecured viaProxy alice bob baseId = runRight_ $ do
   let pqEnc = PQEncryption $ supportPQ pqSupport
-  (aliceId, bobId) <- makeConnection_ pqSupport alice bob
+  (aliceId, bobId) <- makeConnection_ pqSupport sqSecured alice bob
   let proxySrv = if viaProxy then Just testSMPServer else Nothing
       message i = "message " <> bshow i
   concurrently_
@@ -666,10 +668,10 @@ runAgentClientStressTestOneWay n pqSupport viaProxy alice bob baseId = runRight_
   where
     msgId = subtract baseId . fst
 
-runAgentClientStressTestConc :: HasCallStack => Int64 -> PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
-runAgentClientStressTestConc n pqSupport viaProxy alice bob baseId = runRight_ $ do
+runAgentClientStressTestConc :: HasCallStack => Int64 -> PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientStressTestConc n pqSupport sqSecured viaProxy alice bob baseId = runRight_ $ do
   let pqEnc = PQEncryption $ supportPQ pqSupport
-  (aliceId, bobId) <- makeConnection_ pqSupport alice bob
+  (aliceId, bobId) <- makeConnection_ pqSupport sqSecured alice bob
   let proxySrv = if viaProxy then Just testSMPServer else Nothing
       message i = "message " <> bshow i
       loop a bId mIdVar i = do
@@ -703,7 +705,7 @@ testEnablePQEncryption :: HasCallStack => IO ()
 testEnablePQEncryption =
   withAgentClients2 $ \ca cb -> runRight_ $ do
     g <- liftIO C.newRandom
-    (aId, bId) <- makeConnection_ PQSupportOff ca cb
+    (aId, bId) <- makeConnection_ PQSupportOff True ca cb
     let a = (ca, aId)
         b = (cb, bId)
     (a, 2, "msg 1") \#>\ b
@@ -789,20 +791,23 @@ testAgentClient3 =
     get c =##> \case ("", connId, Msg "c5") -> connId == aIdForC; _ -> False
     ackMessage c aIdForC 3 Nothing
 
-runAgentClientContactTest :: HasCallStack => PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
-runAgentClientContactTest pqSupport viaProxy alice bob baseId =
-  runAgentClientContactTestPQ viaProxy pqSupport (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId
+runAgentClientContactTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientContactTest pqSupport sqSecured viaProxy alice bob baseId =
+  runAgentClientContactTestPQ sqSecured viaProxy pqSupport (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId
 
-runAgentClientContactTestPQ :: HasCallStack => Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
-runAgentClientContactTestPQ viaProxy reqPQSupport (alice, aPQ) (bob, bPQ) baseId =
+runAgentClientContactTestPQ :: HasCallStack => SndQueueSecured -> Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
+runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, bPQ) baseId =
   runRight_ $ do
     (_, qInfo) <- A.createConnection alice 1 True SCMContact Nothing aPQ SMSubscribe
     aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
-    aliceId' <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" bPQ SMSubscribe
-    liftIO $ aliceId' `shouldBe` aliceId
+    (aliceId', sqSecuredJoin) <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" bPQ SMSubscribe
+    liftIO $ do
+      aliceId' `shouldBe` aliceId
+      sqSecuredJoin `shouldBe` False -- joining via contact address connection
     ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
     liftIO $ pqSup' `shouldBe` reqPQSupport
-    bobId <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
+    (bobId, sqSecured') <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
+    liftIO $ sqSecured' `shouldBe` sqSecured
     ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get bob
     liftIO $ pqSup'' `shouldBe` bPQ
     allowConnection bob aliceId confId "bob's connInfo"
@@ -847,11 +852,14 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId
     msgId = subtract baseId . fst
     connectViaContact b pq qInfo = do
       aId <- A.prepareConnectionToJoin b 1 True qInfo pq
-      aId' <- A.joinConnection b 1 (Just aId) True qInfo "bob's connInfo" pq SMSubscribe
-      liftIO $ aId' `shouldBe` aId
+      (aId', sqSecuredJoin) <- A.joinConnection b 1 (Just aId) True qInfo "bob's connInfo" pq SMSubscribe
+      liftIO $ do
+        aId' `shouldBe` aId
+        sqSecuredJoin `shouldBe` False -- joining via contact address connection
       ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
       liftIO $ pqSup' `shouldBe` PQSupportOn
-      bId <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
+      (bId, sqSecuredAccept) <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
+      liftIO $ sqSecuredAccept `shouldBe` False -- agent cfg is v8
       ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get b
       liftIO $ pqSup'' `shouldBe` pq
       allowConnection b aId confId "bob's connInfo"
@@ -891,8 +899,10 @@ testRejectContactRequest =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     (addrConnId, qInfo) <- A.createConnection alice 1 True SCMContact Nothing IKPQOn SMSubscribe
     aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
-    aliceId' <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" PQSupportOn SMSubscribe
-    liftIO $ aliceId' `shouldBe` aliceId
+    (aliceId', sqSecured) <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+    liftIO $ do
+      aliceId' `shouldBe` aliceId
+      sqSecured `shouldBe` False -- joining via contact address connection
     ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get alice
     liftIO $ runExceptT (rejectContact alice "abcd" invId) `shouldReturn` Left (CONN NOT_FOUND)
     rejectContact alice addrConnId invId
@@ -904,15 +914,34 @@ testAsyncInitiatingOffline =
     alice <- liftIO $ getSMPAgentClient' 1 agentCfg initAgentServers testDB
     (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
     liftIO $ disposeAgentClient alice
-    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
+
+    (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
+    liftIO $ sqSecured `shouldBe` True
+
+    -- send messages
+    msgId1 <- A.sendMessage bob aliceId PQEncOn SMP.noMsgFlags "can send 1"
+    liftIO $ msgId1 `shouldBe` (2, PQEncOff)
+    get bob ##> ("", aliceId, SENT 2)
+    msgId2 <- A.sendMessage bob aliceId PQEncOn SMP.noMsgFlags "can send 2"
+    liftIO $ msgId2 `shouldBe` (3, PQEncOff)
+    get bob ##> ("", aliceId, SENT 3)
+
     alice' <- liftIO $ getSMPAgentClient' 3 agentCfg initAgentServers testDB
     subscribeConnection alice' bobId
     ("", _, CONF confId _ "bob's connInfo") <- get alice'
+    -- receive messages
+    get alice' =##> \case ("", c, Msg' mId pq "can send 1") -> c == bobId && mId == 1 && pq == PQEncOff; _ -> False
+    ackMessage alice' bobId 1 Nothing
+    get alice' =##> \case ("", c, Msg' mId pq "can send 2") -> c == bobId && mId == 2 && pq == PQEncOff; _ -> False
+    ackMessage alice' bobId 2 Nothing
+    -- for alice msg id 3 is sent confirmation, then they're matched with bob at msg id 4
+
+    -- allow connection
     allowConnection alice' bobId confId "alice's connInfo"
     get alice' ##> ("", bobId, CON)
     get bob ##> ("", aliceId, INFO "alice's connInfo")
     get bob ##> ("", aliceId, CON)
-    exchangeGreetings alice' bobId bob aliceId
+    exchangeGreetingsMsgId 4 alice' bobId bob aliceId
     liftIO $ disposeAgentClient alice'
 
 testAsyncJoiningOfflineBeforeActivation :: HasCallStack => IO ()
@@ -920,7 +949,8 @@ testAsyncJoiningOfflineBeforeActivation =
   withAgent 1 agentCfg initAgentServers testDB $ \alice -> runRight_ $ do
     bob <- liftIO $ getSMPAgentClient' 2 agentCfg initAgentServers testDB2
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    liftIO $ sqSecured `shouldBe` True
     liftIO $ disposeAgentClient bob
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     allowConnection alice bobId confId "alice's connInfo"
@@ -939,7 +969,8 @@ testAsyncBothOffline = do
   runRight_ $ do
     (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
     liftIO $ disposeAgentClient alice
-    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
+    (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
+    liftIO $ sqSecured `shouldBe` True
     liftIO $ disposeAgentClient bob
     alice' <- liftIO $ getSMPAgentClient' 3 agentCfg initAgentServers testDB
     subscribeConnection alice' bobId
@@ -970,7 +1001,8 @@ testAsyncServerOffline t = withAgentClients2 $ \alice bob -> do
     liftIO $ do
       srv1 `shouldBe` testSMPServer
       conns1 `shouldBe` [bobId]
-    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
+    (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
+    liftIO $ sqSecured `shouldBe` True
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     allowConnection alice bobId confId "alice's connInfo"
     get alice ##> ("", bobId, CON)
@@ -988,7 +1020,8 @@ testAllowConnectionClientRestart t = do
       withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \_ -> do
         runRight $ do
           (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-          aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+          (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+          liftIO $ sqSecured `shouldBe` True
           ("", _, CONF confId _ "bob's connInfo") <- get alice
           pure (aliceId, bobId, confId)
 
@@ -1024,7 +1057,7 @@ testIncreaseConnAgentVersion t = do
   bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2
   withSmpServerStoreMsgLogOn t testPort $ \_ -> do
     (aliceId, bobId) <- runRight $ do
-      (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
+      (aliceId, bobId) <- makeConnection_ PQSupportOff False alice bob
       exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
       checkVersion alice bobId 2
       checkVersion bob aliceId 2
@@ -1089,7 +1122,7 @@ testIncreaseConnAgentVersionMaxCompatible t = do
   bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2
   withSmpServerStoreMsgLogOn t testPort $ \_ -> do
     (aliceId, bobId) <- runRight $ do
-      (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
+      (aliceId, bobId) <- makeConnection_ PQSupportOff False alice bob
       exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
       checkVersion alice bobId 2
       checkVersion bob aliceId 2
@@ -1119,7 +1152,7 @@ testIncreaseConnAgentVersionStartDifferentVersion t = do
   bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
   withSmpServerStoreMsgLogOn t testPort $ \_ -> do
     (aliceId, bobId) <- runRight $ do
-      (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
+      (aliceId, bobId) <- makeConnection_ PQSupportOff False alice bob
       exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
       checkVersion alice bobId 2
       checkVersion bob aliceId 2
@@ -1620,7 +1653,8 @@ testRatchetSyncSimultaneous t = do
 testOnlyCreatePullSlowHandshake :: IO ()
 testOnlyCreatePullSlowHandshake = withAgentClientsCfg2 agentProxyCfgV8 agentProxyCfgV8 $ \alice bob -> runRight_ $ do
   (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate
-  aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
+  (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
+  liftIO $ sqSecured `shouldBe` False
   Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
   allowConnection alice bobId confId "alice's connInfo"
   liftIO $ threadDelay 1_000000
@@ -1654,7 +1688,8 @@ getMsg c cId action = do
 testOnlyCreatePull :: IO ()
 testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
   (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate
-  aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
+  (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
+  liftIO $ sqSecured `shouldBe` True
   Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
   allowConnection alice bobId confId "alice's connInfo"
   liftIO $ threadDelay 1_000000
@@ -1676,20 +1711,22 @@ testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
   ackMessage alice bobId 3 Nothing
 
 makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
-makeConnection = makeConnection_ PQSupportOn
+makeConnection = makeConnection_ PQSupportOn True
 
-makeConnection_ :: PQSupport -> AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
-makeConnection_ pqEnc alice bob = makeConnectionForUsers_ pqEnc alice 1 bob 1
+makeConnection_ :: PQSupport -> SndQueueSecured -> AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
+makeConnection_ pqEnc sqSecured alice bob = makeConnectionForUsers_ pqEnc sqSecured alice 1 bob 1
 
 makeConnectionForUsers :: HasCallStack => AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
-makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn
+makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn True
 
-makeConnectionForUsers_ :: HasCallStack => PQSupport -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
-makeConnectionForUsers_ pqSupport alice aliceUserId bob bobUserId = do
+makeConnectionForUsers_ :: HasCallStack => PQSupport -> SndQueueSecured -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
+makeConnectionForUsers_ pqSupport sqSecured alice aliceUserId bob bobUserId = do
   (bobId, qInfo) <- A.createConnection alice aliceUserId True SCMInvitation Nothing (CR.IKNoPQ pqSupport) SMSubscribe
   aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport
-  aliceId' <- A.joinConnection bob bobUserId (Just aliceId) True qInfo "bob's connInfo" pqSupport SMSubscribe
-  liftIO $ aliceId' `shouldBe` aliceId
+  (aliceId', sqSecured') <- A.joinConnection bob bobUserId (Just aliceId) True qInfo "bob's connInfo" pqSupport SMSubscribe
+  liftIO $ do
+    aliceId' `shouldBe` aliceId
+    sqSecured' `shouldBe` sqSecured
   ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
   liftIO $ pqSup' `shouldBe` pqSupport
   allowConnection alice bobId confId "alice's connInfo"
@@ -1816,7 +1853,7 @@ testBatchedSubscriptions :: Int -> Int -> ATransport -> IO ()
 testBatchedSubscriptions nCreate nDel t =
   withAgentClientsCfgServers2 agentCfg agentCfg initAgentServers2 $ \a b -> do
     conns <- runServers $ do
-      conns <- replicateM nCreate $ makeConnection_ PQSupportOff a b
+      conns <- replicateM nCreate $ makeConnection_ PQSupportOff True a b
       forM_ conns $ \(aId, bId) -> exchangeGreetings_ PQEncOff a bId b aId
       let (aIds', bIds') = unzip $ take nDel conns
       delete a bIds'
@@ -1894,15 +1931,17 @@ testBatchedPendingMessages nCreate nMsgs =
     withA = withAgent 1 agentCfg initAgentServers testDB
     withB = withAgent 2 agentCfg initAgentServers testDB2
 
-testAsyncCommands :: AgentClient -> AgentClient -> AgentMsgId -> IO ()
-testAsyncCommands alice bob baseId =
+testAsyncCommands :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+testAsyncCommands sqSecured alice bob baseId =
   runRight_ $ do
     bobId <- createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
     ("1", bobId', INV (ACR _ qInfo)) <- get alice
     liftIO $ bobId' `shouldBe` bobId
     aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
-    ("2", aliceId', OK) <- get bob
-    liftIO $ aliceId' `shouldBe` aliceId
+    ("2", aliceId', JOINED sqSecured') <- get bob
+    liftIO $ do
+      aliceId' `shouldBe` aliceId
+      sqSecured' `shouldBe` sqSecured
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     allowConnectionAsync alice "3" bobId confId "alice's connInfo"
     get alice =##> \case ("3", _, OK) -> True; _ -> False
@@ -1955,14 +1994,15 @@ testAsyncCommandsRestore t = do
       get alice' =##> \case ("1", _, INV _) -> True; _ -> False
       pure ()
 
-testAcceptContactAsync :: AgentClient -> AgentClient -> AgentMsgId -> IO ()
-testAcceptContactAsync alice bob baseId =
+testAcceptContactAsync :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+testAcceptContactAsync sqSecured alice bob baseId =
   runRight_ $ do
     (_, qInfo) <- createConnection alice 1 True SCMContact Nothing SMSubscribe
-    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    (aliceId, sqSecuredJoin) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
     ("", _, REQ invId _ "bob's connInfo") <- get alice
     bobId <- acceptContactAsync alice "1" True invId "alice's connInfo" PQSupportOn SMSubscribe
-    get alice =##> \case ("1", c, OK) -> c == bobId; _ -> False
+    get alice =##> \case ("1", c, JOINED sqSecured') -> c == bobId && sqSecured' == sqSecured; _ -> False
     ("", _, CONF confId _ "alice's connInfo") <- get bob
     allowConnection bob aliceId confId "bob's connInfo"
     get alice ##> ("", bobId, INFO "bob's connInfo")
@@ -2238,7 +2278,7 @@ testJoinConnectionAsyncReplyErrorV8 t = do
         pure (aId, bId)
       nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
       withSmpServerOn t testPort2 $ do
-        get b =##> \case ("2", c, OK) -> c == aId; _ -> False
+        get b =##> \case ("2", c, JOINED sqSecured) -> c == aId && not sqSecured; _ -> False
         confId <- withSmpServerStoreLogOn t testPort $ \_ -> do
           pGet a >>= \case
             ("", "", AEvt _ (UP _ [_])) -> do
@@ -2279,7 +2319,7 @@ testJoinConnectionAsyncReplyError t = do
       withSmpServerOn t testPort2 $ do
         confId <- withSmpServerStoreLogOn t testPort $ \_ -> do
           -- both servers need to be online for connection to progress because of SKEY
-          get b =##> \case ("2", c, OK) -> c == aId; _ -> False
+          get b =##> \case ("2", c, JOINED sqSecured) -> c == aId && sqSecured; _ -> False
           pGet a >>= \case
             ("", "", AEvt _ (UP _ [_])) -> do
               ("", _, CONF confId _ "bob's connInfo") <- get a
@@ -2733,8 +2773,8 @@ testSwitch2ConnectionsAbort1 servers = do
     withB :: (AgentClient -> IO a) -> IO a
     withB = withAgent 2 agentCfg servers testDB2
 
-testCreateQueueAuth :: HasCallStack => VersionSMP -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> AgentMsgId -> IO Int
-testCreateQueueAuth srvVersion clnt1 clnt2 baseId = do
+testCreateQueueAuth :: HasCallStack => VersionSMP -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int
+testCreateQueueAuth srvVersion clnt1 clnt2 sqSecured baseId = do
   a <- getClient 1 clnt1 testDB
   b <- getClient 2 clnt2 testDB2
   r <- runRight $ do
@@ -2745,7 +2785,8 @@ testCreateQueueAuth srvVersion clnt1 clnt2 baseId = do
         tryError (joinConnection b 1 True qInfo "bob's connInfo" SMSubscribe) >>= \case
           Left (SMP _ AUTH) -> pure 1
           Left e -> throwError e
-          Right aId -> do
+          Right (aId, sqSecured') -> do
+            liftIO $ sqSecured' `shouldBe` sqSecured
             ("", _, CONF confId _ "bob's connInfo") <- get a
             allowConnection a bId confId "alice's connInfo"
             get a ##> ("", bId, CON)
@@ -2805,7 +2846,7 @@ testDeliveryReceiptsVersion t = do
   b <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
   withSmpServerStoreMsgLogOn t testPort $ \_ -> do
     (aId, bId) <- runRight $ do
-      (aId, bId) <- makeConnection_ PQSupportOff a b
+      (aId, bId) <- makeConnection_ PQSupportOff False a b
       checkVersion a bId 3
       checkVersion b aId 3
       (2, _) <- A.sendMessage a bId PQEncOff SMP.noMsgFlags "hello"
@@ -2829,8 +2870,8 @@ testDeliveryReceiptsVersion t = do
       subscribeConnection a' bId
       subscribeConnection b' aId
       exchangeGreetingsMsgId_ PQEncOff 4 a' bId b' aId
-      checkVersion a' bId 6
-      checkVersion b' aId 6
+      checkVersion a' bId 7
+      checkVersion b' aId 7
       (6, PQEncOff) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello"
       get a' ##> ("", bId, SENT 6)
       get b' =##> \case ("", c, Msg' 6 PQEncOff "hello") -> c == aId; _ -> False
@@ -2979,7 +3020,8 @@ testServerMultipleIdentities :: HasCallStack => IO ()
 testServerMultipleIdentities =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
+    (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
+    liftIO $ sqSecured `shouldBe` True
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     allowConnection alice bobId confId "alice's connInfo"
     get alice ##> ("", bobId, CON)
@@ -3078,7 +3120,8 @@ testServerQueueInfo = do
     (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
     liftIO $ threadDelay 200000
     checkEmptyQ alice bobId False
-    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
+    (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
+    liftIO $ sqSecured `shouldBe` True
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     liftIO $ threadDelay 200000
     checkEmptyQ alice bobId True -- secured by sender
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index fd737e913..41ed8c730 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -477,7 +477,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
   (bobId, aliceId, nonce, message) <- runRight $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    (aliceId, _sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     allowConnection alice bobId confId "alice's connInfo"
     get bob ##> ("", aliceId, INFO "alice's connInfo")
@@ -544,7 +544,7 @@ testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} baseId alice bo
     liftIO $ threadDelay 50000
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
     liftIO $ threadDelay 1000000
-    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    (aliceId, _sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
     liftIO $ threadDelay 750000
     void $ messageNotificationData alice apnsQ
     ("", _, CONF confId _ "bob's connInfo") <- get alice
@@ -591,7 +591,8 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    liftIO $ sqSecured `shouldBe` True
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     allowConnection alice bobId confId "alice's connInfo"
     get bob ##> ("", aliceId, INFO "alice's connInfo")
@@ -653,7 +654,8 @@ testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers t
   (aliceId, bobId) <- withAgent 2 agentCfg initAgentServers testDB $ \alice -> runRight $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
+    liftIO $ sqSecured `shouldBe` True
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     allowConnection alice bobId confId "alice's connInfo"
     get bob ##> ("", aliceId, INFO "alice's connInfo")
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 7505ef977..2aa89e06f 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -207,7 +207,8 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b
   withAgent 1 aCfg (servers aTestCfg) testDB $ \alice ->
     withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do
       (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
-      aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+      (aliceId, sqSecured) <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+      liftIO $ sqSecured `shouldBe` True
       ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
       liftIO $ pqSup' `shouldBe` PQSupportOn
       allowConnection alice bobId confId "alice's connInfo"
@@ -261,7 +262,8 @@ agentDeliverMessagesViaProxyConc agentServers msgs =
     -- otherwise the CONF messages would get mixed with MSG
     prePair alice bob = do
       (bobId, qInfo) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
-      aliceId <- runExceptT' $ A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+      (aliceId, sqSecured) <- runExceptT' $ A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+      liftIO $ sqSecured `shouldBe` True
       confId <-
         get alice >>= \case
           ("", _, A.CONF confId pqSup' _ "bob's connInfo") -> do
@@ -329,7 +331,8 @@ agentViaProxyRetryOffline = do
       withServer $ \_ -> do
         (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do
           (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
-          aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+          (aliceId, sqSecured) <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+          liftIO $ sqSecured `shouldBe` True
           ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
           liftIO $ pqSup' `shouldBe` PQSupportOn
           allowConnection alice bobId confId "alice's connInfo"

From cc5732f41f802c5204aa4b6547aabddfca65c49c Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sat, 20 Jul 2024 14:10:10 +0100
Subject: [PATCH 045/195] smp server: stats for commands retrieving messages
 when notifications are received (#1236)

* more stats

* fix stats
---
 src/Simplex/Messaging/Server.hs | 83 +++++++++++++++++++++------------
 1 file changed, 54 insertions(+), 29 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 1d7398b43..c82036292 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -69,6 +69,7 @@ import Data.Type.Equality
 import GHC.Stats (getRTSStats)
 import GHC.TypeLits (KnownNat)
 import Network.Socket (ServiceName, Socket, socketToHandle)
+import Numeric.Natural (Natural)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Client (ProtocolClient (thParams), ProtocolClientError (..), SMPClient, SMPClientError, forwardSMPTransmission, smpProxyError, temporaryClientError)
 import Simplex.Messaging.Client.Agent (OwnServer, SMPClientAgent (..), SMPClientAgentEvent (..), closeSMPClientAgent, getSMPServerClient'', isOwnServer, lookupSMPServerClient, getConnectedSMPServerClient)
@@ -395,27 +396,28 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                   hPutStrLn h . B.unpack $ B.intercalate "," [bshow cid, encode sessionId, connected', strEncode createdAt, rcvActiveAt', sndActiveAt', bshow age, subscriptions']
               CPStats -> withUserRole $ do
                 ss <- unliftIO u $ asks serverStats
-                let putStat :: Show a => ByteString -> (ServerStats -> TVar a) -> IO ()
-                    putStat label var = readTVarIO (var ss) >>= \v -> B.hPutStr h $ label <> ": " <> bshow v <> "\n"
-                    putProxyStat :: ByteString -> (ServerStats -> ProxyStats) -> IO ()
+                let getStat :: (ServerStats -> TVar a) -> IO a
+                    getStat var = readTVarIO (var ss)
+                    putStat :: Show a => String -> (ServerStats -> TVar a) -> IO ()
+                    putStat label var = getStat var >>= \v -> hPutStrLn h $ label <> ": " <> show v
+                    putProxyStat :: String -> (ServerStats -> ProxyStats) -> IO ()
                     putProxyStat label var = do
                       ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther} <- atomically $ getProxyStatsData $ var ss
-                      B.hPutStr h $ label <> ": requests=" <> bshow _pRequests <> ", successes=" <> bshow _pSuccesses <> ", errorsConnect=" <> bshow _pErrorsConnect <> ", errorsCompat=" <> bshow _pErrorsCompat <> ", errorsOther=" <> bshow _pErrorsOther <> "\n"
+                      hPutStrLn h $ label <> ": requests=" <> show _pRequests <> ", successes=" <> show _pSuccesses <> ", errorsConnect=" <> show _pErrorsConnect <> ", errorsCompat=" <> show _pErrorsCompat <> ", errorsOther=" <> show _pErrorsOther
                 putStat "fromTime" fromTime
                 putStat "qCreated" qCreated
                 putStat "qSecured" qSecured
                 putStat "qDeletedAll" qDeletedAll
                 putStat "qDeletedNew" qDeletedNew
                 putStat "qDeletedSecured" qDeletedSecured
-                readTVarIO (day $ activeQueues ss) >>= \v -> B.hPutStr h $ "dayMsgQueues" <> ": " <> bshow (S.size v) <> "\n"
+                getStat (day . activeQueues) >>= \v -> hPutStrLn h $ "dayMsgQueues: " <> show (S.size v)
+                subs <- (,,,,) <$> getStat qSub <*> getStat qSubNoMsg <*> getStat qSubAuth <*> getStat qSubDuplicate <*> getStat qSubProhibited
+                hPutStrLn h $ "SUBs (count, noMsg, auth, duplicate, prohibited): " <> show subs
                 putStat "msgSent" msgSent
                 putStat "msgRecv" msgRecv
                 putStat "msgRecvGet" msgRecvGet
-                putStat "msgGet" msgGet
-                putStat "msgGetNoMsg" msgGetNoMsg
-                putStat "msgGetAuth" msgGetAuth
-                putStat "msgGetDuplicate" msgGetDuplicate
-                putStat "msgGetProhibited" msgGetProhibited
+                gets <- (,,,,) <$> getStat msgGet <*> getStat msgGetNoMsg <*> getStat msgGetAuth <*> getStat msgGetDuplicate <*> getStat msgGetProhibited
+                hPutStrLn h $ "GETs (count, noMsg, auth, duplicate, prohibited): " <> show gets
                 putStat "msgSentNtf" msgSentNtf
                 putStat "msgRecvNtf" msgRecvNtf
                 putStat "qCount" qCount
@@ -474,30 +476,53 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                   activeClients <- readTVarIO clients
                   hPutStrLn h $ "Clients: " <> show (IM.size activeClients)
                   when (r == CPRAdmin) $ do
-                    (smpSubCnt, smpSubCntByGroup, smpClCnt) <- countClientSubs subscriptions countSMPSubs activeClients
-                    (ntfSubCnt, _, ntfClCnt) <- countClientSubs ntfSubscriptions (\_ -> pure (0, 0, 0, 0)) activeClients
-                    hPutStrLn h $ "SMP subscriptions (via clients, slow): " <> show smpSubCnt
+                    clQs <- clientTBQueueLengths activeClients
+                    hPutStrLn h $ "Client queues (rcvQ, sndQ, msgQ): " <> show clQs
+                    (smpSubCnt, smpSubCntByGroup, smpClCnt, smpClQs) <- countClientSubs subscriptions (Just countSMPSubs) activeClients
+                    hPutStrLn h $ "SMP subscriptions (via clients): " <> show smpSubCnt
                     hPutStrLn h $ "SMP subscriptions (by group: NoSub, SubPending, SubThread, ProhibitSub): " <> show smpSubCntByGroup
-                    hPutStrLn h $ "SMP subscribed clients (via clients, slow): " <> show smpClCnt
-                    hPutStrLn h $ "Ntf subscriptions (via clients, slow): " <> show ntfSubCnt
-                    hPutStrLn h $ "Ntf subscribed clients (via clients, slow): " <> show ntfClCnt
-                  activeSubs <- readTVarIO subscribers
-                  activeNtfSubs <- readTVarIO notifiers
-                  hPutStrLn h $ "SMP subscriptions: " <> show (M.size activeSubs)
-                  hPutStrLn h $ "SMP subscribed clients: " <> show (countSubClients activeSubs)
-                  hPutStrLn h $ "Ntf subscriptions: " <> show (M.size activeNtfSubs)
-                  hPutStrLn h $ "Ntf subscribed clients: " <> show (countSubClients activeNtfSubs)
+                    hPutStrLn h $ "SMP subscribed clients (via clients): " <> show smpClCnt
+                    hPutStrLn h $ "SMP subscribed clients queues (via clients, rcvQ, sndQ, msgQ): " <> show smpClQs
+                    (ntfSubCnt, _, ntfClCnt, ntfClQs) <- countClientSubs ntfSubscriptions Nothing activeClients
+                    hPutStrLn h $ "Ntf subscriptions (via clients): " <> show ntfSubCnt
+                    hPutStrLn h $ "Ntf subscribed clients (via clients): " <> show ntfClCnt
+                    hPutStrLn h $ "Ntf subscribed clients queues (via clients, rcvQ, sndQ, msgQ): " <> show ntfClQs
+                  putActiveClientsInfo "SMP" subscribers
+                  putActiveClientsInfo "Ntf" notifiers
                   where
-                    countClientSubs :: (Client -> TMap QueueId a) -> (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap Client -> IO (Int, (Int, Int, Int, Int), Int)
-                    countClientSubs subSel countSubs = foldM addSubs (0, (0, 0, 0, 0), 0)
+                    putActiveClientsInfo :: String -> TMap QueueId Client -> IO ()
+                    putActiveClientsInfo protoName clients = do
+                      activeSubs <- readTVarIO clients
+                      hPutStrLn h $ protoName <> " subscriptions: " <> show (M.size activeSubs)
+                      hPutStrLn h $ protoName <> " subscribed clients: " <> show (countSubClients activeSubs)
+                      when (r == CPRAdmin) $ do
+                        clQs <- clientTBQueueLengths activeSubs
+                        hPutStrLn h $ protoName <> " subscribed clients queues (rcvQ, sndQ, msgQ): " <> show clQs
+                    countClientSubs :: (Client -> TMap QueueId a) -> Maybe (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap Client -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
+                    countClientSubs subSel countSubs_ = foldM addSubs (0, (0, 0, 0, 0), 0, (0, 0, 0))
                       where
-                        addSubs :: (Int, (Int, Int, Int, Int), Int) -> Client -> IO (Int, (Int, Int, Int, Int), Int)
-                        addSubs (subCnt, (c1, c2, c3, c4), clCnt) cl = do
+                        addSubs :: (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural)) -> Client -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
+                        addSubs (!subCnt, cnts@(!c1, !c2, !c3, !c4), !clCnt, !qs) cl = do
                           subs <- readTVarIO $ subSel cl
-                          (c1', c2', c3', c4') <- countSubs subs
+                          cnts' <- case countSubs_ of
+                            Nothing -> pure cnts
+                            Just countSubs -> do
+                              (c1', c2', c3', c4') <- countSubs subs
+                              pure (c1 + c1', c2 + c2', c3 + c3', c4 + c4')
                           let cnt = M.size subs
-                              cnts' = (c1 + c1', c2 + c2', c3 + c3', c4 + c4')
-                          pure (subCnt + cnt, cnts', clCnt + if cnt == 0 then 0 else 1)
+                              clCnt' = if cnt == 0 then clCnt else clCnt + 1
+                          qs' <- if cnt == 0 then pure qs else addQueueLengths qs cl
+                          pure (subCnt + cnt, cnts', clCnt', qs')
+                    clientTBQueueLengths :: Foldable t => t Client -> IO (Natural, Natural, Natural)
+                    clientTBQueueLengths = foldM addQueueLengths (0, 0, 0)
+                    addQueueLengths (!rl, !sl, !ml) cl = do
+                      (rl', sl', ml') <- queueLengths cl
+                      pure (rl + rl', sl + sl', ml + ml')
+                    queueLengths Client {rcvQ, sndQ, msgQ} = do
+                      rl <- atomically $ lengthTBQueue rcvQ
+                      sl <- atomically $ lengthTBQueue sndQ
+                      ml <- atomically $ lengthTBQueue msgQ
+                      pure (rl, sl, ml)
                     countSMPSubs :: M.Map QueueId Sub -> IO (Int, Int, Int, Int)
                     countSMPSubs = foldM countSubs (0, 0, 0, 0)
                       where

From 8423c636a82530b32061e2628af4892100d3da46 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 22 Jul 2024 12:01:38 +0100
Subject: [PATCH 046/195] rename queueId to entId (can be message queue,
 proxied session and data blob ID to be added) (#1240)

---
 src/Simplex/Messaging/Server.hs | 78 ++++++++++++++++-----------------
 1 file changed, 39 insertions(+), 39 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index c82036292..34c7dd561 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -874,10 +874,10 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
       incStat $ sel ps
       when own $ incStat $ sel psOwn
     processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
-    processCommand (qr_, (corrId, queueId, cmd)) = case cmd of
-      Cmd SProxiedClient command -> processProxiedCmd (corrId, queueId, command)
+    processCommand (qr_, (corrId, entId, cmd)) = case cmd of
+      Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command)
       Cmd SSender command -> Just <$> case command of
-        SKEY sKey -> (corrId,queueId,) <$> case qr_ of
+        SKEY sKey -> (corrId,entId,) <$> case qr_ of
           Just QueueRec {sndSecure, recipientId}
             | sndSecure -> secureQueue_ "SKEY" recipientId sKey
             | otherwise -> pure $ ERR AUTH
@@ -893,15 +893,15 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             ifM
               allowNew
               (createQueue st rKey dhKey subMode sndSecure)
-              (pure (corrId, queueId, ERR AUTH))
+              (pure (corrId, entId, ERR AUTH))
             where
               allowNew = do
                 ServerConfig {allowNewQueues, newQueueBasicAuth} <- asks config
                 pure $ allowNewQueues && maybe True ((== auth) . Just) newQueueBasicAuth
-          SUB -> withQueue (`subscribeQueue` queueId)
+          SUB -> withQueue (`subscribeQueue` entId)
           GET -> withQueue getMessage
           ACK msgId -> withQueue (`acknowledgeMsg` msgId)
-          KEY sKey -> (corrId,queueId,) <$> case qr_ of
+          KEY sKey -> (corrId,entId,) <$> case qr_ of
             Just QueueRec {recipientId} -> secureQueue_ "KEY" recipientId sKey
             Nothing -> pure $ ERR INTERNAL
           NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
@@ -926,7 +926,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                     status = QueueActive,
                     sndSecure
                   }
-          (corrId,queueId,) <$> addQueueRetry 3 qik qRec
+          (corrId,entId,) <$> addQueueRetry 3 qik qRec
           where
             addQueueRetry ::
               Int -> ((RecipientId, SenderId) -> QueueIdsKeys) -> ((RecipientId, SenderId) -> QueueRec) -> M BrokerMsg
@@ -971,34 +971,34 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
         addQueueNotifier_ st notifierKey dhKey = time "NKEY" $ do
           (rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
           let rcvNtfDhSecret = C.dh' dhKey privDhKey
-          (corrId,queueId,) <$> addNotifierRetry 3 rcvPublicDhKey rcvNtfDhSecret
+          (corrId,entId,) <$> addNotifierRetry 3 rcvPublicDhKey rcvNtfDhSecret
           where
             addNotifierRetry :: Int -> RcvNtfPublicDhKey -> RcvNtfDhSecret -> M BrokerMsg
             addNotifierRetry 0 _ _ = pure $ ERR INTERNAL
             addNotifierRetry n rcvPublicDhKey rcvNtfDhSecret = do
               notifierId <- randomId =<< asks (queueIdBytes . config)
               let ntfCreds = NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}
-              atomically (addQueueNotifier st queueId ntfCreds) >>= \case
+              atomically (addQueueNotifier st entId ntfCreds) >>= \case
                 Left DUPLICATE_ -> addNotifierRetry (n - 1) rcvPublicDhKey rcvNtfDhSecret
                 Left e -> pure $ ERR e
                 Right _ -> do
-                  withLog $ \s -> logAddNotifier s queueId ntfCreds
+                  withLog $ \s -> logAddNotifier s entId ntfCreds
                   pure $ NID notifierId rcvPublicDhKey
 
         deleteQueueNotifier_ :: QueueStore -> M (Transmission BrokerMsg)
         deleteQueueNotifier_ st = do
-          withLog (`logDeleteNotifier` queueId)
-          atomically (deleteQueueNotifier st queueId) >>= \case
+          withLog (`logDeleteNotifier` entId)
+          atomically (deleteQueueNotifier st entId) >>= \case
             Right () -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              atomically $ writeTQueue ntfSubscribedQ (queueId, clnt, False)
+              atomically $ writeTQueue ntfSubscribedQ (entId, clnt, False)
               pure ok
             Left e -> pure $ err e
 
         suspendQueue_ :: QueueStore -> M (Transmission BrokerMsg)
         suspendQueue_ st = do
-          withLog (`logSuspendQueue` queueId)
-          okResp <$> atomically (suspendQueue st queueId)
+          withLog (`logSuspendQueue` entId)
+          okResp <$> atomically (suspendQueue st entId)
 
         subscribeQueue :: QueueRec -> RecipientId -> M (Transmission BrokerMsg)
         subscribeQueue qr rId = do
@@ -1032,7 +1032,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
 
         getMessage :: QueueRec -> M (Transmission BrokerMsg)
         getMessage qr = time "GET" $ do
-          atomically (TM.lookup queueId subscriptions) >>= \case
+          atomically (TM.lookup entId subscriptions) >>= \case
             Nothing ->
               atomically newSub >>= (`getMessage_` Nothing)
             Just s@Sub {subThread} ->
@@ -1044,16 +1044,16 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 _ -> do
                   stats <- asks serverStats
                   incStat $ msgGetProhibited stats
-                  pure (corrId, queueId, ERR $ CMD PROHIBITED)
+                  pure (corrId, entId, ERR $ CMD PROHIBITED)
           where
             newSub :: STM Sub
             newSub = do
               s <- newSubscription ProhibitSub
-              TM.insert queueId s subscriptions
+              TM.insert entId s subscriptions
               pure s
             getMessage_ :: Sub -> Maybe MsgId -> M (Transmission BrokerMsg)
             getMessage_ s delivered_ = do
-              q <- getStoreMsgQueue "GET" queueId
+              q <- getStoreMsgQueue "GET" entId
               stats <- asks serverStats
               (statCnt, r) <-
                 atomically $
@@ -1061,8 +1061,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                     Just msg ->
                       let encMsg = encryptMsg qr msg
                           cnt = if isJust delivered_ then msgGetDuplicate else msgGet
-                       in setDelivered s msg $> (cnt, (corrId, queueId, MSG encMsg))
-                    _ -> pure (msgGetNoMsg, (corrId, queueId, OK))
+                       in setDelivered s msg $> (cnt, (corrId, entId, MSG encMsg))
+                    _ -> pure (msgGetNoMsg, (corrId, entId, OK))
               incStat $ statCnt stats
               pure r
 
@@ -1071,19 +1071,19 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
 
         subscribeNotifications :: M (Transmission BrokerMsg)
         subscribeNotifications = time "NSUB" . atomically $ do
-          unlessM (TM.member queueId ntfSubscriptions) $ do
-            writeTQueue ntfSubscribedQ (queueId, clnt, True)
-            TM.insert queueId () ntfSubscriptions
+          unlessM (TM.member entId ntfSubscriptions) $ do
+            writeTQueue ntfSubscribedQ (entId, clnt, True)
+            TM.insert entId () ntfSubscriptions
           pure ok
 
         acknowledgeMsg :: QueueRec -> MsgId -> M (Transmission BrokerMsg)
         acknowledgeMsg qr msgId = time "ACK" $ do
-          atomically (TM.lookup queueId subscriptions) >>= \case
+          atomically (TM.lookup entId subscriptions) >>= \case
             Nothing -> pure $ err NO_MSG
             Just sub ->
               atomically (getDelivered sub) >>= \case
                 Just st -> do
-                  q <- getStoreMsgQueue "ACK" queueId
+                  q <- getStoreMsgQueue "ACK" entId
                   case st of
                     ProhibitSub -> do
                       deletedMsg_ <- atomically $ tryDelMsg q msgId
@@ -1092,7 +1092,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                     _ -> do
                       (deletedMsg_, msg_) <- atomically $ tryDelPeekMsg q msgId
                       mapM_ (updateStats False) deletedMsg_
-                      deliverMessage "ACK" qr queueId sub msg_
+                      deliverMessage "ACK" qr entId sub msg_
                 _ -> pure $ err NO_MSG
           where
             getDelivered :: Sub -> STM (Maybe SubscriptionThread)
@@ -1109,10 +1109,10 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 incStat $ msgRecv stats
                 when isGet $ incStat $ msgRecvGet stats
                 atomically $ modifyTVar' (msgCount stats) (subtract 1)
-                atomically $ updatePeriodStats (activeQueues stats) queueId
+                atomically $ updatePeriodStats (activeQueues stats) entId
                 when (notification msgFlags) $ do
                   incStat $ msgRecvNtf stats
-                  atomically $ updatePeriodStats (activeQueuesNtf stats) queueId
+                  atomically $ updatePeriodStats (activeQueuesNtf stats) entId
 
         sendMessage :: QueueRec -> MsgFlags -> MsgBody -> M (Transmission BrokerMsg)
         sendMessage qr msgFlags msgBody
@@ -1306,7 +1306,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             resp = (corrId, rId, OK)
 
         time :: T.Text -> M a -> M a
-        time name = timed name queueId
+        time name = timed name entId
 
         encryptMsg :: QueueRec -> Message -> RcvMessage
         encryptMsg qr msg = encrypt . encodeRcvMsgBody $ case msg of
@@ -1329,26 +1329,26 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
 
         delQueueAndMsgs :: QueueStore -> M (Transmission BrokerMsg)
         delQueueAndMsgs st = do
-          withLog (`logDeleteQueue` queueId)
+          withLog (`logDeleteQueue` entId)
           ms <- asks msgStore
-          atomically (deleteQueue st queueId $>>= \q -> delMsgQueue ms queueId $> Right q) >>= \case
+          atomically (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case
             Right q -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              atomically $ writeTQueue subscribedQ (queueId, clnt, False)
-              atomically $ writeTQueue ntfSubscribedQ (queueId, clnt, False)
+              atomically $ writeTQueue subscribedQ (entId, clnt, False)
+              atomically $ writeTQueue ntfSubscribedQ (entId, clnt, False)
               updateDeletedStats q
               pure ok
             Left e -> pure $ err e
 
         getQueueInfo :: QueueRec -> M (Transmission BrokerMsg)
         getQueueInfo QueueRec {senderKey, notifier} = do
-          q@MsgQueue {size} <- getStoreMsgQueue "getQueueInfo" queueId
+          q@MsgQueue {size} <- getStoreMsgQueue "getQueueInfo" entId
           info <- atomically $ do
-            qiSub <- TM.lookup queueId subscriptions >>= mapM mkQSub
+            qiSub <- TM.lookup entId subscriptions >>= mapM mkQSub
             qiSize <- readTVar size
             qiMsg <- toMsgInfo <$$> tryPeekMsg q
             pure QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
-          pure (corrId, queueId, INFO info)
+          pure (corrId, entId, INFO info)
           where
             mkQSub Sub {subThread, delivered} = do
               st <- readTVar subThread
@@ -1361,10 +1361,10 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
               pure QSub {qSubThread, qDelivered}
 
         ok :: Transmission BrokerMsg
-        ok = (corrId, queueId, OK)
+        ok = (corrId, entId, OK)
 
         err :: ErrorType -> Transmission BrokerMsg
-        err e = (corrId, queueId, ERR e)
+        err e = (corrId, entId, ERR e)
 
         okResp :: Either ErrorType () -> Transmission BrokerMsg
         okResp = either err $ const ok

From 051bf38bc75414fa58fa5004619594b0f674b591 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 22 Jul 2024 15:42:34 +0100
Subject: [PATCH 047/195] agent: remove delays in notification processing, add
 notification stats (#1235)

* agent: remove delays in notification processing, add notification stats

* do not replace token after failed check

* more stats

* refactor

* fix

* backwards compatible JSON parsing

* retry deleting subscription on temporary error

* remove attempts to get multiple notification messages

* fix JSON decoding to be backwards compatible
---
 src/Simplex/Messaging/Agent.hs                |  37 ++--
 src/Simplex/Messaging/Agent/Client.hs         |  40 ++--
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |   6 -
 .../Messaging/Agent/NtfSubSupervisor.hs       | 108 +++++------
 src/Simplex/Messaging/Agent/Stats.hs          | 176 +++++++++++++++++-
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  29 +--
 src/Simplex/Messaging/Notifications/Types.hs  |  18 +-
 tests/AgentTests/NotificationTests.hs         |   2 +-
 tests/SMPAgentClient.hs                       |   2 -
 9 files changed, 285 insertions(+), 133 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index a0079c883..f26c46925 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -237,25 +237,25 @@ logServersStats c = do
     liftIO $ threadDelay' int
 
 saveServersStats :: AgentClient -> AM' ()
-saveServersStats c@AgentClient {subQ, smpServersStats, xftpServersStats} = do
+saveServersStats c@AgentClient {subQ, smpServersStats, xftpServersStats, ntfServersStats} = do
   sss <- mapM (lift . getAgentSMPServerStats) =<< readTVarIO smpServersStats
   xss <- mapM (lift . getAgentXFTPServerStats) =<< readTVarIO xftpServersStats
-  let stats = AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss}
+  nss <- mapM (lift . getAgentNtfServerStats) =<< readTVarIO ntfServersStats
+  let stats = AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss, ntfServersStats = OptionalMap nss}
   tryAgentError' (withStore' c (`updateServersStats` stats)) >>= \case
     Left e -> atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
     Right () -> pure ()
 
 restoreServersStats :: AgentClient -> AM' ()
-restoreServersStats c@AgentClient {smpServersStats, xftpServersStats, srvStatsStartedAt} = do
+restoreServersStats c@AgentClient {smpServersStats, xftpServersStats, ntfServersStats, srvStatsStartedAt} = do
   tryAgentError' (withStore c getServersStats) >>= \case
     Left e -> atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
     Right (startedAt, Nothing) -> atomically $ writeTVar srvStatsStartedAt startedAt
-    Right (startedAt, Just AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss}) -> do
+    Right (startedAt, Just AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss, ntfServersStats = OptionalMap nss}) -> do
       atomically $ writeTVar srvStatsStartedAt startedAt
-      sss' <- mapM (atomically . newAgentSMPServerStats') sss
-      atomically $ writeTVar smpServersStats sss'
-      xss' <- mapM (atomically . newAgentXFTPServerStats') xss
-      atomically $ writeTVar xftpServersStats xss'
+      atomically . writeTVar smpServersStats =<< mapM (atomically . newAgentSMPServerStats') sss
+      atomically . writeTVar xftpServersStats =<< mapM (atomically . newAgentXFTPServerStats') xss
+      atomically . writeTVar ntfServersStats =<< mapM (atomically . newAgentNtfServerStats') nss
 
 disconnectAgentClient :: AgentClient -> IO ()
 disconnectAgentClient c@AgentClient {agentEnv = Env {ntfSupervisor = ns, xftpAgent = xa}} = do
@@ -375,7 +375,7 @@ getConnectionMessage c = withAgentEnv c . getConnectionMessage' c
 {-# INLINE getConnectionMessage #-}
 
 -- | Get connection message for received notification
-getNotificationMessage :: AgentClient -> C.CbNonce -> ByteString -> AE (NotificationInfo, [SMPMsgMeta])
+getNotificationMessage :: AgentClient -> C.CbNonce -> ByteString -> AE (NotificationInfo, Maybe SMPMsgMeta)
 getNotificationMessage c = withAgentEnv c .: getNotificationMessage' c
 {-# INLINE getNotificationMessage #-}
 
@@ -1032,7 +1032,7 @@ getConnectionMessage' c connId = do
     SndConnection _ _ -> throwE $ CONN SIMPLEX
     NewConnection _ -> throwE $ CMD PROHIBITED "getConnectionMessage: NewConnection"
 
-getNotificationMessage' :: AgentClient -> C.CbNonce -> ByteString -> AM (NotificationInfo, [SMPMsgMeta])
+getNotificationMessage' :: AgentClient -> C.CbNonce -> ByteString -> AM (NotificationInfo, Maybe SMPMsgMeta)
 getNotificationMessage' c nonce encNtfInfo = do
   withStore' c getActiveNtfToken >>= \case
     Just NtfToken {ntfDhSecret = Just dhSecret} -> do
@@ -1040,22 +1040,9 @@ getNotificationMessage' c nonce encNtfInfo = do
       PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} <- liftEither (parse strP (INTERNAL "error parsing PNMessageData") ntfData)
       (ntfConnId, rcvNtfDhSecret) <- withStore c (`getNtfRcvQueue` smpQueue)
       ntfMsgMeta <- (eitherToMaybe . smpDecode <$> agentCbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta) `catchAgentError` \_ -> pure Nothing
-      maxMsgs <- asks $ ntfMaxMessages . config
-      (NotificationInfo {ntfConnId, ntfTs, ntfMsgMeta},) <$> getNtfMessages ntfConnId ntfMsgMeta maxMsgs
+      msgMeta <- getConnectionMessage' c ntfConnId
+      pure (NotificationInfo {ntfConnId, ntfTs, ntfMsgMeta}, msgMeta)
     _ -> throwE $ CMD PROHIBITED "getNotificationMessage"
-  where
-    getNtfMessages ntfConnId nMeta = getMsg
-      where
-        getMsg 0 = pure []
-        getMsg n =
-          getConnectionMessage' c ntfConnId >>= \case
-            Just m
-              | lastMsg m -> pure [m]
-              | otherwise -> (m :) <$> getMsg (n - 1)
-            Nothing -> pure []
-        lastMsg SMP.SMPMsgMeta {msgId, msgTs, msgFlags} = case nMeta of
-          Just SMP.NMsgMeta {msgId = msgId', msgTs = msgTs'} -> msgId == msgId' || msgTs > msgTs'
-          Nothing -> SMP.notification msgFlags
 
 -- | Send message to the connection (SEND command) in Reader monad
 sendMessage' :: AgentClient -> ConnId -> PQEncryption -> MsgFlags -> MsgBody -> AM (AgentMsgId, PQEncryption)
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 43b3b8064..3a7616499 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -145,6 +145,7 @@ module Simplex.Messaging.Agent.Client
     incXFTPServerStat,
     incXFTPServerStat',
     incXFTPServerSizeStat,
+    incNtfServerStat,
     AgentWorkersDetails (..),
     getAgentWorkersDetails,
     AgentWorkersSummary (..),
@@ -330,6 +331,7 @@ data AgentClient = AgentClient
     agentEnv :: Env,
     smpServersStats :: TMap (UserId, SMPServer) AgentSMPServerStats,
     xftpServersStats :: TMap (UserId, XFTPServer) AgentXFTPServerStats,
+    ntfServersStats :: TMap  (UserId, NtfServer) AgentNtfServerStats,
     srvStatsStartedAt :: TVar UTCTime
   }
 
@@ -488,6 +490,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
   smpSubWorkers <- TM.empty
   smpServersStats <- TM.empty
   xftpServersStats <- TM.empty
+  ntfServersStats <- TM.empty
   srvStatsStartedAt <- newTVar currentTs
   return
     AgentClient
@@ -528,6 +531,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
         agentEnv,
         smpServersStats,
         xftpServersStats,
+        ntfServersStats,
         srvStatsStartedAt
       }
 
@@ -1954,13 +1958,7 @@ incSMPServerStat :: AgentClient -> UserId -> SMPServer -> (AgentSMPServerStats -
 incSMPServerStat c userId srv sel = incSMPServerStat' c userId srv sel 1
 
 incSMPServerStat' :: AgentClient -> UserId -> SMPServer -> (AgentSMPServerStats -> TVar Int) -> Int -> STM ()
-incSMPServerStat' AgentClient {smpServersStats} userId srv sel n = do
-  TM.lookup (userId, srv) smpServersStats >>= \case
-    Just v -> modifyTVar' (sel v) (+ n)
-    Nothing -> do
-      newStats <- newAgentSMPServerStats
-      modifyTVar' (sel newStats) (+ n)
-      TM.insert (userId, srv) newStats smpServersStats
+incSMPServerStat' = incServerStat (\AgentClient {smpServersStats = s} -> s) newAgentSMPServerStats
 
 incXFTPServerStat :: AgentClient -> UserId -> XFTPServer -> (AgentXFTPServerStats -> TVar Int) -> STM ()
 incXFTPServerStat c userId srv sel = incXFTPServerStat_ c userId srv sel 1
@@ -1975,24 +1973,34 @@ incXFTPServerSizeStat = incXFTPServerStat_
 {-# INLINE incXFTPServerSizeStat #-}
 
 incXFTPServerStat_ :: Num n => AgentClient -> UserId -> XFTPServer -> (AgentXFTPServerStats -> TVar n) -> n -> STM ()
-incXFTPServerStat_ AgentClient {xftpServersStats} userId srv sel n = do
-  TM.lookup (userId, srv) xftpServersStats >>= \case
+incXFTPServerStat_ = incServerStat (\AgentClient {xftpServersStats = s} -> s) newAgentXFTPServerStats
+{-# INLINE incXFTPServerStat_ #-}
+
+incNtfServerStat :: AgentClient -> UserId -> NtfServer -> (AgentNtfServerStats -> TVar Int) -> STM ()
+incNtfServerStat c userId srv sel = incServerStat (\AgentClient {ntfServersStats = s} -> s) newAgentNtfServerStats c userId srv sel 1
+{-# INLINE incNtfServerStat #-}
+
+incServerStat :: Num n => (AgentClient -> TMap (UserId, ProtocolServer p) s) -> STM s -> AgentClient -> UserId -> ProtocolServer p -> (s -> TVar n) -> n -> STM ()
+incServerStat statsSel mkNewStats c userId srv sel n = do
+  TM.lookup (userId, srv) (statsSel c) >>= \case
     Just v -> modifyTVar' (sel v) (+ n)
     Nothing -> do
-      newStats <- newAgentXFTPServerStats
+      newStats <- mkNewStats
       modifyTVar' (sel newStats) (+ n)
-      TM.insert (userId, srv) newStats xftpServersStats
+      TM.insert (userId, srv) newStats (statsSel c)
 
 data AgentServersSummary = AgentServersSummary
   { smpServersStats :: Map (UserId, SMPServer) AgentSMPServerStatsData,
     xftpServersStats :: Map (UserId, XFTPServer) AgentXFTPServerStatsData,
+    ntfServersStats :: Map (UserId, NtfServer) AgentNtfServerStatsData,
     statsStartedAt :: UTCTime,
     smpServersSessions :: Map (UserId, SMPServer) ServerSessions,
     smpServersSubs :: Map (UserId, SMPServer) SMPServerSubs,
     xftpServersSessions :: Map (UserId, XFTPServer) ServerSessions,
     xftpRcvInProgress :: [XFTPServer],
     xftpSndInProgress :: [XFTPServer],
-    xftpDelInProgress :: [XFTPServer]
+    xftpDelInProgress :: [XFTPServer],
+    ntfServersSessions :: Map (UserId, NtfServer) ServerSessions
   }
   deriving (Show)
 
@@ -2010,9 +2018,10 @@ data ServerSessions = ServerSessions
   deriving (Show)
 
 getAgentServersSummary :: AgentClient -> IO AgentServersSummary
-getAgentServersSummary c@AgentClient {smpServersStats, xftpServersStats, srvStatsStartedAt, agentEnv} = do
+getAgentServersSummary c@AgentClient {smpServersStats, xftpServersStats, ntfServersStats, srvStatsStartedAt, agentEnv} = do
   sss <- mapM getAgentSMPServerStats =<< readTVarIO smpServersStats
   xss <- mapM getAgentXFTPServerStats =<< readTVarIO xftpServersStats
+  nss <- mapM getAgentNtfServerStats =<< readTVarIO ntfServersStats
   statsStartedAt <- readTVarIO srvStatsStartedAt
   smpServersSessions <- countSessions =<< readTVarIO (smpClients c)
   smpServersSubs <- getServerSubs
@@ -2020,17 +2029,20 @@ getAgentServersSummary c@AgentClient {smpServersStats, xftpServersStats, srvStat
   xftpRcvInProgress <- catMaybes <$> getXFTPWorkerSrvs xftpRcvWorkers
   xftpSndInProgress <- catMaybes <$> getXFTPWorkerSrvs xftpSndWorkers
   xftpDelInProgress <- getXFTPWorkerSrvs xftpDelWorkers
+  ntfServersSessions <- countSessions =<< readTVarIO (ntfClients c)
   pure
     AgentServersSummary
       { smpServersStats = sss,
         xftpServersStats = xss,
+        ntfServersStats = nss,
         statsStartedAt,
         smpServersSessions,
         smpServersSubs,
         xftpServersSessions,
         xftpRcvInProgress,
         xftpSndInProgress,
-        xftpDelInProgress
+        xftpDelInProgress,
+        ntfServersSessions
       }
   where
     getServerSubs = do
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 0f88508b9..d21d0fb5e 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -148,10 +148,7 @@ data AgentConfig = AgentConfig
     xftpMaxRecipientsPerRequest :: Int,
     deleteErrorCount :: Int,
     ntfCron :: Word16,
-    ntfWorkerDelay :: Int,
-    ntfSMPWorkerDelay :: Int,
     ntfSubCheckInterval :: NominalDiffTime,
-    ntfMaxMessages :: Int,
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
     certificateFile :: FilePath,
@@ -220,10 +217,7 @@ defaultAgentConfig =
       xftpMaxRecipientsPerRequest = 200,
       deleteErrorCount = 10,
       ntfCron = 20, -- minutes
-      ntfWorkerDelay = 100000, -- microseconds
-      ntfSMPWorkerDelay = 500000, -- microseconds
       ntfSubCheckInterval = nominalDay,
-      ntfMaxMessages = 3,
       -- CA certificate private key is not needed for initialization
       -- ! we do not generate these
       caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
index a239768b0..689e5fcce 100644
--- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
+++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
@@ -20,8 +20,8 @@ where
 
 import Control.Logger.Simple (logError, logInfo)
 import Control.Monad
-import Control.Monad.Except
 import Control.Monad.Reader
+import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
@@ -31,6 +31,7 @@ import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol (AEvent (..), AEvt (..), AgentErrorType (..), BrokerErrorType (..), ConnId, NotificationsMode (..), SAEntity (..))
 import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Crypto as C
@@ -40,7 +41,7 @@ import Simplex.Messaging.Protocol (NtfServer, SMPServer, sameSrvAddr)
 import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow, unlessM)
 import System.Random (randomR)
 import UnliftIO
-import UnliftIO.Concurrent (forkIO, threadDelay)
+import UnliftIO.Concurrent (forkIO)
 import qualified UnliftIO.Exception as E
 
 runNtfSupervisor :: AgentClient -> AM' ()
@@ -64,7 +65,7 @@ processNtfSub c (connId, cmd) = do
   logInfo $ "processNtfSub - connId = " <> tshow connId <> " - cmd = " <> tshow cmd
   case cmd of
     NSCCreate -> do
-      (a, RcvQueue {server = smpServer, clientNtfCreds}) <- withStore c $ \db -> runExceptT $ do
+      (a, RcvQueue {userId, server = smpServer, clientNtfCreds}) <- withStore c $ \db -> runExceptT $ do
         a <- liftIO $ getNtfSubscription db connId
         q <- ExceptT $ getPrimaryRcvQueue db connId
         pure (a, q)
@@ -74,12 +75,12 @@ processNtfSub c (connId, cmd) = do
           withTokenServer $ \ntfServer -> do
             case clientNtfCreds of
               Just ClientNtfCreds {notifierId} -> do
-                let newSub = newNtfSubscription connId smpServer (Just notifierId) ntfServer NASKey
-                withStore c $ \db -> createNtfSubscription db newSub $ NtfSubNTFAction NSACreate
+                let newSub = newNtfSubscription userId connId smpServer (Just notifierId) ntfServer NASKey
+                withStore c $ \db -> createNtfSubscription db newSub $ NSANtf NSACreate
                 lift . void $ getNtfNTFWorker True c ntfServer
               Nothing -> do
-                let newSub = newNtfSubscription connId smpServer Nothing ntfServer NASNew
-                withStore c $ \db -> createNtfSubscription db newSub $ NtfSubSMPAction NSASmpKey
+                let newSub = newNtfSubscription userId connId smpServer Nothing ntfServer NASNew
+                withStore c $ \db -> createNtfSubscription db newSub $ NSASMP NSASmpKey
                 lift . void $ getNtfSMPWorker True c smpServer
         (Just (sub@NtfSubscription {ntfSubStatus, ntfServer = subNtfServer, smpServer = smpServer', ntfQueueId}, action_)) -> do
           case (clientNtfCreds, ntfQueueId) of
@@ -99,24 +100,24 @@ processNtfSub c (connId, cmd) = do
                     if ntfSubStatus == NASNew || ntfSubStatus == NASOff || ntfSubStatus == NASDeleted
                       then resetSubscription
                       else withTokenServer $ \ntfServer -> do
-                        withStore' c $ \db -> supervisorUpdateNtfSub db sub {ntfServer} (NtfSubNTFAction NSACreate)
+                        withStore' c $ \db -> supervisorUpdateNtfSub db sub {ntfServer} (NSANtf NSACreate)
                         lift . void $ getNtfNTFWorker True c ntfServer
                 | otherwise -> case action of
-                    NtfSubNTFAction _ -> lift . void $ getNtfNTFWorker True c subNtfServer
-                    NtfSubSMPAction _ -> lift . void $ getNtfSMPWorker True c smpServer
+                    NSANtf _ -> lift . void $ getNtfNTFWorker True c subNtfServer
+                    NSASMP _ -> lift . void $ getNtfSMPWorker True c smpServer
             rotate :: AM ()
             rotate = do
-              withStore' c $ \db -> supervisorUpdateNtfSub db sub (NtfSubNTFAction NSARotate)
+              withStore' c $ \db -> supervisorUpdateNtfSub db sub (NSANtf NSARotate)
               lift . void $ getNtfNTFWorker True c subNtfServer
             resetSubscription :: AM ()
             resetSubscription =
               withTokenServer $ \ntfServer -> do
                 let sub' = sub {ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
-                withStore' c $ \db -> supervisorUpdateNtfSub db sub' (NtfSubSMPAction NSASmpKey)
+                withStore' c $ \db -> supervisorUpdateNtfSub db sub' (NSASMP NSASmpKey)
                 lift . void $ getNtfSMPWorker True c smpServer
     NSCDelete -> do
       sub_ <- withStore' c $ \db -> do
-        supervisorUpdateNtfAction db connId (NtfSubNTFAction NSADelete)
+        supervisorUpdateNtfAction db connId (NSANtf NSADelete)
         getNtfSubscription db connId
       logInfo $ "processNtfSub, NSCDelete - sub_ = " <> tshow sub_
       case sub_ of
@@ -126,7 +127,7 @@ processNtfSub c (connId, cmd) = do
       withStore' c (`getPrimaryRcvQueue` connId) >>= \case
         Right rq@RcvQueue {server = smpServer} -> do
           logInfo $ "processNtfSub, NSCSmpDelete - rq = " <> tshow rq
-          withStore' c $ \db -> supervisorUpdateNtfAction db connId (NtfSubSMPAction NSASmpDelete)
+          withStore' c $ \db -> supervisorUpdateNtfAction db connId (NSASMP NSASmpDelete)
           lift . void $ getNtfSMPWorker True c smpServer
         _ -> notifyInternalError c connId "NSCSmpDelete - no rcv queue"
     NSCNtfWorker ntfServer -> lift . void $ getNtfNTFWorker True c ntfServer
@@ -146,12 +147,10 @@ withTokenServer :: (NtfServer -> AM ()) -> AM ()
 withTokenServer action = lift getNtfToken >>= mapM_ (\NtfToken {ntfServer} -> action ntfServer)
 
 runNtfWorker :: AgentClient -> NtfServer -> Worker -> AM ()
-runNtfWorker c srv Worker {doWork} = do
-  delay <- asks $ ntfWorkerDelay . config
+runNtfWorker c srv Worker {doWork} =
   forever $ do
     waitForWork doWork
     ExceptT $ agentOperationBracket c AONtfNetwork throwWhenInactive $ runExceptT runNtfOperation
-    threadDelay delay
   where
     runNtfOperation :: AM ()
     runNtfOperation =
@@ -164,66 +163,68 @@ runNtfWorker c srv Worker {doWork} = do
             processSub nextSub
               `catchAgentError` retryOnError c "NtfWorker" loop (workerInternalError c connId . show)
     processSub :: (NtfSubscription, NtfSubNTFAction, NtfActionTs) -> AM ()
-    processSub (sub@NtfSubscription {connId, smpServer, ntfSubId}, action, actionTs) = do
+    processSub (sub@NtfSubscription {userId, connId, smpServer, ntfSubId}, action, actionTs) = do
       ts <- liftIO getCurrentTime
       unlessM (lift $ rescheduleAction doWork ts actionTs) $
         case action of
           NSACreate ->
             lift getNtfToken >>= \case
-              Just tkn@NtfToken {ntfTokenId = Just tknId, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
+              Just tkn@NtfToken {ntfServer, ntfTokenId = Just tknId, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
                 RcvQueue {clientNtfCreds} <- withStore c (`getPrimaryRcvQueue` connId)
                 case clientNtfCreds of
                   Just ClientNtfCreds {ntfPrivateKey, notifierId} -> do
+                    atomically $ incNtfServerStat c userId ntfServer ntfCreateAttempts
                     nSubId <- agentNtfCreateSubscription c tknId tkn (SMPQueueNtf smpServer notifierId) ntfPrivateKey
+                    atomically $ incNtfServerStat c userId ntfServer ntfCreated
                     -- possible improvement: smaller retry until Active, less frequently (daily?) once Active
                     let actionTs' = addUTCTime 30 ts
                     withStore' c $ \db ->
-                      updateNtfSubscription db sub {ntfSubId = Just nSubId, ntfSubStatus = NASCreated NSNew} (NtfSubNTFAction NSACheck) actionTs'
+                      updateNtfSubscription db sub {ntfSubId = Just nSubId, ntfSubStatus = NASCreated NSNew} (NSANtf NSACheck) actionTs'
                   _ -> workerInternalError c connId "NSACreate - no notifier queue credentials"
               _ -> workerInternalError c connId "NSACreate - no active token"
           NSACheck ->
             lift getNtfToken >>= \case
-              Just tkn ->
+              Just tkn@NtfToken {ntfServer} ->
                 case ntfSubId of
-                  Just nSubId ->
+                  Just nSubId -> do
+                    atomically $ incNtfServerStat c userId ntfServer ntfCheckAttempts
                     agentNtfCheckSubscription c nSubId tkn >>= \case
                       NSAuth -> do
-                        lift (getNtfServer c) >>= \case
-                          Just ntfServer -> do
-                            withStore' c $ \db ->
-                              updateNtfSubscription db sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew} (NtfSubSMPAction NSASmpKey) ts
-                            ns <- asks ntfSupervisor
-                            atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
-                          _ -> workerInternalError c connId "NSACheck - failed to reset subscription, notification server not configured"
+                        withStore' c $ \db ->
+                          updateNtfSubscription db sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew} (NSASMP NSASmpKey) ts
+                        ns <- asks ntfSupervisor
+                        atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
                       status -> updateSubNextCheck ts status
+                    atomically $ incNtfServerStat c userId ntfServer ntfChecked
                   Nothing -> workerInternalError c connId "NSACheck - no subscription ID"
               _ -> workerInternalError c connId "NSACheck - no active token"
-          NSADelete -> case ntfSubId of
-            Just nSubId ->
-              (lift getNtfToken >>= mapM_ (agentNtfDeleteSubscription c nSubId))
-                `agentFinally` continueDeletion
-            _ -> continueDeletion
-            where
-              continueDeletion = do
-                let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
-                withStore' c $ \db -> updateNtfSubscription db sub' (NtfSubSMPAction NSASmpDelete) ts
-                ns <- asks ntfSupervisor
-                atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
-          NSARotate -> case ntfSubId of
-            Just nSubId ->
-              (lift getNtfToken >>= mapM_ (agentNtfDeleteSubscription c nSubId))
-                `agentFinally` deleteCreate
-            _ -> deleteCreate
-            where
-              deleteCreate = do
-                withStore' c $ \db -> deleteNtfSubscription db connId
-                ns <- asks ntfSupervisor
-                atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCCreate)
+          NSADelete ->
+            deleteNtfSub $ do
+              let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
+              withStore' c $ \db -> updateNtfSubscription db sub' (NSASMP NSASmpDelete) ts
+              ns <- asks ntfSupervisor
+              atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
+          NSARotate ->
+            deleteNtfSub $ do
+              withStore' c $ \db -> deleteNtfSubscription db connId
+              ns <- asks ntfSupervisor
+              atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCCreate)
       where
+        deleteNtfSub continue = case ntfSubId of
+          Just nSubId ->
+            lift getNtfToken >>= \case
+              Just tkn@NtfToken {ntfServer} -> do
+                atomically $ incNtfServerStat c userId ntfServer ntfDelAttempts
+                tryAgentError (agentNtfDeleteSubscription c nSubId tkn) >>= \case
+                  Left e | temporaryOrHostError e -> throwE e
+                  _ -> continue
+                atomically $ incNtfServerStat c userId ntfServer ntfDeleted
+              Nothing -> continue
+          _ -> continue
         updateSubNextCheck ts toStatus = do
           checkInterval <- asks $ ntfSubCheckInterval . config
           let nextCheckTs = addUTCTime checkInterval ts
-          updateSub (NASCreated toStatus) (NtfSubNTFAction NSACheck) nextCheckTs
+          updateSub (NASCreated toStatus) (NSANtf NSACheck) nextCheckTs
         updateSub toStatus toAction actionTs' =
           withStore' c $ \db ->
             updateNtfSubscription db sub {ntfSubStatus = toStatus} toAction actionTs'
@@ -231,12 +232,10 @@ runNtfWorker c srv Worker {doWork} = do
 runNtfSMPWorker :: AgentClient -> SMPServer -> Worker -> AM ()
 runNtfSMPWorker c srv Worker {doWork} = do
   env <- ask
-  delay <- asks $ ntfSMPWorkerDelay . config
   forever $ do
     waitForWork doWork
     ExceptT . liftIO . agentOperationBracket c AONtfNetwork throwWhenInactive $
       runReaderT (runExceptT runNtfSMPOperation) env
-    threadDelay delay
   where
     runNtfSMPOperation =
       withWork c doWork (`getNextNtfSubSMPAction` srv) $
@@ -264,11 +263,12 @@ runNtfSMPWorker c srv Worker {doWork} = do
                 let rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
                 withStore' c $ \db -> do
                   setRcvQueueNtfCreds db connId $ Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
-                  updateNtfSubscription db sub {ntfQueueId = Just notifierId, ntfSubStatus = NASKey} (NtfSubNTFAction NSACreate) ts
+                  updateNtfSubscription db sub {ntfQueueId = Just notifierId, ntfSubStatus = NASKey} (NSANtf NSACreate) ts
                 ns <- asks ntfSupervisor
                 atomically $ sendNtfSubCommand ns (connId, NSCNtfWorker ntfServer)
               _ -> workerInternalError c connId "NSASmpKey - no active token"
           NSASmpDelete -> do
+            -- TODO should we remove it after successful removal from the server?
             rq_ <- withStore' c $ \db -> do
               setRcvQueueNtfCreds db connId Nothing
               getPrimaryRcvQueue db connId
diff --git a/src/Simplex/Messaging/Agent/Stats.hs b/src/Simplex/Messaging/Agent/Stats.hs
index 424052d74..d4663bfb1 100644
--- a/src/Simplex/Messaging/Agent/Stats.hs
+++ b/src/Simplex/Messaging/Agent/Stats.hs
@@ -1,17 +1,20 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Simplex.Messaging.Agent.Stats where
 
+import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..))
 import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
-import Data.Map (Map)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Agent.Protocol (UserId)
 import Simplex.Messaging.Parsers (defaultJSON, fromTextField_)
-import Simplex.Messaging.Protocol (SMPServer, XFTPServer)
+import Simplex.Messaging.Protocol (SMPServer, XFTPServer, NtfServer)
 import Simplex.Messaging.Util (decodeJSON, encodeJSON)
 import UnliftIO.STM
 
@@ -44,7 +47,12 @@ data AgentSMPServerStats = AgentSMPServerStats
     connSubscribed :: TVar Int, -- total successful subscription
     connSubAttempts :: TVar Int, -- subscription attempts
     connSubIgnored :: TVar Int, -- subscription results ignored (client switched to different session or it was not pending)
-    connSubErrs :: TVar Int -- permanent subscription errors (temporary accounted for in attempts)
+    connSubErrs :: TVar Int, -- permanent subscription errors (temporary accounted for in attempts)
+    -- notifications stats
+    ntfKey :: TVar Int,
+    ntfKeyAttempts :: TVar Int,
+    ntfKeyDeleted :: TVar Int,
+    ntfKeyDeleteAttempts :: TVar Int
   }
 
 data AgentSMPServerStatsData = AgentSMPServerStatsData
@@ -75,10 +83,17 @@ data AgentSMPServerStatsData = AgentSMPServerStatsData
     _connSubscribed :: Int,
     _connSubAttempts :: Int,
     _connSubIgnored :: Int,
-    _connSubErrs :: Int
+    _connSubErrs :: Int,
+    _ntfKey :: OptionalInt,
+    _ntfKeyAttempts :: OptionalInt,
+    _ntfKeyDeleted :: OptionalInt,
+    _ntfKeyDeleteAttempts :: OptionalInt
   }
   deriving (Show)
 
+newtype OptionalInt = OInt {toInt :: Int}
+  deriving (Num, Show, ToJSON)
+
 newAgentSMPServerStats :: STM AgentSMPServerStats
 newAgentSMPServerStats = do
   sentDirect <- newTVar 0
@@ -109,6 +124,10 @@ newAgentSMPServerStats = do
   connSubAttempts <- newTVar 0
   connSubIgnored <- newTVar 0
   connSubErrs <- newTVar 0
+  ntfKey <- newTVar 0
+  ntfKeyAttempts <- newTVar 0
+  ntfKeyDeleted <- newTVar 0
+  ntfKeyDeleteAttempts <- newTVar 0
   pure
     AgentSMPServerStats
       { sentDirect,
@@ -138,7 +157,11 @@ newAgentSMPServerStats = do
         connSubscribed,
         connSubAttempts,
         connSubIgnored,
-        connSubErrs
+        connSubErrs,
+        ntfKey,
+        ntfKeyAttempts,
+        ntfKeyDeleted,
+        ntfKeyDeleteAttempts
       }
 
 newAgentSMPServerStatsData :: AgentSMPServerStatsData
@@ -171,7 +194,11 @@ newAgentSMPServerStatsData =
       _connSubscribed = 0,
       _connSubAttempts = 0,
       _connSubIgnored = 0,
-      _connSubErrs = 0
+      _connSubErrs = 0,
+      _ntfKey = 0,
+      _ntfKeyAttempts = 0,
+      _ntfKeyDeleted = 0,
+      _ntfKeyDeleteAttempts = 0
     }
 
 newAgentSMPServerStats' :: AgentSMPServerStatsData -> STM AgentSMPServerStats
@@ -204,6 +231,10 @@ newAgentSMPServerStats' s = do
   connSubAttempts <- newTVar $ _connSubAttempts s
   connSubIgnored <- newTVar $ _connSubIgnored s
   connSubErrs <- newTVar $ _connSubErrs s
+  ntfKey <- newTVar $ toInt $ _ntfKey s
+  ntfKeyAttempts <- newTVar $ toInt $ _ntfKeyAttempts s
+  ntfKeyDeleted <- newTVar $ toInt $ _ntfKeyDeleted s
+  ntfKeyDeleteAttempts <- newTVar $ toInt $ _ntfKeyDeleteAttempts s
   pure
     AgentSMPServerStats
       { sentDirect,
@@ -233,7 +264,11 @@ newAgentSMPServerStats' s = do
         connSubscribed,
         connSubAttempts,
         connSubIgnored,
-        connSubErrs
+        connSubErrs,
+        ntfKey,
+        ntfKeyAttempts,
+        ntfKeyDeleted,
+        ntfKeyDeleteAttempts
       }
 
 -- as this is used to periodically update stats in db,
@@ -268,6 +303,10 @@ getAgentSMPServerStats s = do
   _connSubAttempts <- readTVarIO $ connSubAttempts s
   _connSubIgnored <- readTVarIO $ connSubIgnored s
   _connSubErrs <- readTVarIO $ connSubErrs s
+  _ntfKey <- OInt <$> readTVarIO (ntfKey s)
+  _ntfKeyAttempts <- OInt <$> readTVarIO (ntfKeyAttempts s)
+  _ntfKeyDeleted <- OInt <$> readTVarIO (ntfKeyDeleted s)
+  _ntfKeyDeleteAttempts <- OInt <$> readTVarIO (ntfKeyDeleteAttempts s)
   pure
     AgentSMPServerStatsData
       { _sentDirect,
@@ -297,7 +336,11 @@ getAgentSMPServerStats s = do
         _connSubscribed,
         _connSubAttempts,
         _connSubIgnored,
-        _connSubErrs
+        _connSubErrs,
+        _ntfKey,
+        _ntfKeyAttempts,
+        _ntfKeyDeleted,
+        _ntfKeyDeleteAttempts
       }
 
 addSMPStatsData :: AgentSMPServerStatsData -> AgentSMPServerStatsData -> AgentSMPServerStatsData
@@ -330,7 +373,11 @@ addSMPStatsData sd1 sd2 =
       _connSubscribed = _connSubscribed sd1 + _connSubscribed sd2,
       _connSubAttempts = _connSubAttempts sd1 + _connSubAttempts sd2,
       _connSubIgnored = _connSubIgnored sd1 + _connSubIgnored sd2,
-      _connSubErrs = _connSubErrs sd1 + _connSubErrs sd2
+      _connSubErrs = _connSubErrs sd1 + _connSubErrs sd2,
+      _ntfKey = _ntfKey sd1 + _ntfKey sd2,
+      _ntfKeyAttempts = _ntfKeyAttempts sd1 + _ntfKeyAttempts sd2,
+      _ntfKeyDeleted = _ntfKeyDeleted sd1 + _ntfKeyDeleted sd2,
+      _ntfKeyDeleteAttempts = _ntfKeyDeleteAttempts sd1 + _ntfKeyDeleteAttempts sd2
     }
 
 data AgentXFTPServerStats = AgentXFTPServerStats
@@ -490,18 +537,127 @@ addXFTPStatsData sd1 sd2 =
       _deleteErrs = _deleteErrs sd1 + _deleteErrs sd2
     }
 
+data AgentNtfServerStats = AgentNtfServerStats
+  { ntfCreated :: TVar Int,
+    ntfCreateAttempts :: TVar Int,
+    ntfChecked :: TVar Int,
+    ntfCheckAttempts :: TVar Int,
+    ntfDeleted :: TVar Int,
+    ntfDelAttempts :: TVar Int
+  }
+
+data AgentNtfServerStatsData = AgentNtfServerStatsData
+  { _ntfCreated :: Int,
+    _ntfCreateAttempts :: Int,
+    _ntfChecked :: Int,
+    _ntfCheckAttempts :: Int,
+    _ntfDeleted :: Int,
+    _ntfDelAttempts :: Int
+  }
+  deriving (Show)
+
+newAgentNtfServerStats :: STM AgentNtfServerStats
+newAgentNtfServerStats = do
+  ntfCreated <- newTVar 0
+  ntfCreateAttempts <- newTVar 0
+  ntfChecked <- newTVar 0
+  ntfCheckAttempts <- newTVar 0
+  ntfDeleted <- newTVar 0
+  ntfDelAttempts <- newTVar 0
+  pure
+    AgentNtfServerStats
+      { ntfCreated,
+        ntfCreateAttempts,
+        ntfChecked,
+        ntfCheckAttempts,
+        ntfDeleted,
+        ntfDelAttempts
+      }
+
+newAgentNtfServerStatsData :: AgentNtfServerStatsData
+newAgentNtfServerStatsData =
+  AgentNtfServerStatsData
+    { _ntfCreated = 0,
+      _ntfCreateAttempts = 0,
+      _ntfChecked = 0,
+      _ntfCheckAttempts = 0,
+      _ntfDeleted = 0,
+      _ntfDelAttempts = 0
+    }
+
+newAgentNtfServerStats' :: AgentNtfServerStatsData -> STM AgentNtfServerStats
+newAgentNtfServerStats' s = do
+  ntfCreated <- newTVar $ _ntfCreated s
+  ntfCreateAttempts <- newTVar $ _ntfCreateAttempts s
+  ntfChecked <- newTVar $ _ntfChecked s
+  ntfCheckAttempts <- newTVar $ _ntfCheckAttempts s
+  ntfDeleted <- newTVar $ _ntfDeleted s
+  ntfDelAttempts <- newTVar $ _ntfDelAttempts s
+  pure
+    AgentNtfServerStats
+      { ntfCreated,
+        ntfCreateAttempts,
+        ntfChecked,
+        ntfCheckAttempts,
+        ntfDeleted,
+        ntfDelAttempts
+      }
+
+getAgentNtfServerStats :: AgentNtfServerStats -> IO AgentNtfServerStatsData
+getAgentNtfServerStats s = do
+  _ntfCreated <- readTVarIO $ ntfCreated s
+  _ntfCreateAttempts <- readTVarIO $ ntfCreateAttempts s
+  _ntfChecked <- readTVarIO $ ntfChecked s
+  _ntfCheckAttempts <- readTVarIO $ ntfCheckAttempts s
+  _ntfDeleted <- readTVarIO $ ntfDeleted s
+  _ntfDelAttempts <- readTVarIO $ ntfDelAttempts s
+  pure
+    AgentNtfServerStatsData
+      { _ntfCreated,
+        _ntfCreateAttempts,
+        _ntfChecked,
+        _ntfCheckAttempts,
+        _ntfDeleted,
+        _ntfDelAttempts
+      }
+
+addNtfStatsData :: AgentNtfServerStatsData -> AgentNtfServerStatsData -> AgentNtfServerStatsData
+addNtfStatsData sd1 sd2 =
+  AgentNtfServerStatsData
+    { _ntfCreated = _ntfCreated sd1 + _ntfCreated sd2,
+      _ntfCreateAttempts = _ntfCreateAttempts sd1 + _ntfCreateAttempts sd2,
+      _ntfChecked = _ntfChecked sd1 + _ntfChecked sd2,
+      _ntfCheckAttempts = _ntfCheckAttempts sd1 + _ntfCheckAttempts sd2,
+      _ntfDeleted = _ntfDeleted sd1 + _ntfDeleted sd2,
+      _ntfDelAttempts = _ntfDelAttempts sd1 + _ntfDelAttempts sd2
+    }
+
 -- Type for gathering both smp and xftp stats across all users and servers,
 -- to then be persisted to db as a single json.
 data AgentPersistedServerStats = AgentPersistedServerStats
   { smpServersStats :: Map (UserId, SMPServer) AgentSMPServerStatsData,
-    xftpServersStats :: Map (UserId, XFTPServer) AgentXFTPServerStatsData
+    xftpServersStats :: Map (UserId, XFTPServer) AgentXFTPServerStatsData,
+    ntfServersStats :: OptionalMap (UserId, NtfServer) AgentNtfServerStatsData
   }
   deriving (Show)
 
+instance FromJSON OptionalInt where
+  parseJSON v = OInt <$> parseJSON v
+  omittedField = Just (OInt 0)
+
+newtype OptionalMap k v = OptionalMap (Map k v)
+  deriving (Show, ToJSON)
+
+instance (FromJSONKey k, Ord k, FromJSON v) => FromJSON (OptionalMap k v) where
+  parseJSON v = OptionalMap <$> parseJSON v
+  omittedField = Just (OptionalMap M.empty)
+
 $(J.deriveJSON defaultJSON ''AgentSMPServerStatsData)
 
 $(J.deriveJSON defaultJSON ''AgentXFTPServerStatsData)
 
+$(J.deriveJSON defaultJSON ''AgentNtfServerStatsData)
+
 $(J.deriveJSON defaultJSON ''AgentPersistedServerStats)
 
 instance ToField AgentPersistedServerStats where
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 0727343e7..574137883 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -1457,23 +1457,24 @@ getNtfSubscription db connId =
     DB.query
       db
       [sql|
-        SELECT s.host, s.port, COALESCE(nsb.smp_server_key_hash, s.key_hash), ns.ntf_host, ns.ntf_port, ns.ntf_key_hash,
+        SELECT c.user_id, s.host, s.port, COALESCE(nsb.smp_server_key_hash, s.key_hash), ns.ntf_host, ns.ntf_port, ns.ntf_key_hash,
           nsb.smp_ntf_id, nsb.ntf_sub_id, nsb.ntf_sub_status, nsb.ntf_sub_action, nsb.ntf_sub_smp_action, nsb.ntf_sub_action_ts
         FROM ntf_subscriptions nsb
+        JOIN connections c USING (conn_id)
         JOIN servers s ON s.host = nsb.smp_host AND s.port = nsb.smp_port
         JOIN ntf_servers ns USING (ntf_host, ntf_port)
         WHERE nsb.conn_id = ?
       |]
       (Only connId)
   where
-    ntfSubscription (smpHost, smpPort, smpKeyHash, ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, ntfAction_, smpAction_, actionTs_) =
+    ntfSubscription ((userId, smpHost, smpPort, smpKeyHash, ntfHost, ntfPort, ntfKeyHash ) :. (ntfQueueId, ntfSubId, ntfSubStatus, ntfAction_, smpAction_, actionTs_)) =
       let smpServer = SMPServer smpHost smpPort smpKeyHash
           ntfServer = NtfServer ntfHost ntfPort ntfKeyHash
           action = case (ntfAction_, smpAction_, actionTs_) of
-            (Just ntfAction, Nothing, Just actionTs) -> Just (NtfSubNTFAction ntfAction, actionTs)
-            (Nothing, Just smpAction, Just actionTs) -> Just (NtfSubSMPAction smpAction, actionTs)
+            (Just ntfAction, Nothing, Just actionTs) -> Just (NSANtf ntfAction, actionTs)
+            (Nothing, Just smpAction, Just actionTs) -> Just (NSASMP smpAction, actionTs)
             _ -> Nothing
-       in (NtfSubscription {connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}, action)
+       in (NtfSubscription {userId, connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}, action)
 
 createNtfSubscription :: DB.Connection -> NtfSubscription -> NtfSubAction -> IO (Either StoreError ())
 createNtfSubscription db ntfSubscription action = runExceptT $ do
@@ -1607,18 +1608,19 @@ getNextNtfSubNTFAction db ntfServer@(NtfServer ntfHost ntfPort _) =
         DB.query
           db
           [sql|
-            SELECT s.host, s.port, COALESCE(ns.smp_server_key_hash, s.key_hash),
+            SELECT c.user_id, s.host, s.port, COALESCE(ns.smp_server_key_hash, s.key_hash),
               ns.smp_ntf_id, ns.ntf_sub_id, ns.ntf_sub_status, ns.ntf_sub_action_ts, ns.ntf_sub_action
             FROM ntf_subscriptions ns
+            JOIN connections c USING (conn_id)
             JOIN servers s ON s.host = ns.smp_host AND s.port = ns.smp_port
             WHERE ns.conn_id = ?
           |]
           (Only connId)
       where
         err = SEInternal $ "ntf subscription " <> bshow connId <> " returned []"
-        ntfSubAction (smpHost, smpPort, smpKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
+        ntfSubAction (userId, smpHost, smpPort, smpKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
           let smpServer = SMPServer smpHost smpPort smpKeyHash
-              ntfSubscription = NtfSubscription {connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
+              ntfSubscription = NtfSubscription {userId, connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
            in (ntfSubscription, action, actionTs)
 
 markNtfSubActionNtfFailed_ :: DB.Connection -> ConnId -> IO ()
@@ -1650,18 +1652,19 @@ getNextNtfSubSMPAction db smpServer@(SMPServer smpHost smpPort _) =
         DB.query
           db
           [sql|
-            SELECT s.ntf_host, s.ntf_port, s.ntf_key_hash,
+            SELECT c.user_id, s.ntf_host, s.ntf_port, s.ntf_key_hash,
               ns.smp_ntf_id, ns.ntf_sub_id, ns.ntf_sub_status, ns.ntf_sub_action_ts, ns.ntf_sub_smp_action
             FROM ntf_subscriptions ns
+            JOIN connections c USING (conn_id)
             JOIN ntf_servers s USING (ntf_host, ntf_port)
             WHERE ns.conn_id = ?
           |]
           (Only connId)
       where
         err = SEInternal $ "ntf subscription " <> bshow connId <> " returned []"
-        ntfSubAction (ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
+        ntfSubAction (userId, ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
           let ntfServer = NtfServer ntfHost ntfPort ntfKeyHash
-              ntfSubscription = NtfSubscription {connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
+              ntfSubscription = NtfSubscription {userId, connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
            in (ntfSubscription, action, actionTs)
 
 markNtfSubActionSMPFailed_ :: DB.Connection -> ConnId -> IO ()
@@ -2272,8 +2275,8 @@ randomId :: TVar ChaChaDRG -> Int -> IO ByteString
 randomId gVar n = atomically $ U.encode <$> C.randomBytes n gVar
 
 ntfSubAndSMPAction :: NtfSubAction -> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction)
-ntfSubAndSMPAction (NtfSubNTFAction action) = (Just action, Nothing)
-ntfSubAndSMPAction (NtfSubSMPAction action) = (Nothing, Just action)
+ntfSubAndSMPAction (NSANtf action) = (Just action, Nothing)
+ntfSubAndSMPAction (NSASMP action) = (Nothing, Just action)
 
 createXFTPServer_ :: DB.Connection -> XFTPServer -> IO Int64
 createXFTPServer_ db newSrv@ProtocolServer {host, port, keyHash} =
diff --git a/src/Simplex/Messaging/Notifications/Types.hs b/src/Simplex/Messaging/Notifications/Types.hs
index 4465f8767..97f9e6bdd 100644
--- a/src/Simplex/Messaging/Notifications/Types.hs
+++ b/src/Simplex/Messaging/Notifications/Types.hs
@@ -11,7 +11,7 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time (UTCTime)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import Simplex.Messaging.Agent.Protocol (ConnId, NotificationsMode (..))
+import Simplex.Messaging.Agent.Protocol (UserId, ConnId, NotificationsMode (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol
@@ -79,17 +79,17 @@ newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys ntfMode =
       ntfMode
     }
 
-data NtfSubAction = NtfSubNTFAction NtfSubNTFAction | NtfSubSMPAction NtfSubSMPAction
+data NtfSubAction = NSANtf NtfSubNTFAction | NSASMP NtfSubSMPAction
   deriving (Show)
 
 isDeleteNtfSubAction :: NtfSubAction -> Bool
 isDeleteNtfSubAction = \case
-  NtfSubNTFAction a -> case a of
+  NSANtf a -> case a of
     NSACreate -> False
     NSACheck -> False
     NSADelete -> True
     NSARotate -> True
-  NtfSubSMPAction a -> case a of
+  NSASMP a -> case a of
     NSASmpKey -> False
     NSASmpDelete -> True
 
@@ -177,7 +177,8 @@ instance FromField NtfAgentSubStatus where fromField = fromTextField_ $ either (
 instance ToField NtfAgentSubStatus where toField = toField . decodeLatin1 . smpEncode
 
 data NtfSubscription = NtfSubscription
-  { connId :: ConnId,
+  { userId :: UserId,
+    connId :: ConnId,
     smpServer :: SMPServer,
     ntfQueueId :: Maybe NotifierId,
     ntfServer :: NtfServer,
@@ -186,10 +187,11 @@ data NtfSubscription = NtfSubscription
   }
   deriving (Show)
 
-newNtfSubscription :: ConnId -> SMPServer -> Maybe NotifierId -> NtfServer -> NtfAgentSubStatus -> NtfSubscription
-newNtfSubscription connId smpServer ntfQueueId ntfServer ntfSubStatus =
+newNtfSubscription :: UserId -> ConnId -> SMPServer -> Maybe NotifierId -> NtfServer -> NtfAgentSubStatus -> NtfSubscription
+newNtfSubscription userId connId smpServer ntfQueueId ntfServer ntfSubStatus =
   NtfSubscription
-    { connId,
+    { userId,
+      connId,
       smpServer,
       ntfQueueId,
       ntfServer,
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 41ed8c730..cc79faeca 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -511,7 +511,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
 
   -- aliceNtf client doesn't have subscription and is allowed to get notification message
   withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do
-    (_, [SMPMsgMeta {msgFlags = MsgFlags True}]) <- getNotificationMessage aliceNtf nonce message
+    (_, Just SMPMsgMeta {msgFlags = MsgFlags True}) <- getNotificationMessage aliceNtf nonce message
     pure ()
 
   threadDelay 1000000
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index e0de57466..0bb050cbe 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -72,8 +72,6 @@ agentCfg =
       ntfCfg = defaultNTFClientConfig {qSize = 1, defaultTransport = (ntfTestPort, transport @TLS), networkConfig},
       reconnectInterval = fastRetryInterval,
       persistErrorInterval = 1,
-      ntfWorkerDelay = 100,
-      ntfSMPWorkerDelay = 100,
       caCertificateFile = "tests/fixtures/ca.crt",
       privateKeyFile = "tests/fixtures/server.key",
       certificateFile = "tests/fixtures/server.crt"

From c605156302b78a8411a1a083c52e7d5506f11f9c Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Mon, 22 Jul 2024 18:43:38 +0400
Subject: [PATCH 048/195] agent: getAgentSubsTotal api (#1238)

* agent: getAgentSubsTotal api

* move

* export

* count sessions

* simplify

* simplify 2

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
---
 src/Simplex/Messaging/Agent.hs        |  1 +
 src/Simplex/Messaging/Agent/Client.hs | 18 ++++++++++++++++++
 2 files changed, 19 insertions(+)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index f26c46925..0bd95d1dc 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -106,6 +106,7 @@ module Simplex.Messaging.Agent
     rcConnectHost,
     rcConnectCtrl,
     rcDiscoverCtrl,
+    getAgentSubsTotal,
     getAgentServersSummary,
     resetAgentServersStats,
     foregroundAgent,
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 3a7616499..8aacd8836 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -93,6 +93,7 @@ module Simplex.Messaging.Agent.Client
     AgentServersSummary (..),
     ServerSessions (..),
     SMPServerSubs (..),
+    getAgentSubsTotal,
     getAgentServersSummary,
     getAgentSubscriptions,
     slowNetworkConfig,
@@ -2017,6 +2018,23 @@ data ServerSessions = ServerSessions
   }
   deriving (Show)
 
+getAgentSubsTotal :: AgentClient -> [UserId] -> IO (SMPServerSubs, Bool)
+getAgentSubsTotal c userIds = do
+  ssActive <- getSubsCount activeSubs
+  ssPending <- getSubsCount pendingSubs
+  sess <- hasSession . M.toList =<< readTVarIO (smpClients c)
+  pure (SMPServerSubs {ssActive, ssPending}, sess)
+  where
+    getSubsCount subs = M.foldrWithKey' addSub 0 <$> readTVarIO (getRcvQueues $ subs c)
+    addSub (userId, _, _) _ cnt = if userId `elem` userIds then cnt + 1 else cnt
+    hasSession :: [(SMPTransportSession, SMPClientVar)] -> IO Bool
+    hasSession = \case
+      [] -> pure False
+      (s : ss) -> ifM (isConnected s) (pure True) (hasSession ss)
+    isConnected ((userId, _, _), SessionVar {sessionVar})
+      | userId `elem` userIds = atomically $ maybe False isRight <$> tryReadTMVar sessionVar
+      | otherwise = pure False
+
 getAgentServersSummary :: AgentClient -> IO AgentServersSummary
 getAgentServersSummary c@AgentClient {smpServersStats, xftpServersStats, ntfServersStats, srvStatsStartedAt, agentEnv} = do
   sss <- mapM getAgentSMPServerStats =<< readTVarIO smpServersStats

From 47ae921b86e70d3dbbad059e860e36f2a0ad312a Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 23 Jul 2024 08:27:54 +0100
Subject: [PATCH 049/195] use strict Map (#1241)

---
 src/Simplex/FileTransfer/Agent.hs         | 2 +-
 src/Simplex/FileTransfer/Client/Main.hs   | 2 +-
 src/Simplex/FileTransfer/Description.hs   | 2 +-
 src/Simplex/Messaging/Agent/Env/SQLite.hs | 2 +-
 src/Simplex/Messaging/Agent/Protocol.hs   | 4 ++--
 5 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 725444086..8ca537e53 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -43,7 +43,7 @@ import Data.Either (partitionEithers, rights)
 import Data.Int (Int64)
 import Data.List (foldl', partition, sortOn)
 import qualified Data.List.NonEmpty as L
-import Data.Map (Map)
+import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (mapMaybe)
 import qualified Data.Set as S
diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs
index aeac956e6..fee44832a 100644
--- a/src/Simplex/FileTransfer/Client/Main.hs
+++ b/src/Simplex/FileTransfer/Client/Main.hs
@@ -43,7 +43,7 @@ import Data.Int (Int64)
 import Data.List (foldl', sortOn)
 import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
 import qualified Data.List.NonEmpty as L
-import Data.Map (Map)
+import Data.Map.Strict (Map)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, listToMaybe)
 import qualified Data.Text as T
diff --git a/src/Simplex/FileTransfer/Description.hs b/src/Simplex/FileTransfer/Description.hs
index d5b5e5105..c702a177f 100644
--- a/src/Simplex/FileTransfer/Description.hs
+++ b/src/Simplex/FileTransfer/Description.hs
@@ -52,7 +52,7 @@ import Data.Int (Int64)
 import Data.List (foldl', sortOn)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
-import Data.Map (Map)
+import Data.Map.Strict (Map)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 import Data.String
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index d21d0fb5e..6932764c3 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -51,7 +51,7 @@ import Data.ByteArray (ScrubbedBytes)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
-import Data.Map (Map)
+import Data.Map.Strict (Map)
 import Data.Maybe (fromMaybe)
 import Data.Time.Clock (NominalDiffTime, nominalDay)
 import Data.Time.Clock.System (SystemTime (..))
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index ca9737008..ea1d51a7d 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -155,8 +155,8 @@ import Data.Int (Int64)
 import Data.Kind (Type)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
-import Data.Map (Map)
-import qualified Data.Map as M
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)

From 9093c7b120882c8686bd616ba29d23e6bd803a99 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Thu, 25 Jul 2024 13:07:28 +0100
Subject: [PATCH 050/195] agent, ntf server: only mark subscriptions as pending
 that were created by the disconnected client (#1242)

* ntf server: only mark subscriptions as pending if the disconnected client is current

* add sessionId to subscribed queue

* add sessionId to subscriptions in ntf server agent

* fix
---
 src/Simplex/Messaging/Agent.hs               |  2 +-
 src/Simplex/Messaging/Agent/Client.hs        | 33 +++++++------
 src/Simplex/Messaging/Agent/TRcvQueues.hs    | 50 ++++++++++++--------
 src/Simplex/Messaging/Client/Agent.hs        | 38 ++++++++-------
 src/Simplex/Messaging/Notifications/Types.hs |  3 +-
 src/Simplex/Messaging/Session.hs             | 13 ++---
 tests/CoreTests/TRcvQueuesTests.hs           | 41 ++++++++--------
 7 files changed, 98 insertions(+), 82 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 0bd95d1dc..7159a1324 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -2202,7 +2202,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
     processSubOk :: RcvQueue -> TVar [ConnId] -> AM ()
     processSubOk rq@RcvQueue {connId} upConnIds =
       atomically . whenM (isPendingSub connId) $ do
-        addSubscription c rq
+        addSubscription c sessId rq
         modifyTVar' upConnIds (connId :)
     processSubErr :: RcvQueue -> SMPClientError -> AM ()
     processSubErr rq@RcvQueue {connId} e = do
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 8aacd8836..55caf754c 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -306,8 +306,8 @@ data AgentClient = AgentClient
     userNetworkInfo :: TVar UserNetworkInfo,
     userNetworkUpdated :: TVar (Maybe UTCTime),
     subscrConns :: TVar (Set ConnId),
-    activeSubs :: TRcvQueues,
-    pendingSubs :: TRcvQueues,
+    activeSubs :: TRcvQueues (SessionId, RcvQueue),
+    pendingSubs :: TRcvQueues RcvQueue,
     removedSubs :: TMap (UserId, SMPServer, SMP.RecipientId) SMPClientError,
     workerSeq :: TVar Int,
     smpDeliveryWorkers :: TMap SndQAddr (Worker, TMVar ()),
@@ -332,7 +332,7 @@ data AgentClient = AgentClient
     agentEnv :: Env,
     smpServersStats :: TMap (UserId, SMPServer) AgentSMPServerStats,
     xftpServersStats :: TMap (UserId, XFTPServer) AgentXFTPServerStats,
-    ntfServersStats :: TMap  (UserId, NtfServer) AgentNtfServerStats,
+    ntfServersStats :: TMap (UserId, NtfServer) AgentNtfServerStats,
     srvStatsStartedAt :: TVar UTCTime
   }
 
@@ -677,11 +677,13 @@ smpClientDisconnected c@AgentClient {active, smpClients, smpProxiedRelays} tSess
     -- because we can have a race condition when a new current client could have already
     -- made subscriptions active, and the old client would be processing diconnection later.
     removeClientAndSubs :: IO ([RcvQueue], [ConnId])
-    removeClientAndSubs = atomically $ ifM currentActiveClient removeSubs $ pure ([], [])
+    removeClientAndSubs = atomically $ do
+      removeSessVar v tSess smpClients
+      ifM (readTVar active) removeSubs (pure ([], []))
       where
-        currentActiveClient = (&&) <$> removeSessVar' v tSess smpClients <*> readTVar active
+        sessId = sessionId $ thParams client
         removeSubs = do
-          (qs, cs) <- RQ.getDelSessQueues tSess $ activeSubs c
+          (qs, cs) <- RQ.getDelSessQueues tSess sessId $ activeSubs c
           RQ.batchAddQueues (pendingSubs c) qs
           -- this removes proxied relays that this client created sessions to
           destSrvs <- M.keys <$> readTVar prs
@@ -1347,8 +1349,8 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode sender
       qUri = SMPQueueUri vRange $ SMPQueueAddress srv sndId e2eDhKey sndSecure
   pure (rq, qUri, tSess, sessId)
 
-processSubResult :: AgentClient -> RcvQueue -> Either SMPClientError () -> STM ()
-processSubResult c rq@RcvQueue {userId, server, connId} = \case
+processSubResult :: AgentClient -> SessionId -> RcvQueue -> Either SMPClientError () -> STM ()
+processSubResult c sessId rq@RcvQueue {userId, server, connId} = \case
   Left e ->
     unless (temporaryClientError e) $ do
       incSMPServerStat c userId server connSubErrs
@@ -1356,7 +1358,7 @@ processSubResult c rq@RcvQueue {userId, server, connId} = \case
   Right () ->
     ifM
       (hasPendingSubscription c connId)
-      (incSMPServerStat c userId server connSubscribed >> addSubscription c rq)
+      (incSMPServerStat c userId server connSubscribed >> addSubscription c sessId rq)
       (incSMPServerStat c userId server connSubIgnored)
 
 temporaryAgentError :: AgentErrorType -> Bool
@@ -1427,7 +1429,7 @@ subscribeQueues c qs = do
         sessId = sessionId $ thParams smp
         hasTempErrors = any (either temporaryClientError (const False) . snd)
         processSubResults :: NonEmpty (RcvQueue, Either SMPClientError ()) -> STM ()
-        processSubResults = mapM_ $ uncurry $ processSubResult c
+        processSubResults = mapM_ $ uncurry $ processSubResult c sessId
         resubscribe = resubscribeSMPSession c tSess `runReaderT` env
 
 activeClientSession :: AgentClient -> SMPTransportSession -> SessionId -> STM Bool
@@ -1466,10 +1468,10 @@ sendBatch smpCmdFunc smp qs = L.zip qs <$> smpCmdFunc smp (L.map queueCreds qs)
   where
     queueCreds RcvQueue {rcvPrivateKey, rcvId} = (rcvPrivateKey, rcvId)
 
-addSubscription :: AgentClient -> RcvQueue -> STM ()
-addSubscription c rq@RcvQueue {connId} = do
+addSubscription :: AgentClient -> SessionId -> RcvQueue -> STM ()
+addSubscription c sessId rq@RcvQueue {connId} = do
   modifyTVar' (subscrConns c) $ S.insert connId
-  RQ.addQueue rq $ activeSubs c
+  RQ.addQueue (sessId, rq) $ activeSubs c
   RQ.deleteQueue rq $ pendingSubs c
 
 failSubscription :: AgentClient -> RcvQueue -> SMPClientError -> STM ()
@@ -1488,7 +1490,7 @@ addNewQueueSubscription c rq tSess sessId = do
     atomically $
       ifM
         (activeClientSession c tSess sessId)
-        (True <$ addSubscription c rq)
+        (True <$ addSubscription c sessId rq)
         (False <$ addPendingSubscription c rq)
   unless same $ resubscribeSMPSession c tSess
 
@@ -2025,7 +2027,9 @@ getAgentSubsTotal c userIds = do
   sess <- hasSession . M.toList =<< readTVarIO (smpClients c)
   pure (SMPServerSubs {ssActive, ssPending}, sess)
   where
+    getSubsCount :: (AgentClient -> TRcvQueues q) -> IO Int
     getSubsCount subs = M.foldrWithKey' addSub 0 <$> readTVarIO (getRcvQueues $ subs c)
+    addSub :: (UserId, SMPServer, SMP.RecipientId) -> q -> Int -> Int
     addSub (userId, _, _) _ cnt = if userId `elem` userIds then cnt + 1 else cnt
     hasSession :: [(SMPTransportSession, SMPClientVar)] -> IO Bool
     hasSession = \case
@@ -2106,6 +2110,7 @@ getAgentSubscriptions c = do
   removedSubscriptions <- getRemovedSubs
   pure $ SubscriptionsInfo {activeSubscriptions, pendingSubscriptions, removedSubscriptions}
   where
+    getSubs :: (AgentClient -> TRcvQueues q) -> IO [SubInfo]
     getSubs sel = map (`subInfo` Nothing) . M.keys <$> readTVarIO (getRcvQueues $ sel c)
     getRemovedSubs = map (uncurry subInfo . second Just) . M.assocs <$> readTVarIO (removedSubs c)
     subInfo :: (UserId, SMPServer, SMP.RecipientId) -> Maybe SMPClientError -> SubInfo
diff --git a/src/Simplex/Messaging/Agent/TRcvQueues.hs b/src/Simplex/Messaging/Agent/TRcvQueues.hs
index 9ffe325b2..10e4574cb 100644
--- a/src/Simplex/Messaging/Agent/TRcvQueues.hs
+++ b/src/Simplex/Messaging/Agent/TRcvQueues.hs
@@ -1,7 +1,9 @@
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 
 module Simplex.Messaging.Agent.TRcvQueues
   ( TRcvQueues (getRcvQueues, getConnections),
+    Queue (..),
     empty,
     clear,
     deleteConn,
@@ -11,7 +13,6 @@ module Simplex.Messaging.Agent.TRcvQueues
     deleteQueue,
     getSessQueues,
     getDelSessQueues,
-    qKey,
   )
 where
 
@@ -25,46 +26,51 @@ import Simplex.Messaging.Agent.Store (RcvQueue, StoredRcvQueue (..))
 import Simplex.Messaging.Protocol (RecipientId, SMPServer)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Transport
+
+class Queue q where
+  connId' :: q -> ConnId
+  qKey :: q -> (UserId, SMPServer, ConnId)
 
 -- the fields in this record have the same data with swapped keys for lookup efficiency,
 -- and all methods must maintain this invariant.
-data TRcvQueues = TRcvQueues
-  { getRcvQueues :: TMap (UserId, SMPServer, RecipientId) RcvQueue,
+data TRcvQueues q = TRcvQueues
+  { getRcvQueues :: TMap (UserId, SMPServer, RecipientId) q,
     getConnections :: TMap ConnId (NonEmpty (UserId, SMPServer, RecipientId))
   }
 
-empty :: STM TRcvQueues
+empty :: STM (TRcvQueues q)
 empty = TRcvQueues <$> TM.empty <*> TM.empty
 
-clear :: TRcvQueues -> STM ()
+clear :: TRcvQueues q -> STM ()
 clear (TRcvQueues qs cs) = TM.clear qs >> TM.clear cs
 
-deleteConn :: ConnId -> TRcvQueues -> STM ()
+deleteConn :: ConnId -> TRcvQueues q -> STM ()
 deleteConn cId (TRcvQueues qs cs) =
   TM.lookupDelete cId cs >>= \case
     Just ks -> modifyTVar' qs $ \qs' -> foldl' (flip M.delete) qs' ks
     Nothing -> pure ()
 
-hasConn :: ConnId -> TRcvQueues -> STM Bool
+hasConn :: ConnId -> TRcvQueues q -> STM Bool
 hasConn cId (TRcvQueues _ cs) = TM.member cId cs
 
-addQueue :: RcvQueue -> TRcvQueues -> STM ()
+addQueue :: Queue q => q -> TRcvQueues q -> STM ()
 addQueue rq (TRcvQueues qs cs) = do
   TM.insert k rq qs
-  TM.alter addQ (connId rq) cs
+  TM.alter addQ (connId' rq) cs
   where
     addQ = Just . maybe (k :| []) (k <|)
     k = qKey rq
 
 -- Save time by aggregating modifyTVar
-batchAddQueues :: Foldable t => TRcvQueues -> t RcvQueue -> STM ()
+batchAddQueues :: (Foldable t, Queue q) => TRcvQueues q -> t q -> STM ()
 batchAddQueues (TRcvQueues qs cs) rqs = do
   modifyTVar' qs $ \now -> foldl' (\rqs' rq -> M.insert (qKey rq) rq rqs') now rqs
-  modifyTVar' cs $ \now -> foldl' (\cs' rq -> M.alter (addQ $ qKey rq) (connId rq) cs') now rqs
+  modifyTVar' cs $ \now -> foldl' (\cs' rq -> M.alter (addQ $ qKey rq) (connId' rq) cs') now rqs
   where
     addQ k = Just . maybe (k :| []) (k <|)
 
-deleteQueue :: RcvQueue -> TRcvQueues -> STM ()
+deleteQueue :: RcvQueue -> TRcvQueues RcvQueue -> STM ()
 deleteQueue rq (TRcvQueues qs cs) = do
   TM.delete k qs
   TM.update delQ (connId rq) cs
@@ -72,21 +78,22 @@ deleteQueue rq (TRcvQueues qs cs) = do
     delQ = L.nonEmpty . L.filter (/= k)
     k = qKey rq
 
-getSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues -> STM [RcvQueue]
+getSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues RcvQueue -> STM [RcvQueue]
 getSessQueues tSess (TRcvQueues qs _) = M.foldl' addQ [] <$> readTVar qs
   where
     addQ qs' rq = if rq `isSession` tSess then rq : qs' else qs'
 
-getDelSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues -> STM ([RcvQueue], [ConnId])
-getDelSessQueues tSess (TRcvQueues qs cs) = do
+getDelSessQueues :: (UserId, SMPServer, Maybe ConnId) -> SessionId -> TRcvQueues (SessionId, RcvQueue) -> STM ([RcvQueue], [ConnId])
+getDelSessQueues tSess sessId' (TRcvQueues qs cs) = do
   (removedQs, qs'') <- (\qs' -> M.foldl' delQ ([], qs') qs') <$> readTVar qs
   writeTVar qs $! qs''
   removedConns <- stateTVar cs $ \cs' -> foldl' delConn ([], cs') removedQs
   pure (removedQs, removedConns)
   where
-    delQ acc@(removed, qs') rq
-      | rq `isSession` tSess = (rq : removed, M.delete (qKey rq) qs')
+    delQ acc@(removed, qs') (sessId, rq)
+      | rq `isSession` tSess && sessId == sessId' = (rq : removed, M.delete (qKey rq) qs')
       | otherwise = acc
+    delConn :: ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, ConnId))) -> RcvQueue -> ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, ConnId)))
     delConn (removed, cs') rq = M.alterF f cId cs'
       where
         cId = connId rq
@@ -100,5 +107,10 @@ isSession :: RcvQueue -> (UserId, SMPServer, Maybe ConnId) -> Bool
 isSession rq (uId, srv, connId_) =
   userId rq == uId && server rq == srv && maybe True (connId rq ==) connId_
 
-qKey :: RcvQueue -> (UserId, SMPServer, ConnId)
-qKey rq = (userId rq, server rq, connId rq)
+instance Queue RcvQueue where
+  connId' = connId
+  qKey rq = (userId rq, server rq, connId rq)
+
+instance Queue (SessionId, RcvQueue) where
+  connId' = connId . snd
+  qKey = qKey . snd
diff --git a/src/Simplex/Messaging/Client/Agent.hs b/src/Simplex/Messaging/Client/Agent.hs
index 99c77f67c..a95f706bf 100644
--- a/src/Simplex/Messaging/Client/Agent.hs
+++ b/src/Simplex/Messaging/Client/Agent.hs
@@ -100,7 +100,7 @@ data SMPClientAgent = SMPClientAgent
     randomDrg :: TVar ChaChaDRG,
     smpClients :: TMap SMPServer SMPClientVar,
     smpSessions :: TMap SessionId (OwnServer, SMPClient),
-    srvSubs :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey),
+    srvSubs :: TMap SMPServer (TMap SMPSub (SessionId, C.APrivateAuthKey)),
     pendingSrvSubs :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey),
     smpSubWorkers :: TMap SMPServer (SessionVar (Async ())),
     workerSeq :: TVar Int
@@ -204,14 +204,17 @@ connectClient ca@SMPClientAgent {agentCfg, smpClients, smpSessions, msgQ, random
 
     removeClientAndSubs :: SMPClient -> IO (Maybe (Map SMPSub C.APrivateAuthKey))
     removeClientAndSubs smp = atomically $ do
+      TM.delete sessId smpSessions
       removeSessVar v srv smpClients
-      TM.delete (sessionId $ thParams smp) smpSessions
-      TM.lookupDelete srv (srvSubs ca) >>= mapM updateSubs
+      TM.lookup srv (srvSubs ca) >>= mapM updateSubs
       where
+        sessId = sessionId $ thParams smp
         updateSubs sVar = do
-          ss <- readTVar sVar
-          addSubs_ (pendingSrvSubs ca) srv ss
-          pure ss
+          -- removing subscriptions that have matching sessionId to disconnected client
+          -- and keep the other ones (they can be made by the new client)
+          pending <- M.map snd <$> stateTVar sVar (M.partition ((sessId ==) . fst))
+          addSubs_ (pendingSrvSubs ca) srv pending
+          pure pending
 
     serverDown :: Map SMPSub C.APrivateAuthKey -> IO ()
     serverDown ss = unless (M.null ss) $ do
@@ -256,9 +259,9 @@ reconnectSMPClient ca@SMPClientAgent {agentCfg} srv cs =
     subscribe_ smp SPNotifier nSubs
     subscribe_ smp SPRecipient rSubs
   where
-    groupSub :: Map SMPSub C.APrivateAuthKey -> (SMPSub, C.APrivateAuthKey) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)]) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)])
-    groupSub currSubs (s@(party, qId), k) (nSubs, rSubs)
-      | M.member s currSubs = (nSubs, rSubs)
+    groupSub :: Map SMPSub (SessionId, C.APrivateAuthKey) -> (SMPSub, C.APrivateAuthKey) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)]) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)])
+    groupSub currSubs (s@(party, qId), k) acc@(nSubs, rSubs)
+      | M.member s currSubs = acc
       | otherwise = case party of
           SPNotifier -> (s' : nSubs, rSubs)
           SPRecipient -> (nSubs, s' : rSubs)
@@ -346,17 +349,18 @@ smpSubscribeQueues party ca smp srv subs = do
       when tempErrs $ reconnectClient ca srv
     Nothing -> reconnectClient ca srv
   where
-    processSubscriptions :: NonEmpty (Either SMPClientError ()) -> STM (Bool, [(QueueId, SMPClientError)], [(QueueId, C.APrivateAuthKey)], [QueueId])
+    processSubscriptions :: NonEmpty (Either SMPClientError ()) -> STM (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId])
     processSubscriptions rs = do
       pending <- maybe (pure M.empty) readTVar =<< TM.lookup srv (pendingSrvSubs ca)
       let acc@(_, _, oks, notPending) = foldr (groupSub pending) (False, [], [], []) (L.zip subs rs)
       unless (null oks) $ addSubscriptions ca srv party oks
       unless (null notPending) $ removePendingSubs ca srv party notPending
       pure acc
-    groupSub :: Map SMPSub C.APrivateAuthKey -> ((QueueId, C.APrivateAuthKey), Either SMPClientError ()) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, C.APrivateAuthKey)], [QueueId]) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, C.APrivateAuthKey)], [QueueId])
-    groupSub pending (s@(qId, _), r) acc@(!tempErrs, finalErrs, oks, notPending) = case r of
+    sessId = sessionId $ thParams smp
+    groupSub :: Map SMPSub C.APrivateAuthKey -> ((QueueId, C.APrivateAuthKey), Either SMPClientError ()) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId]) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId])
+    groupSub pending ((qId, pk), r) acc@(!tempErrs, finalErrs, oks, notPending) = case r of
       Right ()
-        | M.member (party, qId) pending -> (tempErrs, finalErrs, s : oks, qId : notPending)
+        | M.member (party, qId) pending -> (tempErrs, finalErrs, (qId, (sessId, pk)) : oks, qId : notPending)
         | otherwise -> acc
       Left e
         | temporaryClientError e -> (True, finalErrs, oks, notPending)
@@ -379,7 +383,7 @@ showServer :: SMPServer -> ByteString
 showServer ProtocolServer {host, port} =
   strEncode host <> B.pack (if null port then "" else ':' : port)
 
-addSubscriptions :: SMPClientAgent -> SMPServer -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> STM ()
+addSubscriptions :: SMPClientAgent -> SMPServer -> SMPSubParty -> [(QueueId, (SessionId, C.APrivateAuthKey))] -> STM ()
 addSubscriptions = addSubsList_ . srvSubs
 {-# INLINE addSubscriptions #-}
 
@@ -387,12 +391,12 @@ addPendingSubs :: SMPClientAgent -> SMPServer -> SMPSubParty -> [(QueueId, C.APr
 addPendingSubs = addSubsList_ . pendingSrvSubs
 {-# INLINE addPendingSubs #-}
 
-addSubsList_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> STM ()
+addSubsList_ :: TMap SMPServer (TMap SMPSub s) -> SMPServer -> SMPSubParty -> [(QueueId, s)] -> STM ()
 addSubsList_ subs srv party ss = addSubs_ subs srv ss'
   where
     ss' = M.fromList $ map (first (party,)) ss
 
-addSubs_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> Map SMPSub C.APrivateAuthKey -> STM ()
+addSubs_ :: TMap SMPServer (TMap SMPSub s) -> SMPServer -> Map SMPSub s -> STM ()
 addSubs_ subs srv ss =
   TM.lookup srv subs >>= \case
     Just m -> TM.union ss m
@@ -402,7 +406,7 @@ removeSubscription :: SMPClientAgent -> SMPServer -> SMPSub -> STM ()
 removeSubscription = removeSub_ . srvSubs
 {-# INLINE removeSubscription #-}
 
-removeSub_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSub -> STM ()
+removeSub_ :: TMap SMPServer (TMap SMPSub s) -> SMPServer -> SMPSub -> STM ()
 removeSub_ subs srv s = TM.lookup srv subs >>= mapM_ (TM.delete s)
 
 removePendingSubs :: SMPClientAgent -> SMPServer -> SMPSubParty -> [QueueId] -> STM ()
diff --git a/src/Simplex/Messaging/Notifications/Types.hs b/src/Simplex/Messaging/Notifications/Types.hs
index 97f9e6bdd..8fcedab53 100644
--- a/src/Simplex/Messaging/Notifications/Types.hs
+++ b/src/Simplex/Messaging/Notifications/Types.hs
@@ -11,7 +11,7 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time (UTCTime)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import Simplex.Messaging.Agent.Protocol (UserId, ConnId, NotificationsMode (..))
+import Simplex.Messaging.Agent.Protocol (ConnId, NotificationsMode (..), UserId)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol
@@ -48,6 +48,7 @@ data NtfToken = NtfToken
     ntfServer :: NtfServer,
     ntfTokenId :: Maybe NtfTokenId,
     -- TODO combine keys to key pair as the types should match
+
     -- | key used by the ntf server to verify transmissions
     ntfPubKey :: C.APublicAuthKey,
     -- | key used by the ntf client to sign transmissions
diff --git a/src/Simplex/Messaging/Session.hs b/src/Simplex/Messaging/Session.hs
index 3ce5a35c8..45c182046 100644
--- a/src/Simplex/Messaging/Session.hs
+++ b/src/Simplex/Messaging/Session.hs
@@ -5,9 +5,6 @@
 module Simplex.Messaging.Session where
 
 import Control.Concurrent.STM
-import Control.Monad
-import Data.Composition ((.:.))
-import Data.Functor (($>))
 import Data.Time (UTCTime)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -31,14 +28,10 @@ getSessVar sessSeq sessKey vs sessionVarTs = maybe (Left <$> newSessionVar) (pur
       pure v
 
 removeSessVar :: Ord k => SessionVar a -> k -> TMap k (SessionVar a) -> STM ()
-removeSessVar = void .:. removeSessVar'
-{-# INLINE removeSessVar #-}
-
-removeSessVar' :: Ord k => SessionVar a -> k -> TMap k (SessionVar a) -> STM Bool
-removeSessVar' v sessKey vs =
+removeSessVar v sessKey vs =
   TM.lookup sessKey vs >>= \case
-    Just v' | sessionVarId v == sessionVarId v' -> TM.delete sessKey vs $> True
-    _ -> pure False
+    Just v' | sessionVarId v == sessionVarId v' -> TM.delete sessKey vs
+    _ -> pure ()
 
 tryReadSessVar :: Ord k => k -> TMap k (SessionVar a) -> STM (Maybe a)
 tryReadSessVar sessKey vs = TM.lookup sessKey vs $>>= (tryReadTMVar . sessionVar)
diff --git a/tests/CoreTests/TRcvQueuesTests.hs b/tests/CoreTests/TRcvQueuesTests.hs
index 9f7c4932e..7e39d7fd9 100644
--- a/tests/CoreTests/TRcvQueuesTests.hs
+++ b/tests/CoreTests/TRcvQueuesTests.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
 module CoreTests.TRcvQueuesTests where
@@ -30,13 +31,13 @@ tRcvQueuesTests = do
   describe "queue transfer" $ do
     it "getDelSessQueues-batchAddQueues preserves total length" removeSubsTest
 
-checkDataInvariant :: RQ.TRcvQueues -> IO Bool
+checkDataInvariant :: RQ.Queue q => RQ.TRcvQueues q -> IO Bool
 checkDataInvariant trq = atomically $ do
   conns <- readTVar $ RQ.getConnections trq
   qs <- readTVar $ RQ.getRcvQueues trq
   -- three invariant checks
-  let inv1 = all (\cId -> (S.fromList . L.toList <$> M.lookup cId conns) == Just (M.keysSet (M.filter (\q -> connId q == cId) qs))) (M.keys conns)
-      inv2 = all (\(k, q) -> maybe False ((k `elem`) . L.toList) (M.lookup (connId q) conns)) (M.assocs qs)
+  let inv1 = all (\cId -> (S.fromList . L.toList <$> M.lookup cId conns) == Just (M.keysSet (M.filter (\q -> RQ.connId' q == cId) qs))) (M.keys conns)
+      inv2 = all (\(k, q) -> maybe False ((k `elem`) . L.toList) (M.lookup (RQ.connId' q) conns)) (M.assocs qs)
       inv3 = all (\(k, q) -> RQ.qKey q == k) (M.assocs qs)
   pure $ inv1 && inv2 && inv3
 
@@ -76,7 +77,7 @@ batchIdempotentTest = do
   atomically $ RQ.batchAddQueues trq qs
   checkDataInvariant trq `shouldReturn` True
   readTVarIO (RQ.getRcvQueues trq) `shouldReturn` qs'
-  fmap L.nub <$> readTVarIO (RQ.getConnections trq) `shouldReturn`cs' -- connections get duplicated, but that doesn't appear to affect anybody
+  fmap L.nub <$> readTVarIO (RQ.getConnections trq) `shouldReturn` cs' -- connections get duplicated, but that doesn't appear to affect anybody
 
 deleteConnTest :: IO ()
 deleteConnTest = do
@@ -112,23 +113,23 @@ getDelSessQueuesTest :: IO ()
 getDelSessQueuesTest = do
   trq <- atomically RQ.empty
   let qs =
-        [ dummyRQ 0 "smp://1234-w==@alpha" "c1",
-          dummyRQ 0 "smp://1234-w==@alpha" "c2",
-          dummyRQ 0 "smp://1234-w==@beta" "c3",
-          dummyRQ 1 "smp://1234-w==@beta" "c4"
+        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
+          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
+          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3"),
+          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4")
         ]
   atomically $ RQ.batchAddQueues trq qs
   checkDataInvariant trq `shouldReturn` True
   -- no user
-  atomically (RQ.getDelSessQueues (2, "smp://1234-w==@alpha", Nothing) trq) `shouldReturn` ([], [])
+  atomically (RQ.getDelSessQueues (2, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([], [])
   checkDataInvariant trq `shouldReturn` True
   -- wrong user
-  atomically (RQ.getDelSessQueues (1, "smp://1234-w==@alpha", Nothing) trq) `shouldReturn` ([], [])
+  atomically (RQ.getDelSessQueues (1, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([], [])
   checkDataInvariant trq `shouldReturn` True
   -- connections intact
   atomically (RQ.hasConn "c1" trq) `shouldReturn` True
   atomically (RQ.hasConn "c2" trq) `shouldReturn` True
-  atomically (RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) trq) `shouldReturn` ([dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"], ["c1", "c2"])
+  atomically (RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"], ["c1", "c2"])
   checkDataInvariant trq `shouldReturn` True
   -- connections gone
   atomically (RQ.hasConn "c1" trq) `shouldReturn` False
@@ -141,29 +142,29 @@ removeSubsTest :: IO ()
 removeSubsTest = do
   aq <- atomically RQ.empty
   let qs =
-        [ dummyRQ 0 "smp://1234-w==@alpha" "c1",
-          dummyRQ 0 "smp://1234-w==@alpha" "c2",
-          dummyRQ 0 "smp://1234-w==@beta" "c3",
-          dummyRQ 1 "smp://1234-w==@beta" "c4"
+        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
+          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
+          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3"),
+          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4")
         ]
   atomically $ RQ.batchAddQueues aq qs
 
   pq <- atomically RQ.empty
   atomically (totalSize aq pq) `shouldReturn` (4, 4)
 
-  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) aq >>= RQ.batchAddQueues pq . fst
+  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
   atomically (totalSize aq pq) `shouldReturn` (4, 4)
 
-  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "non-existent") aq >>= RQ.batchAddQueues pq . fst
+  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "non-existent") "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
   atomically (totalSize aq pq) `shouldReturn` (4, 4)
 
-  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@localhost", Nothing) aq >>= RQ.batchAddQueues pq . fst
+  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@localhost", Nothing) "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
   atomically (totalSize aq pq) `shouldReturn` (4, 4)
 
-  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "c3") aq >>= RQ.batchAddQueues pq . fst
+  atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "c3") "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
   atomically (totalSize aq pq) `shouldReturn` (4, 4)
 
-totalSize :: RQ.TRcvQueues -> RQ.TRcvQueues -> STM (Int, Int)
+totalSize :: RQ.TRcvQueues q -> RQ.TRcvQueues q -> STM (Int, Int)
 totalSize a b = do
   qsizeA <- M.size <$> readTVar (RQ.getRcvQueues a)
   qsizeB <- M.size <$> readTVar (RQ.getRcvQueues b)

From 5fa3c149e9ac10e1d3a08130dc67074f5962077a Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Thu, 25 Jul 2024 16:06:40 +0100
Subject: [PATCH 051/195] smp server: fix server-info, additional stats, allow
 expiring inactive clients which have prohibit subscriptions only (iOS NSE
 clients) (#1237)

* smp server: fix server-info

* fix

* faster saving messages

* remove comment

* move ProhibitSub out of TVar

* subscription stats

* stabilize test

* order

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

* more notification stats

* count ntf stats

* update server-info

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
---
 src/Simplex/Messaging/Server.hs              | 174 +++++++++++++------
 src/Simplex/Messaging/Server/Env/STM.hs      |  24 ++-
 src/Simplex/Messaging/Server/MsgStore/STM.hs |  14 --
 src/Simplex/Messaging/Server/Stats.hs        |  64 +++++++
 tests/AgentTests/FunctionalAPITests.hs       |   1 +
 tests/SMPProxyTests.hs                       |  14 +-
 tests/ServerTests.hs                         |   6 +-
 7 files changed, 215 insertions(+), 82 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 34c7dd561..f8927d21d 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -37,6 +37,7 @@ module Simplex.Messaging.Server
   )
 where
 
+import Control.Concurrent.STM.TQueue (flushTQueue)
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
@@ -47,6 +48,7 @@ import Crypto.Random
 import Control.Monad.STM (retry)
 import Data.Bifunctor (first)
 import Data.ByteString.Base64 (encode)
+import qualified Data.ByteString.Builder as BLD
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -54,6 +56,7 @@ import Data.Either (fromRight, partitionEithers)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
+import qualified Data.IntSet as IS
 import Data.List (intercalate, mapAccumR)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
@@ -232,7 +235,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
       liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
       liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
-      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubNoMsg, qSubAuth, qSubDuplicate, qSubProhibited, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv} <- asks serverStats
+      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubNoMsg, qSubAuth, qSubDuplicate, qSubProhibited, ntfCreated, ntfDeleted, ntfSub, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, subscribedQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv}
+        <- asks serverStats
+      QueueStore {queues, notifiers} <- asks queueStore
       let interval = 1000000 * logInterval
       forever $ do
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
@@ -249,6 +254,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           qSubAuth' <- atomically $ swapTVar qSubAuth 0
           qSubDuplicate' <- atomically $ swapTVar qSubDuplicate 0
           qSubProhibited' <- atomically $ swapTVar qSubProhibited 0
+          ntfCreated' <- atomically $ swapTVar ntfCreated 0
+          ntfDeleted' <- atomically $ swapTVar ntfDeleted 0
+          ntfSub' <- atomically $ swapTVar ntfSub 0
+          ntfSubAuth' <- atomically $ swapTVar ntfSubAuth 0
+          ntfSubDuplicate' <- atomically $ swapTVar ntfSubDuplicate 0
           msgSent' <- atomically $ swapTVar msgSent 0
           msgSentAuth' <- atomically $ swapTVar msgSentAuth 0
           msgSentQuota' <- atomically $ swapTVar msgSentQuota 0
@@ -262,6 +272,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           msgGetProhibited' <- atomically $ swapTVar msgGetProhibited 0
           msgExpired' <- atomically $ swapTVar msgExpired 0
           ps <- atomically $ periodStatCounts activeQueues ts
+          psSub <- atomically $ periodStatCounts subscribedQueues ts
           msgSentNtf' <- atomically $ swapTVar msgSentNtf 0
           msgRecvNtf' <- atomically $ swapTVar msgRecvNtf 0
           psNtf <- atomically $ periodStatCounts activeQueuesNtf ts
@@ -274,6 +285,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           pMsgFwdsOwn' <- atomically $ getResetProxyStatsData pMsgFwdsOwn
           pMsgFwdsRecv' <- atomically $ swapTVar pMsgFwdsRecv 0
           qCount' <- readTVarIO qCount
+          qCount'' <- M.size <$> readTVarIO queues
+          ntfCount' <- M.size <$> readTVarIO notifiers
           msgCount' <- readTVarIO msgCount
           hPutStrLn h $
             intercalate
@@ -319,7 +332,17 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                        show msgGetNoMsg',
                        show msgGetAuth',
                        show msgGetDuplicate',
-                       show msgGetProhibited'
+                       show msgGetProhibited',
+                       dayCount psSub,
+                       weekCount psSub,
+                       monthCount psSub,
+                       show qCount'',
+                       show ntfCreated',
+                       show ntfDeleted',
+                       show ntfSub',
+                       show ntfSubAuth',
+                       show ntfSubDuplicate',
+                       show ntfCount'
                      ]
               )
         liftIO $ threadDelay' interval
@@ -410,14 +433,19 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                 putStat "qDeletedAll" qDeletedAll
                 putStat "qDeletedNew" qDeletedNew
                 putStat "qDeletedSecured" qDeletedSecured
-                getStat (day . activeQueues) >>= \v -> hPutStrLn h $ "dayMsgQueues: " <> show (S.size v)
-                subs <- (,,,,) <$> getStat qSub <*> getStat qSubNoMsg <*> getStat qSubAuth <*> getStat qSubDuplicate <*> getStat qSubProhibited
-                hPutStrLn h $ "SUBs (count, noMsg, auth, duplicate, prohibited): " <> show subs
+                getStat (day . activeQueues) >>= \v -> hPutStrLn h $ "daily active queues: " <> show (S.size v)
+                getStat (day . subscribedQueues) >>= \v -> hPutStrLn h $ "daily subscribed queues: " <> show (S.size v)
+                putStat "qSub" qSub
+                putStat "qSubNoMsg" qSubNoMsg
+                subs <- (,,) <$> getStat qSubAuth <*> getStat qSubDuplicate <*> getStat qSubProhibited
+                hPutStrLn h $ "other SUB events (auth, duplicate, prohibited): " <> show subs
                 putStat "msgSent" msgSent
                 putStat "msgRecv" msgRecv
                 putStat "msgRecvGet" msgRecvGet
-                gets <- (,,,,) <$> getStat msgGet <*> getStat msgGetNoMsg <*> getStat msgGetAuth <*> getStat msgGetDuplicate <*> getStat msgGetProhibited
-                hPutStrLn h $ "GETs (count, noMsg, auth, duplicate, prohibited): " <> show gets
+                putStat "msgGet" msgGet
+                putStat "msgGetNoMsg" msgGet
+                gets <- (,,) <$> getStat msgGetAuth <*> getStat msgGetDuplicate <*> getStat msgGetProhibited
+                hPutStrLn h $ "other GET events (auth, duplicate, prohibited): " <> show gets
                 putStat "msgSentNtf" msgSentNtf
                 putStat "msgRecvNtf" msgRecvNtf
                 putStat "qCount" qCount
@@ -494,10 +522,23 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                     putActiveClientsInfo protoName clients = do
                       activeSubs <- readTVarIO clients
                       hPutStrLn h $ protoName <> " subscriptions: " <> show (M.size activeSubs)
-                      hPutStrLn h $ protoName <> " subscribed clients: " <> show (countSubClients activeSubs)
-                      when (r == CPRAdmin) $ do
-                        clQs <- clientTBQueueLengths activeSubs
-                        hPutStrLn h $ protoName <> " subscribed clients queues (rcvQ, sndQ, msgQ): " <> show clQs
+                      clCnt <- if r == CPRAdmin then putClientQueues activeSubs else pure $ countSubClients activeSubs
+                      hPutStrLn h $ protoName <> " subscribed clients: " <> show clCnt
+                      where
+                        putClientQueues :: M.Map QueueId Client -> IO Int
+                        putClientQueues subs = do
+                          let cls = differentClients subs
+                          clQs <- clientTBQueueLengths cls
+                          hPutStrLn h $ protoName <> " subscribed clients queues (rcvQ, sndQ, msgQ): " <> show clQs
+                          pure $ length cls
+                        differentClients :: M.Map QueueId Client -> [Client]
+                        differentClients = fst . M.foldl' addClient ([], IS.empty)
+                          where
+                            addClient acc@(cls, clSet) cl@Client {clientId}
+                              | IS.member clientId clSet = acc
+                              | otherwise = (cl : cls, IS.insert clientId clSet)
+                        countSubClients :: M.Map QueueId Client -> Int
+                        countSubClients = IS.size . M.foldr' (IS.insert . clientId) IS.empty
                     countClientSubs :: (Client -> TMap QueueId a) -> Maybe (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap Client -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
                     countClientSubs subSel countSubs_ = foldM addSubs (0, (0, 0, 0, 0), 0, (0, 0, 0))
                       where
@@ -526,13 +567,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                     countSMPSubs :: M.Map QueueId Sub -> IO (Int, Int, Int, Int)
                     countSMPSubs = foldM countSubs (0, 0, 0, 0)
                       where
-                        countSubs (c1, c2, c3, c4) Sub {subThread} =
-                          readTVarIO subThread >>= \st -> pure $ case st of
-                            NoSub -> (c1 + 1, c2, c3, c4)
-                            SubPending -> (c1, c2 + 1, c3, c4)
-                            SubThread _ -> (c1, c2, c3 + 1, c4)
-                            ProhibitSub -> (c1, c2, c3, c4 + 1)
-                    countSubClients = S.size . M.foldr' (S.insert . clientId) S.empty
+                        countSubs (c1, c2, c3, c4) Sub {subThread} = case subThread of
+                          ServerSub t -> do
+                            st <- readTVarIO t
+                            pure $ case st of
+                              NoSub -> (c1 + 1, c2, c3, c4)
+                              SubPending -> (c1, c2 + 1, c3, c4)
+                              SubThread _ -> (c1, c2, c3 + 1, c4)
+                          ProhibitSub -> pure (c1, c2, c3, c4 + 1)
               CPDelete queueId' -> withUserRole $ unliftIO u $ do
                 st <- asks queueStore
                 ms <- asks msgStore
@@ -587,7 +629,8 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
   where
     disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport h (rcvActiveAt c) (sndActiveAt c) expCfg (noSubscriptions c)]
     disconnectThread_ _ _ = []
-    noSubscriptions c = atomically $ (&&) <$> TM.null (subscriptions c) <*> TM.null (ntfSubscriptions c)
+    noSubscriptions c = atomically $ (&&) <$> TM.null (ntfSubscriptions c) <*> (not . hasSubs <$> readTVar (subscriptions c))
+    hasSubs = any $ (\case ServerSub _ -> True; ProhibitSub -> False) . subThread
 
 clientDisconnected :: Client -> M ()
 clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, connected, sessionId, endThreads} = do
@@ -615,10 +658,12 @@ sameClientId :: Client -> Client -> Bool
 sameClientId Client {clientId} Client {clientId = cId'} = clientId == cId'
 
 cancelSub :: Sub -> IO ()
-cancelSub s =
-  readTVarIO (subThread s) >>= \case
-    SubThread t -> liftIO $ deRefWeak t >>= mapM_ killThread
-    _ -> pure ()
+cancelSub s = case subThread s of
+  ServerSub st ->
+    readTVarIO st >>= \case
+      SubThread t -> liftIO $ deRefWeak t >>= mapM_ killThread
+      _ -> pure ()
+  ProhibitSub -> pure ()
 
 receive :: Transport c => THandleSMP c 'TServer -> Client -> M ()
 receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
@@ -643,6 +688,7 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
                 case cmd of
                   Cmd _ SEND {} -> incStat $ msgSentAuth stats
                   Cmd _ SUB -> incStat $ qSubAuth stats
+                  Cmd _ NSUB -> incStat $ ntfSubAuth stats
                   Cmd _ GET -> incStat $ msgGetAuth stats
                   _ -> pure ()
                 pure $ Left (corrId, entId, ERR AUTH)
@@ -983,6 +1029,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 Left e -> pure $ ERR e
                 Right _ -> do
                   withLog $ \s -> logAddNotifier s entId ntfCreds
+                  incStat . ntfCreated =<< asks serverStats
                   pure $ NID notifierId rcvPublicDhKey
 
         deleteQueueNotifier_ :: QueueStore -> M (Transmission BrokerMsg)
@@ -992,6 +1039,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             Right () -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
               atomically $ writeTQueue ntfSubscribedQ (entId, clnt, False)
+              incStat . ntfDeleted =<< asks serverStats
               pure ok
             Left e -> pure $ err e
 
@@ -1006,7 +1054,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             Nothing -> newSub >>= deliver True
             Just s@Sub {subThread} -> do
               stats <- asks serverStats
-              readTVarIO subThread >>= \case
+              case subThread of
                 ProhibitSub -> do
                   -- cannot use SUB in the same connection where GET was used
                   incStat $ qSubProhibited stats
@@ -1028,6 +1076,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
               when inc $ do
                 stats <- asks serverStats
                 incStat $ (if isJust msg_ then qSub else qSubNoMsg) stats
+                atomically $ updatePeriodStats (subscribedQueues stats) rId
               deliverMessage "SUB" qr rId sub msg_
 
         getMessage :: QueueRec -> M (Transmission BrokerMsg)
@@ -1036,7 +1085,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             Nothing ->
               atomically newSub >>= (`getMessage_` Nothing)
             Just s@Sub {subThread} ->
-              readTVarIO subThread >>= \case
+              case subThread of
                 ProhibitSub ->
                   atomically (tryTakeTMVar $ delivered s)
                     >>= getMessage_ s
@@ -1048,7 +1097,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           where
             newSub :: STM Sub
             newSub = do
-              s <- newSubscription ProhibitSub
+              s <- newProhibitedSub
               TM.insert entId s subscriptions
               pure s
             getMessage_ :: Sub -> Maybe MsgId -> M (Transmission BrokerMsg)
@@ -1070,11 +1119,19 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
         withQueue action = maybe (pure $ err AUTH) action qr_
 
         subscribeNotifications :: M (Transmission BrokerMsg)
-        subscribeNotifications = time "NSUB" . atomically $ do
-          unlessM (TM.member entId ntfSubscriptions) $ do
-            writeTQueue ntfSubscribedQ (entId, clnt, True)
-            TM.insert entId () ntfSubscriptions
+        subscribeNotifications = do
+          statCount <-
+            time "NSUB" . atomically $ do
+              ifM
+                (TM.member entId ntfSubscriptions)
+                (pure ntfSubDuplicate)
+                (newSub $> ntfSub)
+          incStat . statCount =<< asks serverStats
           pure ok
+          where
+            newSub = do
+              writeTQueue ntfSubscribedQ (entId, clnt, True)
+              TM.insert entId () ntfSubscriptions
 
         acknowledgeMsg :: QueueRec -> MsgId -> M (Transmission BrokerMsg)
         acknowledgeMsg qr msgId = time "ACK" $ do
@@ -1095,11 +1152,11 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                       deliverMessage "ACK" qr entId sub msg_
                 _ -> pure $ err NO_MSG
           where
-            getDelivered :: Sub -> STM (Maybe SubscriptionThread)
+            getDelivered :: Sub -> STM (Maybe ServerSub)
             getDelivered Sub {delivered, subThread} = do
               tryTakeTMVar delivered $>>= \msgId' ->
                 if msgId == msgId' || B.null msgId
-                  then Just <$> readTVar subThread
+                  then pure $ Just subThread
                   else putTMVar delivered msgId' $> Nothing
             updateStats :: Bool -> Message -> M ()
             updateStats isGet = \case
@@ -1188,26 +1245,28 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 deliverToSub =
                   TM.lookup rId subscribers
                     $>>= \rc@Client {subscriptions = subs, sndQ = q} -> TM.lookup rId subs
-                    $>>= \s@Sub {subThread, delivered} -> readTVar subThread >>= \case
-                      NoSub ->
-                        tryTakeTMVar delivered >>= \case
-                          Just _ -> pure Nothing -- if a message was already delivered, should not deliver more
-                          Nothing ->
-                            ifM
-                              (isFullTBQueue q)
-                              (writeTVar subThread SubPending $> Just (rc, s))
-                              (deliver q s $> Nothing)
-                      _ -> pure Nothing
+                    $>>= \s@Sub {subThread, delivered} -> case subThread of
+                      ProhibitSub -> pure Nothing
+                      ServerSub st -> readTVar st >>= \case
+                        NoSub ->
+                          tryTakeTMVar delivered >>= \case
+                            Just _ -> pure Nothing -- if a message was already delivered, should not deliver more
+                            Nothing ->
+                              ifM
+                                (isFullTBQueue q)
+                                (writeTVar st SubPending $> Just (rc, s, st))
+                                (deliver q s $> Nothing)
+                        _ -> pure Nothing
                 deliver q s = do
                   let encMsg = encryptMsg qr msg
                   writeTBQueue q [(CorrId "", rId, MSG encMsg)]
                   void $ setDelivered s msg
-                forkDeliver (rc@Client {sndQ = q}, s@Sub {subThread, delivered}) = do
+                forkDeliver (rc@Client {sndQ = q}, s@Sub {delivered}, st) = do
                   t <- mkWeakThreadId =<< forkIO deliverThread
-                  atomically . modifyTVar' subThread $ \case
+                  atomically . modifyTVar' st $ \case
                     -- this case is needed because deliverThread can exit before it
                     SubPending -> SubThread t
-                    st -> st
+                    st' -> st'
                   where
                     deliverThread = do
                       labelMyThread $ B.unpack ("client $" <> encode sessionId) <> " deliver/SEND"
@@ -1217,7 +1276,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                             Just _ -> pure () -- if a message was already delivered, should not deliver more
                             Nothing -> do
                               deliver q s
-                              writeTVar subThread NoSub
+                              writeTVar st NoSub
 
             trySendNotification :: NtfCreds -> Message -> TVar ChaChaDRG -> STM (Maybe Bool)
             trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg ntfNonceDrg =
@@ -1295,7 +1354,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                       VRFailed -> Left (corrId', entId', ERR AUTH)
         deliverMessage :: T.Text -> QueueRec -> RecipientId -> Sub -> Maybe Message -> M (Transmission BrokerMsg)
         deliverMessage name qr rId s@Sub {subThread} msg_ = time (name <> " deliver") . atomically $
-          readTVar subThread >>= \case
+          case subThread of
             ProhibitSub -> pure resp
             _ -> case msg_ of
               Just msg ->
@@ -1351,12 +1410,14 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           pure (corrId, entId, INFO info)
           where
             mkQSub Sub {subThread, delivered} = do
-              st <- readTVar subThread
-              let qSubThread = case st of
+              qSubThread <- case subThread of
+                ServerSub t -> do
+                  st <- readTVar t
+                  pure $ case st of
                     NoSub -> QNoSub
                     SubPending -> QSubPending
                     SubThread _ -> QSubThread
-                    ProhibitSub -> QProhibitSub
+                ProhibitSub -> pure QProhibitSub
               qDelivered <- decodeLatin1 . encode <$$> tryReadTMVar delivered
               pure QSub {qSubThread, qDelivered}
 
@@ -1408,13 +1469,16 @@ saveServerMessages keepMsgs = asks (storeMsgsFile . config) >>= mapM_ saveMessag
       logInfo $ "saving messages to file " <> T.pack f
       ms <- asks msgStore
       liftIO . withFile f WriteMode $ \h ->
-        readTVarIO ms >>= mapM_ (saveQueueMsgs ms h) . M.keys
+        readTVarIO ms >>= mapM_ (saveQueueMsgs h) . M.assocs
       logInfo "messages saved"
       where
-        getMessages = if keepMsgs then snapshotMsgQueue else flushMsgQueue
-        saveQueueMsgs ms h rId =
-          atomically (getMessages ms rId)
-            >>= mapM_ (B.hPutStrLn h . strEncode . MLRv3 rId)
+        saveQueueMsgs h (rId, q) = BLD.hPutBuilder h . encodeMessages rId =<< atomically (getMessages $ msgQueue q)
+        getMessages = if keepMsgs then snapshotTQueue else flushTQueue
+        snapshotTQueue q = do
+          msgs <- flushTQueue q
+          mapM_ (writeTQueue q) msgs
+          pure msgs
+        encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
 
 restoreServerMessages :: M Int
 restoreServerMessages =
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index dc77b7481..7a3bcc362 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -1,12 +1,15 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}
 
 module Simplex.Messaging.Server.Env.STM where
 
 import Control.Concurrent (ThreadId)
+import Control.Logger.Simple
+import Control.Monad
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
@@ -17,6 +20,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (isJust, isNothing)
+import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime)
 import Data.X509.Validation (Fingerprint (..))
@@ -104,7 +108,7 @@ defaultMessageExpiration =
 defaultInactiveClientExpiration :: ExpirationConfig
 defaultInactiveClientExpiration =
   ExpirationConfig
-    { ttl = 43200, -- seconds, 12 hours
+    { ttl = 21600, -- seconds, 6 hours
       checkInterval = 3600 -- seconds, 1 hours
     }
 
@@ -162,10 +166,12 @@ data Client = Client
     sndActiveAt :: TVar SystemTime
   }
 
-data SubscriptionThread = NoSub | SubPending | SubThread (Weak ThreadId) | ProhibitSub
+data ServerSub = ServerSub (TVar SubscriptionThread) | ProhibitSub
+
+data SubscriptionThread = NoSub | SubPending | SubThread (Weak ThreadId)
 
 data Sub = Sub
-  { subThread :: TVar SubscriptionThread,
+  { subThread :: ServerSub, -- Nothing value indicates that sub
     delivered :: TMVar MsgId
   }
 
@@ -197,16 +203,24 @@ newClient nextClientId qSize thVersion sessionId createdAt = do
 newSubscription :: SubscriptionThread -> STM Sub
 newSubscription st = do
   delivered <- newEmptyTMVar
-  subThread <- newTVar st
+  subThread <- ServerSub <$> newTVar st
   return Sub {subThread, delivered}
 
+newProhibitedSub :: STM Sub
+newProhibitedSub = do
+  delivered <- newEmptyTMVar
+  return Sub {subThread = ProhibitSub, delivered}
+
 newEnv :: ServerConfig -> IO Env
 newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile, storeLogFile, smpAgentCfg, transportConfig, information, messageExpiration} = do
   server <- atomically newServer
   queueStore <- atomically newQueueStore
   msgStore <- atomically newMsgStore
   random <- liftIO C.newRandom
-  storeLog <- restoreQueues queueStore `mapM` storeLogFile
+  storeLog <-
+    forM storeLogFile $ \f -> do
+      logInfo $ "restoring queues from file " <> T.pack f
+      restoreQueues queueStore f
   tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
   Fingerprint fp <- loadFingerprint caCertificateFile
   let serverIdentity = KeyHash fp
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index c8f78e2fb..6f9c40e58 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -14,8 +14,6 @@ module Simplex.Messaging.Server.MsgStore.STM
     getMsgQueue,
     delMsgQueue,
     delMsgQueueSize,
-    flushMsgQueue,
-    snapshotMsgQueue,
     writeMsg,
     tryPeekMsg,
     peekMsg,
@@ -25,7 +23,6 @@ module Simplex.Messaging.Server.MsgStore.STM
   )
 where
 
-import Control.Concurrent.STM.TQueue (flushTQueue)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -64,17 +61,6 @@ delMsgQueue st rId = TM.delete rId st
 delMsgQueueSize :: STMMsgStore -> RecipientId -> STM Int
 delMsgQueueSize st rId = TM.lookupDelete rId st >>= maybe (pure 0) (\MsgQueue {size} -> readTVar size)
 
-flushMsgQueue :: STMMsgStore -> RecipientId -> STM [Message]
-flushMsgQueue st rId = TM.lookupDelete rId st >>= maybe (pure []) (flushTQueue . msgQueue)
-
-snapshotMsgQueue :: STMMsgStore -> RecipientId -> STM [Message]
-snapshotMsgQueue st rId = TM.lookup rId st >>= maybe (pure []) (snapshotTQueue . msgQueue)
-  where
-    snapshotTQueue q = do
-      msgs <- flushTQueue q
-      mapM_ (writeTQueue q) msgs
-      pure msgs
-
 writeMsg :: MsgQueue -> Message -> STM (Maybe (Message, Bool))
 writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = do
   canWrt <- readTVar canWrite
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index 2f4ed0613..377fddd1a 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -31,6 +31,11 @@ data ServerStats = ServerStats
     qSubAuth :: TVar Int,
     qSubDuplicate :: TVar Int,
     qSubProhibited :: TVar Int,
+    ntfCreated :: TVar Int,
+    ntfDeleted :: TVar Int,
+    ntfSub :: TVar Int,
+    ntfSubAuth :: TVar Int,
+    ntfSubDuplicate :: TVar Int,
     msgSent :: TVar Int,
     msgSentAuth :: TVar Int,
     msgSentQuota :: TVar Int,
@@ -44,6 +49,7 @@ data ServerStats = ServerStats
     msgGetProhibited :: TVar Int,
     msgExpired :: TVar Int,
     activeQueues :: PeriodStats RecipientId,
+    subscribedQueues :: PeriodStats RecipientId,
     msgSentNtf :: TVar Int, -- sent messages with NTF flag
     msgRecvNtf :: TVar Int, -- received messages with NTF flag
     activeQueuesNtf :: PeriodStats RecipientId,
@@ -71,6 +77,11 @@ data ServerStatsData = ServerStatsData
     _qSubAuth :: Int,
     _qSubDuplicate :: Int,
     _qSubProhibited :: Int,
+    _ntfCreated :: Int,
+    _ntfDeleted :: Int,
+    _ntfSub :: Int,
+    _ntfSubAuth :: Int,
+    _ntfSubDuplicate :: Int,
     _msgSent :: Int,
     _msgSentAuth :: Int,
     _msgSentQuota :: Int,
@@ -84,6 +95,7 @@ data ServerStatsData = ServerStatsData
     _msgGetProhibited :: Int,
     _msgExpired :: Int,
     _activeQueues :: PeriodStatsData RecipientId,
+    _subscribedQueues :: PeriodStatsData RecipientId,
     _msgSentNtf :: Int,
     _msgRecvNtf :: Int,
     _activeQueuesNtf :: PeriodStatsData RecipientId,
@@ -113,6 +125,11 @@ newServerStats ts = do
   qSubAuth <- newTVar 0
   qSubDuplicate <- newTVar 0
   qSubProhibited <- newTVar 0
+  ntfCreated <- newTVar 0
+  ntfDeleted <- newTVar 0
+  ntfSub <- newTVar 0
+  ntfSubAuth <- newTVar 0
+  ntfSubDuplicate <- newTVar 0
   msgSent <- newTVar 0
   msgSentAuth <- newTVar 0
   msgSentQuota <- newTVar 0
@@ -126,6 +143,7 @@ newServerStats ts = do
   msgGetProhibited <- newTVar 0
   msgExpired <- newTVar 0
   activeQueues <- newPeriodStats
+  subscribedQueues <- newPeriodStats
   msgSentNtf <- newTVar 0
   msgRecvNtf <- newTVar 0
   activeQueuesNtf <- newPeriodStats
@@ -152,6 +170,11 @@ newServerStats ts = do
         qSubAuth,
         qSubDuplicate,
         qSubProhibited,
+        ntfCreated,
+        ntfDeleted,
+        ntfSub,
+        ntfSubAuth,
+        ntfSubDuplicate,
         msgSent,
         msgSentAuth,
         msgSentQuota,
@@ -165,6 +188,7 @@ newServerStats ts = do
         msgGetProhibited,
         msgExpired,
         activeQueues,
+        subscribedQueues,
         msgSentNtf,
         msgRecvNtf,
         activeQueuesNtf,
@@ -193,6 +217,11 @@ getServerStatsData s = do
   _qSubAuth <- readTVar $ qSubAuth s
   _qSubDuplicate <- readTVar $ qSubDuplicate s
   _qSubProhibited <- readTVar $ qSubProhibited s
+  _ntfCreated <- readTVar $ ntfCreated s
+  _ntfDeleted <- readTVar $ ntfDeleted s
+  _ntfSub <- readTVar $ ntfSub s
+  _ntfSubAuth <- readTVar $ ntfSubAuth s
+  _ntfSubDuplicate <- readTVar $ ntfSubDuplicate s
   _msgSent <- readTVar $ msgSent s
   _msgSentAuth <- readTVar $ msgSentAuth s
   _msgSentQuota <- readTVar $ msgSentQuota s
@@ -206,6 +235,7 @@ getServerStatsData s = do
   _msgGetProhibited <- readTVar $ msgGetProhibited s
   _msgExpired <- readTVar $ msgExpired s
   _activeQueues <- getPeriodStatsData $ activeQueues s
+  _subscribedQueues <- getPeriodStatsData $ subscribedQueues s
   _msgSentNtf <- readTVar $ msgSentNtf s
   _msgRecvNtf <- readTVar $ msgRecvNtf s
   _activeQueuesNtf <- getPeriodStatsData $ activeQueuesNtf s
@@ -232,6 +262,11 @@ getServerStatsData s = do
         _qSubAuth,
         _qSubDuplicate,
         _qSubProhibited,
+        _ntfCreated,
+        _ntfDeleted,
+        _ntfSub,
+        _ntfSubAuth,
+        _ntfSubDuplicate,
         _msgSent,
         _msgSentAuth,
         _msgSentQuota,
@@ -245,6 +280,7 @@ getServerStatsData s = do
         _msgGetProhibited,
         _msgExpired,
         _activeQueues,
+        _subscribedQueues,
         _msgSentNtf,
         _msgRecvNtf,
         _activeQueuesNtf,
@@ -273,6 +309,11 @@ setServerStats s d = do
   writeTVar (qSubAuth s) $! _qSubAuth d
   writeTVar (qSubDuplicate s) $! _qSubDuplicate d
   writeTVar (qSubProhibited s) $! _qSubProhibited d
+  writeTVar (ntfCreated s) $! _ntfCreated d
+  writeTVar (ntfDeleted s) $! _ntfDeleted d
+  writeTVar (ntfSub s) $! _ntfSub d
+  writeTVar (ntfSubAuth s) $! _ntfSubAuth d
+  writeTVar (ntfSubDuplicate s) $! _ntfSubDuplicate d
   writeTVar (msgSent s) $! _msgSent d
   writeTVar (msgSentAuth s) $! _msgSentAuth d
   writeTVar (msgSentQuota s) $! _msgSentQuota d
@@ -286,6 +327,7 @@ setServerStats s d = do
   writeTVar (msgGetProhibited s) $! _msgGetProhibited d
   writeTVar (msgExpired s) $! _msgExpired d
   setPeriodStats (activeQueues s) (_activeQueues d)
+  setPeriodStats (subscribedQueues s) (_subscribedQueues d)
   writeTVar (msgSentNtf s) $! _msgSentNtf d
   writeTVar (msgRecvNtf s) $! _msgRecvNtf d
   setPeriodStats (activeQueuesNtf s) (_activeQueuesNtf d)
@@ -315,6 +357,11 @@ instance StrEncoding ServerStatsData where
         "qSubAuth=" <> strEncode (_qSubAuth d),
         "qSubDuplicate=" <> strEncode (_qSubDuplicate d),
         "qSubProhibited=" <> strEncode (_qSubProhibited d),
+        "ntfCreated=" <> strEncode (_ntfCreated d),
+        "ntfDeleted=" <> strEncode (_ntfDeleted d),
+        "ntfSub=" <> strEncode (_ntfSub d),
+        "ntfSubAuth=" <> strEncode (_ntfSubAuth d),
+        "ntfSubDuplicate=" <> strEncode (_ntfSubDuplicate d),
         "msgSent=" <> strEncode (_msgSent d),
         "msgSentAuth=" <> strEncode (_msgSentAuth d),
         "msgSentQuota=" <> strEncode (_msgSentQuota d),
@@ -334,6 +381,8 @@ instance StrEncoding ServerStatsData where
         "msgNtfLost=" <> strEncode (_msgNtfLost d),
         "activeQueues:",
         strEncode (_activeQueues d),
+        "subscribedQueues:",
+        strEncode (_subscribedQueues d),
         "activeQueuesNtf:",
         strEncode (_activeQueuesNtf d),
         "pRelays:",
@@ -359,6 +408,11 @@ instance StrEncoding ServerStatsData where
     _qSubAuth <- opt "qSubAuth="
     _qSubDuplicate <- opt "qSubDuplicate="
     _qSubProhibited <- opt "qSubProhibited="
+    _ntfCreated <- opt "ntfCreated="
+    _ntfDeleted <- opt "ntfDeleted="
+    _ntfSub <- opt "ntfSub="
+    _ntfSubAuth <- opt "ntfSubAuth="
+    _ntfSubDuplicate <- opt "ntfSubDuplicate="
     _msgSent <- "msgSent=" *> strP <* A.endOfLine
     _msgSentAuth <- opt "msgSentAuth="
     _msgSentQuota <- opt "msgSentQuota="
@@ -384,6 +438,10 @@ instance StrEncoding ServerStatsData where
           _week <- "weekMsgQueues=" *> strP <* A.endOfLine
           _month <- "monthMsgQueues=" *> strP <* optional A.endOfLine
           pure PeriodStatsData {_day, _week, _month}
+    _subscribedQueues <-
+      optional ("subscribedQueues:" <* A.endOfLine) >>= \case
+        Just _ -> strP <* optional A.endOfLine
+        _ -> pure newPeriodStatsData
     _activeQueuesNtf <-
       optional ("activeQueuesNtf:" <* A.endOfLine) >>= \case
         Just _ -> strP <* optional A.endOfLine
@@ -406,6 +464,11 @@ instance StrEncoding ServerStatsData where
           _qSubAuth,
           _qSubDuplicate,
           _qSubProhibited,
+          _ntfCreated,
+          _ntfDeleted,
+          _ntfSub,
+          _ntfSubAuth,
+          _ntfSubDuplicate,
           _msgSent,
           _msgSentAuth,
           _msgSentQuota,
@@ -424,6 +487,7 @@ instance StrEncoding ServerStatsData where
           _msgNtfNoSub,
           _msgNtfLost,
           _activeQueues,
+          _subscribedQueues,
           _activeQueuesNtf,
           _pRelays,
           _pRelaysOwn,
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 75593be73..53991ed12 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -38,6 +38,7 @@ module AgentTests.FunctionalAPITests
     rfGet,
     sfGet,
     nGet,
+    getInAnyOrder,
     (##>),
     (=##>),
     pattern CON,
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 2aa89e06f..8044d23f7 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -361,11 +361,15 @@ agentViaProxyRetryOffline = do
           -- proxy relay down
           4 <- msgId <$> A.sendMessage bob aliceId pqEnc noMsgFlags msg2
           bob `down` aliceId
-        withServer2 $ \_ -> runRight_ $ do
-          bob `up` aliceId
-          get bob ##> ("", aliceId, A.SENT (baseId + 4) bProxySrv)
-          get alice =##> \case ("", c, Msg' _ pq msg2') -> c == bobId && pq == pqEnc && msg2 == msg2'; _ -> False
-          ackMessage alice bobId (baseId + 4) Nothing
+        withServer2 $ \_ -> do
+          getInAnyOrder
+            bob
+            [ \case ("", "", AEvt SAENone (UP _ [c])) -> c == aliceId; _ -> False,
+              \case ("", c, AEvt SAEConn (A.SENT mId srv)) -> c == aliceId && mId == baseId + 4 && srv == bProxySrv; _ -> False
+            ]
+          runRight_ $ do
+            get alice =##> \case ("", c, Msg' _ pq msg2') -> c == bobId && pq == pqEnc && msg2 == msg2'; _ -> False
+            ackMessage alice bobId (baseId + 4) Nothing
   where
     withServer :: (ThreadId -> IO a) -> IO a
     withServer = withServer_ testStoreLogFile testStoreMsgsFile testPort
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 9534b7902..60aa1dd1c 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -610,7 +610,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 2
     logSize testStoreMsgsFile `shouldReturn` 5
-    logSize testServerStatsBackupFile `shouldReturn` 62
+    logSize testServerStatsBackupFile `shouldReturn` 71
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
 
@@ -628,7 +628,7 @@ testRestoreMessages at@(ATransport t) =
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
     logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 62
+    logSize testServerStatsBackupFile `shouldReturn` 71
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
@@ -647,7 +647,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     logSize testStoreMsgsFile `shouldReturn` 0
-    logSize testServerStatsBackupFile `shouldReturn` 62
+    logSize testServerStatsBackupFile `shouldReturn` 71
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
 

From 2de16cfae89661605b468df71eff8b8e8188ef86 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 28 Jul 2024 15:03:32 +0100
Subject: [PATCH 052/195] 6.0.0.4

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index d787d8f8a..6a0bc0e19 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.0.3
+version: 6.0.0.4
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 489b77eb5..827ddd3c2 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.0.3
+version:        6.0.0.4
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 3753379ae47a1201c8e546eaabc7bdf245463a70 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 29 Jul 2024 18:57:16 +0100
Subject: [PATCH 053/195] agent: support dababase access with high priority for
 more responsive user actions (#1248)

* agent: support dababase access with high priority for more responsive user actions

* rename, export

* fix
---
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  5 ++-
 .../Messaging/Agent/Store/SQLite/Common.hs    | 42 +++++++++++--------
 2 files changed, 27 insertions(+), 20 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 574137883..0bb80069c 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -220,7 +220,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     -- * utilities
     withConnection,
     withTransaction,
-    withTransactionCtx,
+    withTransactionPriority,
     firstRow,
     firstRow',
     maybeFirstRow,
@@ -395,7 +395,8 @@ connectSQLiteStore dbFilePath key keepKey = do
   atomically $ do
     dbKey <- newTVar $! storeKey key keepKey
     dbClosed <- newTVar False
-    pure SQLiteStore {dbFilePath, dbKey, dbConnection, dbNew, dbClosed}
+    dbSem <- newTVar 0
+    pure SQLiteStore {dbFilePath, dbKey, dbSem, dbConnection, dbNew, dbClosed}
 
 connectDB :: FilePath -> ScrubbedBytes -> IO DB.Connection
 connectDB path key = do
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs
index b9a9bd501..6b121b0b4 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -8,20 +9,20 @@ module Simplex.Messaging.Agent.Store.SQLite.Common
     withConnection',
     withTransaction,
     withTransaction',
-    withTransactionCtx,
+    withTransactionPriority,
     dbBusyLoop,
     storeKey,
   )
 where
 
 import Control.Concurrent (threadDelay)
+import Control.Concurrent.STM (retry)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
-import Data.Time.Clock (diffUTCTime, getCurrentTime)
 import Database.SQLite.Simple (SQLError)
 import qualified Database.SQLite.Simple as SQL
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
-import Simplex.Messaging.Util (diffToMilliseconds)
+import Simplex.Messaging.Util (ifM, unlessM)
 import qualified UnliftIO.Exception as E
 import UnliftIO.MVar
 import UnliftIO.STM
@@ -32,35 +33,40 @@ storeKey key keepKey = if keepKey || BA.null key then Just key else Nothing
 data SQLiteStore = SQLiteStore
   { dbFilePath :: FilePath,
     dbKey :: TVar (Maybe ScrubbedBytes),
+    dbSem :: TVar Int,
     dbConnection :: MVar DB.Connection,
     dbClosed :: TVar Bool,
     dbNew :: Bool
   }
 
+withConnectionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
+withConnectionPriority SQLiteStore {dbSem, dbConnection} priority action
+  | priority = E.bracket_ signal release $ withMVar dbConnection action
+  | otherwise = lowPriority
+  where
+    lowPriority = wait >> withMVar dbConnection (\db -> ifM free (Just <$> action db) (pure Nothing)) >>= maybe lowPriority pure
+    signal = atomically $ modifyTVar' dbSem (+ 1)
+    release = atomically $ modifyTVar' dbSem $ \sem -> if sem > 0 then sem - 1 else 0
+    wait = atomically $ unlessM ((0 ==) <$> readTVar dbSem) retry
+    free = (0 ==) <$> readTVarIO dbSem
+
 withConnection :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withConnection SQLiteStore {dbConnection} = withMVar dbConnection
+withConnection st = withConnectionPriority st False
 
 withConnection' :: SQLiteStore -> (SQL.Connection -> IO a) -> IO a
 withConnection' st action = withConnection st $ action . DB.conn
 
-withTransaction :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransaction = withTransactionCtx Nothing
-
 withTransaction' :: SQLiteStore -> (SQL.Connection -> IO a) -> IO a
 withTransaction' st action = withTransaction st $ action . DB.conn
 
-withTransactionCtx :: Maybe String -> SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransactionCtx ctx_ st action = withConnection st $ dbBusyLoop . transactionWithCtx
+withTransaction :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
+withTransaction st = withTransactionPriority st False
+{-# INLINE withTransaction #-}
+
+withTransactionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
+withTransactionPriority st priority action = withConnectionPriority st priority $ dbBusyLoop . transaction
   where
-    transactionWithCtx db@DB.Connection {conn} = case ctx_ of
-      Nothing -> SQL.withImmediateTransaction conn $ action db
-      Just ctx -> do
-        t1 <- getCurrentTime
-        r <- SQL.withImmediateTransaction conn $ action db
-        t2 <- getCurrentTime
-        putStrLn $ "withTransactionCtx start :: " <> show t1 <> " :: " <> ctx
-        putStrLn $ "withTransactionCtx end   :: " <> show t2 <> " :: " <> ctx <> " :: duration=" <> show (diffToMilliseconds $ diffUTCTime t2 t1)
-        pure r
+    transaction db@DB.Connection {conn} = SQL.withImmediateTransaction conn $ action db
 
 dbBusyLoop :: forall a. IO a -> IO a
 dbBusyLoop action = loop 500 3000000

From 83f8622b2397afe2635c8f60f1ec5f6fdc16ef7c Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 29 Jul 2024 21:02:22 +0100
Subject: [PATCH 054/195] 6.0.0.5

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index 6a0bc0e19..68b944385 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.0.4
+version: 6.0.0.5
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 827ddd3c2..946c8e3b6 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.0.4
+version:        6.0.0.5
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 03ea151be5dce9a4b8683f9f28805bdc8ba66758 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 30 Jul 2024 17:12:29 +0100
Subject: [PATCH 055/195] agent: support additional messages for connection in
 message batches (#1247)

* agent: support additional messages for connection in message batches

* fix, test

* test 2 connections

* use TVar instead of TMVar for GHC 8.10.7
---
 src/Simplex/Messaging/Agent.hs         | 48 +++++++++++++++++---------
 tests/AgentTests/FunctionalAPITests.hs | 45 ++++++++++++++++++++++++
 2 files changed, 77 insertions(+), 16 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 7159a1324..60c98b4ea 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -33,6 +33,7 @@ module Simplex.Messaging.Agent
     AgentClient (..),
     AE,
     SubscriptionsInfo (..),
+    MsgReq,
     getSMPAgentClient,
     getSMPAgentClient_,
     disconnectAgentClient,
@@ -393,6 +394,10 @@ sendMessage :: AgentClient -> ConnId -> PQEncryption -> MsgFlags -> MsgBody -> A
 sendMessage c = withAgentEnv c .:: sendMessage' c
 {-# INLINE sendMessage #-}
 
+-- When sending multiple messages to the same connection,
+-- only the first MsgReq for this connection should have non-empty ConnId.
+-- All subsequent MsgReq in traversable for this connection must be empty.
+-- This is done to optimize processing by grouping all messages to one connection together.
 type MsgReq = (ConnId, PQEncryption, MsgFlags, MsgBody)
 
 -- | Send multiple messages to different connections (SEND command)
@@ -1057,38 +1062,49 @@ sendMessages' c = sendMessagesB' c . map Right
 
 sendMessagesB' :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType MsgReq) -> AM (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
 sendMessagesB' c reqs = do
-  connIds <- liftEither $ foldl' addConnId (Right S.empty) reqs
+  (_, connIds) <- liftEither $ foldl' addConnId (Right ("", S.empty)) reqs
   lift $ sendMessagesB_ c reqs connIds
   where
-    addConnId s@(Right s') (Right (connId, _, _, _))
-      | B.null connId = s
-      | connId `S.notMember` s' = Right $ S.insert connId s'
-      | otherwise = Left $ INTERNAL "sendMessages: duplicate connection ID"
-    addConnId s _ = s
+    addConnId acc@(Right (prevId, s)) (Right (connId, _, _, _))
+      | B.null connId = if B.null prevId then Left $ INTERNAL "sendMessages: empty first connId" else acc
+      | connId `S.member` s = Left $ INTERNAL "sendMessages: duplicate connId"
+      | otherwise = Right (connId, S.insert connId s)
+    addConnId acc _ = acc
 
 sendMessagesB_ :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType MsgReq) -> Set ConnId -> AM' (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
 sendMessagesB_ c reqs connIds = withConnLocks c connIds "sendMessages" $ do
-  reqs' <- withStoreBatch c (\db -> fmap (bindRight $ \req@(connId, _, _, _) -> bimap storeError (req,) <$> getConn db connId) reqs)
+  prev <- newTVarIO Nothing
+  reqs' <- withStoreBatch c $ \db -> fmap (bindRight $ getConn_ db prev) reqs
   let (toEnable, reqs'') = mapAccumL prepareConn [] reqs'
-  void $ withStoreBatch' c $ \db -> map (\connId -> setConnPQSupport db connId PQSupportOn) toEnable
+  void $ withStoreBatch' c $ \db -> map (\connId -> setConnPQSupport db connId PQSupportOn) $ S.toList toEnable
   enqueueMessagesB c reqs''
   where
-    prepareConn :: [ConnId] -> Either AgentErrorType (MsgReq, SomeConn) -> ([ConnId], Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage))
-    prepareConn acc (Left e) = (acc, Left e)
-    prepareConn acc (Right ((_, pqEnc, msgFlags, msg), SomeConn _ conn)) = case conn of
+    getConn_ :: DB.Connection -> TVar (Maybe (Either AgentErrorType SomeConn)) -> MsgReq -> IO (Either AgentErrorType (MsgReq, SomeConn))
+    getConn_ db prev req@(connId, _, _, _) =
+      (req,) <$$> 
+        if B.null connId
+          then fromMaybe (Left $ INTERNAL "sendMessagesB_: empty prev connId") <$> atomically (readTVar prev)
+          else do
+            conn <- first storeError <$> getConn db connId
+            conn <$ atomically (writeTVar prev $ Just conn)
+    prepareConn :: Set ConnId -> Either AgentErrorType (MsgReq, SomeConn) -> (Set ConnId, Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage))
+    prepareConn s (Left e) = (s, Left e)
+    prepareConn s (Right ((_, pqEnc, msgFlags, msg), SomeConn _ conn)) = case conn of
       DuplexConnection cData _ sqs -> prepareMsg cData sqs
       SndConnection cData sq -> prepareMsg cData [sq]
-      _ -> (acc, Left $ CONN SIMPLEX)
+      _ -> (s, Left $ CONN SIMPLEX)
       where
-        prepareMsg :: ConnData -> NonEmpty SndQueue -> ([ConnId], Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage))
+        prepareMsg :: ConnData -> NonEmpty SndQueue -> (Set ConnId, Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage))
         prepareMsg cData@ConnData {connId, pqSupport} sqs
-          | ratchetSyncSendProhibited cData = (acc, Left $ CMD PROHIBITED "sendMessagesB: send prohibited")
+          | ratchetSyncSendProhibited cData = (s, Left $ CMD PROHIBITED "sendMessagesB: send prohibited")
           -- connection is only updated if PQ encryption was disabled, and now it has to be enabled.
           -- support for PQ encryption (small message envelopes) will not be disabled when message is sent.
           | pqEnc == PQEncOn && pqSupport == PQSupportOff =
               let cData' = cData {pqSupport = PQSupportOn} :: ConnData
-               in (connId : acc, Right (cData', sqs, Just pqEnc, msgFlags, A_MSG msg))
-          | otherwise = (acc, Right (cData, sqs, Just pqEnc, msgFlags, A_MSG msg))
+               in (S.insert connId s, mkReq cData')
+          | otherwise = (s, mkReq cData)
+          where
+            mkReq cData' = Right (cData', sqs, Just pqEnc, msgFlags, A_MSG msg)
 
 -- / async command processing v v v
 
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 53991ed12..0ab162d08 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -357,6 +357,9 @@ functionalAPITests t = do
     it "should subscribe to multiple connections with pending messages" $
       withSmpServer t $
         testBatchedPendingMessages 10 5
+  describe "Batch send messages" $ do
+    it "should send multiple messages to the same connection" $ withSmpServer t testSendMessagesB
+    it "should send messages to the 2 connections" $ withSmpServer t testSendMessagesB2
   describe "Async agent commands" $ do
     describe "connect using async agent commands" $
       testBasicMatrix2 t testAsyncCommands
@@ -1932,6 +1935,48 @@ testBatchedPendingMessages nCreate nMsgs =
     withA = withAgent 1 agentCfg initAgentServers testDB
     withB = withAgent 2 agentCfg initAgentServers testDB2
 
+testSendMessagesB :: IO ()
+testSendMessagesB = withAgentClients2 $ \a b -> runRight_ $ do
+  (aId, bId) <- makeConnection a b
+  let msg cId body = Right (cId, PQEncOn, SMP.noMsgFlags, body)
+  [SentB 2, SentB 3, SentB 4] <- sendMessagesB a ([msg bId "msg 1", msg "" "msg 2", msg "" "msg 3"] :: [Either AgentErrorType MsgReq])
+  get a ##> ("", bId, SENT 2)
+  get a ##> ("", bId, SENT 3)
+  get a ##> ("", bId, SENT 4)
+  receiveMsg b aId 2 "msg 1"
+  receiveMsg b aId 3 "msg 2"
+  receiveMsg b aId 4 "msg 3"
+
+testSendMessagesB2 :: IO ()
+testSendMessagesB2 = withAgentClients3 $ \a b c -> runRight_ $ do
+  (abId, bId) <- makeConnection a b
+  (acId, cId) <- makeConnection a c
+  let msg connId body = Right (connId, PQEncOn, SMP.noMsgFlags, body)
+  [SentB 2, SentB 3, SentB 4, SentB 2, SentB 3] <-
+    sendMessagesB a ([msg bId "msg 1", msg "" "msg 2", msg "" "msg 3", msg cId "msg 4", msg "" "msg 5"] :: [Either AgentErrorType MsgReq])
+  liftIO $
+    getInAnyOrder
+      a
+      [ \case ("", cId', AEvt SAEConn (SENT 2)) -> cId' == bId; _ -> False,
+        \case ("", cId', AEvt SAEConn (SENT 3)) -> cId' == bId; _ -> False,
+        \case ("", cId', AEvt SAEConn (SENT 4)) -> cId' == bId; _ -> False,
+        \case ("", cId', AEvt SAEConn (SENT 2)) -> cId' == cId; _ -> False,
+        \case ("", cId', AEvt SAEConn (SENT 3)) -> cId' == cId; _ -> False
+      ]
+  receiveMsg b abId 2 "msg 1"
+  receiveMsg b abId 3 "msg 2"
+  receiveMsg b abId 4 "msg 3"
+  receiveMsg c acId 2 "msg 4"
+  receiveMsg c acId 3 "msg 5"
+
+pattern SentB :: AgentMsgId -> Either AgentErrorType (AgentMsgId, PQEncryption)
+pattern SentB msgId <- Right (msgId, PQEncOn)
+
+receiveMsg :: AgentClient -> ConnId -> AgentMsgId -> MsgBody -> ExceptT AgentErrorType IO ()
+receiveMsg c cId msgId msg  = do
+  get c =##> \case ("", cId', Msg' mId' PQEncOn msg') -> cId' == cId && mId' == msgId && msg' == msg; _ -> False
+  ackMessage c cId msgId Nothing
+
 testAsyncCommands :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 testAsyncCommands sqSecured alice bob baseId =
   runRight_ $ do

From f4d1a33ed807a5fcbd152817143cf732d4de78c9 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 5 Aug 2024 15:09:46 +0100
Subject: [PATCH 056/195] agent: retry loop that resumes subscriptions as soon
 as agent is moved to foreground, suspend retry loops while agent is suspended
 (#1249)

* agent: retry loop that resumes subscriptions as soon as agent is moved to foreground, suspend retry loops while agent is suspended

* reset retry enterval when moving to foreground

* account for network state too

* simplify

* typo

* simplify
---
 src/Simplex/FileTransfer/Agent.hs             |  4 +
 src/Simplex/Messaging/Agent.hs                |  5 +-
 src/Simplex/Messaging/Agent/Client.hs         | 11 ++-
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |  4 +-
 .../Messaging/Agent/NtfSubSupervisor.hs       |  2 +
 src/Simplex/Messaging/Agent/RetryInterval.hs  | 25 +++++-
 tests/AgentTests/FunctionalAPITests.hs        | 19 +++--
 tests/CoreTests/RetryIntervalTests.hs         | 82 +++++++++++++++++--
 8 files changed, 132 insertions(+), 20 deletions(-)

diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 8ca537e53..c82316c82 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -194,6 +194,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
         (fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _}, approvedRelays) -> do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
+            atomically $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             atomically $ incXFTPServerStat c userId srv downloadAttempts
             downloadFileChunk fc replica approvedRelays
@@ -463,6 +464,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
               let AgentClient {xftpServers} = c
               userSrvCount <- length <$> atomically (TM.lookup userId xftpServers)
               withRetryIntervalCount (riFast ri) $ \n _ loop -> do
+                atomically $ waitWhileSuspended c
                 liftIO $ waitForUserNetwork c
                 let triedAllSrvs = n > userSrvCount
                 createWithNextSrv usedSrvs
@@ -502,6 +504,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
         fc@SndFileChunk {userId, sndFileId, sndFileEntityId, filePrefixPath, digest, replicas = replica@SndFileChunkReplica {sndChunkReplicaId, server, delay} : _} -> do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
+            atomically $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             atomically $ incXFTPServerStat c userId srv uploadAttempts
             uploadFileChunk cfg fc replica
@@ -674,6 +677,7 @@ runXFTPDelWorker c srv Worker {doWork} = do
         processDeletedReplica replica@DeletedSndChunkReplica {deletedSndChunkReplicaId, userId, server, chunkDigest, delay} = do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
+            atomically $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             atomically $ incXFTPServerStat c userId srv deleteAttempts
             deleteChunkReplica
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 60c98b4ea..c8ffe7a50 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1252,7 +1252,9 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
           withStore c (`getConn` connId) >>= \case
             SomeConn _ conn@DuplexConnection {} -> a conn
             _ -> internalErr "command requires duplex connection"
-        tryCommand action = withRetryInterval ri $ \_ loop ->
+        tryCommand action = withRetryInterval ri $ \_ loop -> do
+          atomically $ waitWhileSuspended c
+          liftIO $ waitForUserNetwork c
           tryError action >>= \case
             Left e
               | temporaryOrHostError e -> retrySndOp c loop
@@ -1369,6 +1371,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
         let mId = unId msgId
             ri' = maybe id updateRetryInterval2 msgRetryState ri
         withRetryLock2 ri' qLock $ \riState loop -> do
+          atomically $ waitWhileSuspended c
           liftIO $ waitForUserNetwork c
           resp <- tryError $ case msgType of
             AM_CONN_INFO -> sendConfirmation c sq msgBody
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 55caf754c..d3e1f2eca 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -127,6 +127,7 @@ module Simplex.Messaging.Agent.Client
     beginAgentOperation,
     endAgentOperation,
     waitUntilForeground,
+    waitWhileSuspended,
     suspendSendingAndDatabase,
     suspendOperation,
     notifySuspended,
@@ -716,12 +717,14 @@ resubscribeSMPSession c@AgentClient {smpSubWorkers, workerSeq} tSess = do
       atomically $ putTMVar (sessionVar v) a
     runSubWorker = do
       ri <- asks $ reconnectInterval . config
-      withRetryInterval ri $ \_ loop -> do
+      withRetryForeground ri isForeground (isNetworkOnline c) $ \_ loop -> do
         pending <- atomically getPending
         forM_ (L.nonEmpty pending) $ \qs -> do
+          atomically $ waitUntilForeground c
           liftIO $ waitForUserNetwork c
           reconnectSMPClient c tSess qs
           loop
+    isForeground = (ASForeground ==) <$> readTVar (agentState c)
     getPending = RQ.getSessQueues tSess $ pendingSubs c
     cleanup :: SessionVar (Async ()) -> STM ()
     cleanup v = do
@@ -1873,6 +1876,12 @@ waitUntilForeground :: AgentClient -> STM ()
 waitUntilForeground c = unlessM ((ASForeground ==) <$> readTVar (agentState c)) retry
 {-# INLINE waitUntilForeground #-}
 
+-- This function waits while agent is suspended, but will proceed while it is suspending,
+-- to allow completing in-flight operations.
+waitWhileSuspended :: AgentClient -> STM ()
+waitWhileSuspended c = unlessM ((ASSuspended /=) <$> readTVar (agentState c)) retry
+{-# INLINE waitWhileSuspended #-}
+
 withStore' :: AgentClient -> (DB.Connection -> IO a) -> AM a
 withStore' c action = withStore c $ fmap Right . action
 {-# INLINE withStore' #-}
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 6932764c3..86203266b 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -162,7 +162,7 @@ defaultReconnectInterval =
   RetryInterval
     { initialInterval = 2_000000,
       increaseAfter = 10_000000,
-      maxInterval = 60_000000
+      maxInterval = 180_000000
     }
 
 defaultMessageRetryInterval :: RetryInterval2
@@ -172,7 +172,7 @@ defaultMessageRetryInterval =
         RetryInterval
           { initialInterval = 2_000000,
             increaseAfter = 10_000000,
-            maxInterval = 60_000000
+            maxInterval = 120_000000
           },
       riSlow =
         RetryInterval
diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
index 689e5fcce..249aad942 100644
--- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
+++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
@@ -159,6 +159,7 @@ runNtfWorker c srv Worker {doWork} =
           logInfo $ "runNtfWorker, nextSub " <> tshow nextSub
           ri <- asks $ reconnectInterval . config
           withRetryInterval ri $ \_ loop -> do
+            atomically $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             processSub nextSub
               `catchAgentError` retryOnError c "NtfWorker" loop (workerInternalError c connId . show)
@@ -243,6 +244,7 @@ runNtfSMPWorker c srv Worker {doWork} = do
           logInfo $ "runNtfSMPWorker, nextSub " <> tshow nextSub
           ri <- asks $ reconnectInterval . config
           withRetryInterval ri $ \_ loop -> do
+            atomically $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             processSub nextSub
               `catchAgentError` retryOnError c "NtfSMPWorker" loop (workerInternalError c connId . show)
diff --git a/src/Simplex/Messaging/Agent/RetryInterval.hs b/src/Simplex/Messaging/Agent/RetryInterval.hs
index 00fe4039e..35fa7c5c6 100644
--- a/src/Simplex/Messaging/Agent/RetryInterval.hs
+++ b/src/Simplex/Messaging/Agent/RetryInterval.hs
@@ -9,6 +9,7 @@ module Simplex.Messaging.Agent.RetryInterval
     RI2State (..),
     withRetryInterval,
     withRetryIntervalCount,
+    withRetryForeground,
     withRetryLock2,
     updateRetryInterval2,
     nextRetryDelay,
@@ -16,10 +17,11 @@ module Simplex.Messaging.Agent.RetryInterval
 where
 
 import Control.Concurrent (forkIO)
+import Control.Concurrent.STM (retry)
 import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Int (Int64)
-import Simplex.Messaging.Util (threadDelay', whenM)
+import Simplex.Messaging.Util (threadDelay', unlessM, whenM)
 import UnliftIO.STM
 
 data RetryInterval = RetryInterval
@@ -63,6 +65,27 @@ withRetryIntervalCount ri action = callAction 0 0 $ initialInterval ri
           let elapsed' = elapsed + delay
           callAction (n + 1) elapsed' $ nextRetryDelay elapsed' delay ri
 
+withRetryForeground :: forall m a. MonadIO m => RetryInterval -> STM Bool -> STM Bool -> (Int64 -> m a -> m a) -> m a
+withRetryForeground ri isForeground isOnline action = callAction 0 $ initialInterval ri
+  where
+    callAction :: Int64 -> Int64 -> m a
+    callAction elapsed delay = action delay loop
+      where
+        loop = do
+          -- limit delay to max Int value (~36 minutes on for 32 bit architectures)
+          d <- registerDelay $ fromIntegral $ min delay (fromIntegral (maxBound :: Int))
+          (wasForeground, wasOnline) <- atomically $ (,) <$> isForeground <*> isOnline
+          reset <- atomically $ do
+            foreground <- isForeground
+            online <- isOnline
+            let reset = (not wasForeground && foreground) || (not wasOnline && online)
+            unlessM ((reset ||) <$> readTVar d) retry
+            pure reset
+          let (elapsed', delay')
+                | reset = (0, initialInterval ri)
+                | otherwise = (elapsed + delay, nextRetryDelay elapsed' delay ri)
+          callAction elapsed' delay'
+
 -- This function allows action to toggle between slow and fast retry intervals.
 withRetryLock2 :: forall m. MonadIO m => RetryInterval2 -> TMVar () -> (RI2State -> (RetryIntervalMode -> m ()) -> m ()) -> m ()
 withRetryLock2 RetryInterval2 {riSlow, riFast} lock action =
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 0ab162d08..4d61d8463 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -1813,7 +1813,6 @@ testSuspendingAgentCompleteSending t = withAgentClients2 $ \a b -> do
     get b =##> \case ("", c, Msg "hello") -> c == aId; _ -> False
     ackMessage b aId 2 Nothing
     pure (aId, bId)
-
   runRight_ $ do
     ("", "", DOWN {}) <- nGet a
     ("", "", DOWN {}) <- nGet b
@@ -1821,15 +1820,17 @@ testSuspendingAgentCompleteSending t = withAgentClients2 $ \a b -> do
     4 <- sendMessage b aId SMP.noMsgFlags "how are you?"
     liftIO $ threadDelay 100000
     liftIO $ suspendAgent b 5000000
-
   withSmpServerStoreLogOn t testPort $ \_ -> runRight_ @AgentErrorType $ do
-    pGet b =##> \case ("", c, AEvt SAEConn (SENT 3)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
-    pGet b =##> \case ("", c, AEvt SAEConn (SENT 3)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
-    pGet b =##> \case ("", c, AEvt SAEConn (SENT 4)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
-    ("", "", SUSPENDED) <- nGet b
-
-    pGet a =##> \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; ("", "", AEvt _ UP {}) -> True; _ -> False
-    pGet a =##> \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; ("", "", AEvt _ UP {}) -> True; _ -> False
+    -- there will be no UP event for b, because re-subscriptions are suspended until the agent is in foreground
+    get b =##> \case ("", c, SENT 3) -> c == aId; _ -> False
+    get b =##> \case ("", c, SENT 4) -> c == aId; _ -> False
+    nGet b ##> ("", "", SUSPENDED)
+    liftIO $
+      getInAnyOrder
+        a
+        [ \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; _ -> False,
+          \case ("", "", AEvt _ UP {}) -> True; _ -> False
+        ]
     ackMessage a bId 3 Nothing
     get a =##> \case ("", c, Msg "how are you?") -> c == bId; _ -> False
     ackMessage a bId 4 Nothing
diff --git a/tests/CoreTests/RetryIntervalTests.hs b/tests/CoreTests/RetryIntervalTests.hs
index 7097df989..da96d0208 100644
--- a/tests/CoreTests/RetryIntervalTests.hs
+++ b/tests/CoreTests/RetryIntervalTests.hs
@@ -2,6 +2,8 @@
 
 module CoreTests.RetryIntervalTests where
 
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.Async (concurrently_)
 import Control.Concurrent.STM
 import Control.Monad (when)
 import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds)
@@ -13,6 +15,10 @@ retryIntervalTests = do
   describe "Retry interval with 2 modes and lock" $ do
     testRetryIntervalSameMode
     testRetryIntervalSwitchMode
+  describe "Foreground retry interval" $ do 
+    testRetryForeground
+    testRetryToBackground
+    testRetrySkipWhenForeground
 
 testRI :: RetryInterval2
 testRI =
@@ -23,12 +29,15 @@ testRI =
             increaseAfter = 40000,
             maxInterval = 40000
           },
-      riFast =
-        RetryInterval
-          { initialInterval = 10000,
-            increaseAfter = 20000,
-            maxInterval = 40000
-          }
+      riFast = testFastRI
+    }
+
+testFastRI :: RetryInterval
+testFastRI =
+  RetryInterval
+    { initialInterval = 10000,
+      increaseAfter = 20000,
+      maxInterval = 40000
     }
 
 testRetryIntervalSameMode :: Spec
@@ -81,6 +90,67 @@ testRetryIntervalSwitchMode =
                        (40000, 40000)
                      ]
 
+testRetryForeground :: Spec
+testRetryForeground =
+  it "should increase elapased time and interval" $ do
+    intervals <- newTVarIO []
+    reportedIntervals <- newTVarIO []
+    ts <- newTVarIO =<< getCurrentTime
+    let isForeground = pure True
+    withRetryForeground testFastRI isForeground (pure True) $ \delay loop -> do
+      ints <- addInterval intervals ts
+      atomically $ modifyTVar' reportedIntervals (delay :)
+      when (length ints < 8) $ loop
+    (reverse <$> readTVarIO intervals) `shouldReturn` [0, 1, 1, 1, 2, 3, 4, 4]
+    (reverse <$> readTVarIO reportedIntervals)
+      `shouldReturn` [ 10000, 10000, 15000, 22500, 33750, 40000, 40000, 40000]
+
+testRetryToBackground :: Spec
+testRetryToBackground =
+  it "should not change interval when moving to background" $ do
+    intervals <- newTVarIO []
+    reportedIntervals <- newTVarIO []
+    ts <- newTVarIO =<< getCurrentTime
+    foreground <- newTVarIO True
+    concurrently_
+      ( do
+          threadDelay 50000
+          atomically $ writeTVar foreground False
+      )
+      ( withRetryForeground testFastRI (readTVar foreground) (pure True) $ \delay loop -> do
+          ints <- addInterval intervals ts
+          atomically $ modifyTVar' reportedIntervals (delay :)
+          when (length ints < 8) $ loop
+      )
+    (reverse <$> readTVarIO intervals) `shouldReturn` [0, 1, 1, 1, 2, 3, 4, 4]
+    (reverse <$> readTVarIO reportedIntervals)
+      `shouldReturn` [ 10000, 10000, 15000, 22500, 33750, 40000, 40000, 40000]
+
+testRetrySkipWhenForeground :: Spec
+testRetrySkipWhenForeground =
+  it "should repeat loop as soon as moving to foreground" $ do
+    intervals <- newTVarIO []
+    reportedIntervals <- newTVarIO []
+    ts <- newTVarIO =<< getCurrentTime
+    foreground <- newTVarIO False
+    concurrently_
+      ( do
+          threadDelay 65000
+          atomically $ writeTVar foreground True
+          threadDelay 10000
+          atomically $ writeTVar foreground False
+          threadDelay 100000
+          atomically $ writeTVar foreground True
+      )
+      ( withRetryForeground testFastRI (readTVar foreground) (pure True) $ \delay loop -> do
+          ints <- addInterval intervals ts
+          atomically $ modifyTVar' reportedIntervals (delay :)
+          when (length ints < 12) $ loop
+      )
+    (reverse <$> readTVarIO intervals) `shouldReturn` [0, 1, 1, 1, 2, 0, 1, 1, 1, 2, 3, 1]
+    (reverse <$> readTVarIO reportedIntervals)
+      `shouldReturn` [ 10000, 10000, 15000, 22500, 33750, 10000, 10000, 15000, 22500, 33750, 40000, 10000]
+
 addInterval :: TVar [Int] -> TVar UTCTime -> IO [Int]
 addInterval intervals ts = do
   ts' <- getCurrentTime

From a017047c52cdfa143fefcad2e6ac8b5d8b4e39e7 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 6 Aug 2024 08:17:38 +0100
Subject: [PATCH 057/195] smp server: fix race when client is marked as
 subscribed after it is disconnected, preventing its GC (#1250)

* smp server: fix race when client is marked as subscribed after it is disconnected, preventing its GC

* refactor
---
 src/Simplex/Messaging/Server.hs | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index f8927d21d..fb39c3240 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -169,23 +169,26 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       M ()
     serverThread s label subQ subs clientSubs unsub = do
       labelMyThread label
+      cls <- asks clients
       forever $
-        atomically updateSubscribers
+        atomically (updateSubscribers cls)
           $>>= endPreviousSubscriptions
           >>= liftIO . mapM_ unsub
       where
-        updateSubscribers :: STM (Maybe (QueueId, Client))
-        updateSubscribers = do
+        updateSubscribers :: TVar (IM.IntMap Client) -> STM (Maybe (QueueId, Client))
+        updateSubscribers cls = do
           (qId, clnt, subscribed) <- readTQueue $ subQ s
+          current <- IM.member (clientId clnt) <$> readTVar cls
           let updateSub
-                | subscribed = TM.lookupInsert qId clnt (subs s)
-                | otherwise = TM.lookupDelete qId (subs s)
+                | not subscribed = TM.lookupDelete
+                | not current = TM.lookup -- do not insert client if it is already disconnected, but send END to any other client
+                | otherwise = (`TM.lookupInsert` clnt) -- insert subscribed and current client
               clientToBeNotified c'
                 | sameClientId clnt c' = pure Nothing
                 | otherwise = do
                     yes <- readTVar $ connected c'
                     pure $ if yes then Just (qId, c') else Nothing
-          updateSub $>>= clientToBeNotified
+          updateSub qId (subs s) $>>= clientToBeNotified
         endPreviousSubscriptions :: (QueueId, Client) -> M (Maybe s)
         endPreviousSubscriptions (qId, c) = do
           forkClient c (label <> ".endPreviousSubscriptions") $

From a76e15fd77d68a09bc43820c1cf6bd1c71700100 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 6 Aug 2024 12:39:11 +0100
Subject: [PATCH 058/195] 6.0.0.6

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index 68b944385..d31beffd4 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.0.5
+version: 6.0.0.6
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 946c8e3b6..819506457 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.0.5
+version:        6.0.0.6
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From fc6b9c0e1b197d435b95b7b385f4c4f65f91b632 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Wed, 7 Aug 2024 13:14:09 +0100
Subject: [PATCH 059/195] agent: stop statistics and cleanup when chat is
 stopped (#1251)

---
 src/Simplex/Messaging/Agent.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index c8ffe7a50..f7e70b721 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -235,6 +235,7 @@ logServersStats c = do
   liftIO $ threadDelay' delay
   int <- asks (logStatsInterval . config)
   forever $ do
+    atomically $ waitUntilActive c
     saveServersStats c
     liftIO $ threadDelay' int
 
@@ -2112,6 +2113,7 @@ cleanupManager c@AgentClient {subQ} = do
   int <- asks (cleanupInterval . config)
   ttl <- asks $ storedMsgDataTTL . config
   forever $ do
+    atomically $ waitUntilActive c
     run ERR deleteConns
     run ERR $ withStore' c (`deleteRcvMsgHashesExpired` ttl)
     run ERR $ withStore' c (`deleteSndMsgsExpired` ttl)

From 7d8457263bb77c6d9cb1cd102c3c70177e75327f Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Thu, 8 Aug 2024 13:15:01 +0100
Subject: [PATCH 060/195] 6.0.0.7

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index d31beffd4..fd2139201 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.0.6
+version: 6.0.0.7
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 819506457..37adcec2e 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.0.6
+version:        6.0.0.7
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 7762b4d364e9e1b0217fbdccd994197f6f60898a Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 9 Aug 2024 16:38:46 +0100
Subject: [PATCH 061/195] reduce the number of STM transactions (#1255)

* reduce the number of STM transactions

* reduce STM more

* refactor

* remove more
---
 src/Simplex/FileTransfer/Agent.hs             |  44 ++--
 src/Simplex/FileTransfer/Client/Agent.hs      |   4 +-
 src/Simplex/FileTransfer/Client/Main.hs       |   6 +-
 src/Simplex/FileTransfer/Server.hs            |   4 +-
 src/Simplex/FileTransfer/Server/Env.hs        |  13 +-
 src/Simplex/FileTransfer/Server/Stats.hs      |  44 ++--
 src/Simplex/FileTransfer/Server/Store.hs      |   8 +-
 src/Simplex/Messaging/Agent.hs                |  32 +--
 src/Simplex/Messaging/Agent/Client.hs         | 204 +++++++++---------
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |  24 +--
 .../Messaging/Agent/NtfSubSupervisor.hs       |   6 +-
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |   9 +-
 .../Messaging/Agent/Store/SQLite/Common.hs    |   2 +-
 .../Messaging/Agent/Store/SQLite/DB.hs        |   2 +-
 src/Simplex/Messaging/Agent/TRcvQueues.hs     |  12 +-
 src/Simplex/Messaging/Client.hs               |  50 ++---
 src/Simplex/Messaging/Client/Agent.hs         |  33 +--
 src/Simplex/Messaging/Notifications/Server.hs |  10 +-
 .../Messaging/Notifications/Server/Env.hs     |  51 +++--
 .../Messaging/Notifications/Server/Stats.hs   |  36 ++--
 .../Messaging/Notifications/Server/Store.hs   |  15 +-
 src/Simplex/Messaging/Server.hs               |  16 +-
 src/Simplex/Messaging/Server/Env/STM.hs       |  62 +++---
 src/Simplex/Messaging/Server/MsgStore/STM.hs  |   4 +-
 .../Messaging/Server/QueueStore/STM.hs        |   8 +-
 src/Simplex/Messaging/Server/Stats.hs         | 188 ++++++++--------
 src/Simplex/Messaging/TMap.hs                 |  18 +-
 src/Simplex/Messaging/Transport.hs            |   2 +-
 src/Simplex/Messaging/Transport/Buffer.hs     |   6 +-
 src/Simplex/Messaging/Transport/HTTP2.hs      |   2 +-
 .../Messaging/Transport/HTTP2/Client.hs       |   8 +-
 src/Simplex/Messaging/Transport/Server.hs     |  10 +-
 tests/CoreTests/BatchingTests.hs              |   4 +-
 tests/CoreTests/TRcvQueuesTests.hs            |  32 +--
 34 files changed, 495 insertions(+), 474 deletions(-)

diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index c82316c82..d6ee75ae9 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -184,7 +184,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
   cfg <- asks config
   forever $ do
     lift $ waitForWork doWork
-    atomically $ assertAgentForeground c
+    liftIO $ assertAgentForeground c
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
@@ -194,7 +194,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
         (fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _}, approvedRelays) -> do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
-            atomically $ waitWhileSuspended c
+            liftIO $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             atomically $ incXFTPServerStat c userId srv downloadAttempts
             downloadFileChunk fc replica approvedRelays
@@ -205,7 +205,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
                 when (serverHostError e) $ notify c rcvFileEntityId $ RFWARN e
                 liftIO $ closeXFTPServerClient c userId server digest
                 withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
-              atomically $ assertAgentForeground c
+              liftIO $ assertAgentForeground c
               loop
             retryDone e = do
               atomically . incXFTPServerStat c userId srv $ case e of
@@ -221,7 +221,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
           chunkSpec = XFTPRcvChunkSpec chunkPath chSize (unFileDigest digest)
           relChunkPath = fileTmpPath </> takeFileName chunkPath
       agentXFTPDownloadChunk c userId digest replica chunkSpec
-      atomically $ waitUntilForeground c
+      liftIO $ waitUntilForeground c
       (entityId, complete, progress) <- withStore c $ \db -> runExceptT $ do
         liftIO $ updateRcvFileChunkReceived db (rcvChunkReplicaId replica) rcvChunkId relChunkPath
         RcvFile {size = FileSize currentSize, chunks, redirect} <- ExceptT $ getRcvFile db rcvFileId
@@ -240,7 +240,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
       where
         ipAddressProtected' :: AM Bool
         ipAddressProtected' = do
-          cfg <- liftIO $ getNetworkConfig' c
+          cfg <- liftIO $ getFastNetworkConfig c
           pure $ ipAddressProtected cfg srv
         receivedSize :: [RcvFileChunk] -> Int64
         receivedSize = foldl' (\sz ch -> sz + receivedChunkSize ch) 0
@@ -273,7 +273,7 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
   cfg <- asks config
   forever $ do
     lift $ waitForWork doWork
-    atomically $ assertAgentForeground c
+    liftIO $ assertAgentForeground c
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
@@ -299,12 +299,12 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
         Nothing -> do
           notify c rcvFileEntityId $ RFDONE fsSavePath
           lift $ forM_ tmpPath (removePath <=< toFSFilePath)
-          atomically $ waitUntilForeground c
+          liftIO $ waitUntilForeground c
           withStore' c (`updateRcvFileComplete` rcvFileId)
         Just RcvFileRedirect {redirectFileInfo, redirectDbId} -> do
           let RedirectFileInfo {size = redirectSize, digest = redirectDigest} = redirectFileInfo
           lift $ forM_ tmpPath (removePath <=< toFSFilePath)
-          atomically $ waitUntilForeground c
+          liftIO $ waitUntilForeground c
           withStore' c (`updateRcvFileComplete` rcvFileId)
           -- proceed with redirect
           yaml <- liftError (FILE . FILE_IO . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `agentFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
@@ -392,7 +392,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
   cfg <- asks config
   forever $ do
     lift $ waitForWork doWork
-    atomically $ assertAgentForeground c
+    liftIO $ assertAgentForeground c
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
@@ -454,7 +454,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
           SndFileChunkReplica {server} : _ -> Right server
         createChunk :: Int -> SndFileChunk -> AM (ProtocolServer 'PXFTP)
         createChunk numRecipients' ch = do
-          atomically $ assertAgentForeground c
+          liftIO $ assertAgentForeground c
           (replica, ProtoServerWithAuth srv _) <- tryCreate
           withStore' c $ \db -> createSndFileReplica db ch replica
           pure srv
@@ -462,9 +462,9 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
             tryCreate = do
               usedSrvs <- newTVarIO ([] :: [XFTPServer])
               let AgentClient {xftpServers} = c
-              userSrvCount <- length <$> atomically (TM.lookup userId xftpServers)
+              userSrvCount <- liftIO $ length <$> TM.lookupIO userId xftpServers
               withRetryIntervalCount (riFast ri) $ \n _ loop -> do
-                atomically $ waitWhileSuspended c
+                liftIO $ waitWhileSuspended c
                 liftIO $ waitForUserNetwork c
                 let triedAllSrvs = n > userSrvCount
                 createWithNextSrv usedSrvs
@@ -474,7 +474,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
                 retryLoop loop triedAllSrvs e = do
                   flip catchAgentError (\_ -> pure ()) $ do
                     when (triedAllSrvs && serverHostError e) $ notify c sndFileEntityId $ SFWARN e
-                  atomically $ assertAgentForeground c
+                  liftIO $ assertAgentForeground c
                   loop
             createWithNextSrv usedSrvs = do
               deleted <- withStore' c $ \db -> getSndFileDeleted db sndFileId
@@ -494,7 +494,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
   cfg <- asks config
   forever $ do
     lift $ waitForWork doWork
-    atomically $ assertAgentForeground c
+    liftIO $ assertAgentForeground c
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
@@ -504,7 +504,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
         fc@SndFileChunk {userId, sndFileId, sndFileEntityId, filePrefixPath, digest, replicas = replica@SndFileChunkReplica {sndChunkReplicaId, server, delay} : _} -> do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
-            atomically $ waitWhileSuspended c
+            liftIO $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             atomically $ incXFTPServerStat c userId srv uploadAttempts
             uploadFileChunk cfg fc replica
@@ -515,7 +515,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
                 when (serverHostError e) $ notify c sndFileEntityId $ SFWARN e
                 liftIO $ closeXFTPServerClient c userId server digest
                 withStore' c $ \db -> updateSndChunkReplicaDelay db sndChunkReplicaId replicaDelay
-              atomically $ assertAgentForeground c
+              liftIO $ assertAgentForeground c
               loop
             retryDone e = do
               atomically $ incXFTPServerStat c userId srv uploadErrs
@@ -526,9 +526,9 @@ runXFTPSndWorker c srv Worker {doWork} = do
       fsFilePath <- lift $ toFSFilePath filePath
       unlessM (doesFileExist fsFilePath) $ throwE $ FILE NO_FILE
       let chunkSpec' = chunkSpec {filePath = fsFilePath} :: XFTPChunkSpec
-      atomically $ assertAgentForeground c
+      liftIO $ assertAgentForeground c
       agentXFTPUploadChunk c userId chunkDigest replica' chunkSpec'
-      atomically $ waitUntilForeground c
+      liftIO $ waitUntilForeground c
       sf@SndFile {sndFileEntityId, prefixPath, chunks} <- withStore c $ \db -> do
         updateSndChunkReplicaStatus db sndChunkReplicaId SFRSUploaded
         getSndFile db sndFileId
@@ -666,7 +666,7 @@ runXFTPDelWorker c srv Worker {doWork} = do
   cfg <- asks config
   forever $ do
     lift $ waitForWork doWork
-    atomically $ assertAgentForeground c
+    liftIO $ assertAgentForeground c
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
@@ -677,7 +677,7 @@ runXFTPDelWorker c srv Worker {doWork} = do
         processDeletedReplica replica@DeletedSndChunkReplica {deletedSndChunkReplicaId, userId, server, chunkDigest, delay} = do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
-            atomically $ waitWhileSuspended c
+            liftIO $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             atomically $ incXFTPServerStat c userId srv deleteAttempts
             deleteChunkReplica
@@ -688,7 +688,7 @@ runXFTPDelWorker c srv Worker {doWork} = do
                 when (serverHostError e) $ notify c "" $ SFWARN e
                 liftIO $ closeXFTPServerClient c userId server chunkDigest
                 withStore' c $ \db -> updateDeletedSndChunkReplicaDelay db deletedSndChunkReplicaId replicaDelay
-              atomically $ assertAgentForeground c
+              liftIO $ assertAgentForeground c
               loop
             retryDone e = do
               atomically $ incXFTPServerStat c userId srv deleteErrs
@@ -703,7 +703,7 @@ delWorkerInternalError c deletedSndChunkReplicaId e = do
   withStore' c $ \db -> deleteDeletedSndChunkReplica db deletedSndChunkReplicaId
   notify c "" $ SFERR e
 
-assertAgentForeground :: AgentClient -> STM ()
+assertAgentForeground :: AgentClient -> IO ()
 assertAgentForeground c = do
   throwWhenInactive c
   waitUntilForeground c
diff --git a/src/Simplex/FileTransfer/Client/Agent.hs b/src/Simplex/FileTransfer/Client/Agent.hs
index 86b093ee7..863a91ce1 100644
--- a/src/Simplex/FileTransfer/Client/Agent.hs
+++ b/src/Simplex/FileTransfer/Client/Agent.hs
@@ -53,9 +53,9 @@ defaultXFTPClientAgentConfig =
 data XFTPClientAgentError = XFTPClientAgentError XFTPServer XFTPClientError
   deriving (Show, Exception)
 
-newXFTPAgent :: XFTPClientAgentConfig -> STM XFTPClientAgent
+newXFTPAgent :: XFTPClientAgentConfig -> IO XFTPClientAgent
 newXFTPAgent config = do
-  xftpClients <- TM.empty
+  xftpClients <- TM.emptyIO
   pure XFTPClientAgent {xftpClients, config}
 
 type ME a = ExceptT XFTPClientAgentError IO a
diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs
index fee44832a..1eea6ef5a 100644
--- a/src/Simplex/FileTransfer/Client/Main.hs
+++ b/src/Simplex/FileTransfer/Client/Main.hs
@@ -313,7 +313,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
       pure (encPath, fdRcv, fdSnd, chunkSpecs, encSize)
     uploadFile :: TVar ChaChaDRG -> [XFTPChunkSpec] -> TVar [Int64] -> Int64 -> ExceptT CLIError IO [SentFileChunk]
     uploadFile g chunks uploadedChunks encSize = do
-      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
+      a <- liftIO $ newXFTPAgent defaultXFTPClientAgentConfig
       gen <- newTVarIO =<< liftIO newStdGen
       let xftpSrvs = fromMaybe defaultXFTPServers (nonEmpty xftpServers)
       srvs <- liftIO $ replicateM (length chunks) $ getXFTPServer gen xftpSrvs
@@ -429,7 +429,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
     receive (ValidFileDescription FileDescription {size, digest, key, nonce, chunks}) = do
       encPath <- getEncPath tempPath "xftp"
       createDirectory encPath
-      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
+      a <- liftIO $ newXFTPAgent defaultXFTPClientAgentConfig
       liftIO $ printNoNewLine "Downloading file..."
       downloadedChunks <- newTVarIO []
       let srv FileChunk {replicas} = case replicas of
@@ -494,7 +494,7 @@ cliDeleteFile DeleteOptions {fileDescription, retryCount, yes} = do
   where
     deleteFile :: ValidFileDescription 'FSender -> ExceptT CLIError IO ()
     deleteFile (ValidFileDescription FileDescription {chunks}) = do
-      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
+      a <- liftIO $ newXFTPAgent defaultXFTPClientAgentConfig
       forM_ chunks $ deleteFileChunk a
       liftIO $ do
         printNoNewLine "File deleted!"
diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index 24dcc5e38..819be9a81 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -112,7 +112,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
         Right pk' -> pure pk'
         Left e -> putStrLn ("servers has no valid key: " <> show e) >> exitFailure
       env <- ask
-      sessions <- atomically TM.empty
+      sessions <- liftIO TM.emptyIO
       let cleanup sessionId = atomically $ TM.delete sessionId sessions
       liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize serverParams transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
         reqBody <- getHTTP2Body r xftpBlockSize
@@ -576,7 +576,7 @@ incFileStat statSel = do
 saveServerStats :: M ()
 saveServerStats =
   asks (serverStatsBackupFile . config)
-    >>= mapM_ (\f -> asks serverStats >>= atomically . getFileServerStatsData >>= liftIO . saveStats f)
+    >>= mapM_ (\f -> asks serverStats >>= liftIO . getFileServerStatsData >>= liftIO . saveStats f)
   where
     saveStats f stats = do
       logInfo $ "saving server stats to file " <> T.pack f
diff --git a/src/Simplex/FileTransfer/Server/Env.hs b/src/Simplex/FileTransfer/Server/Env.hs
index f8a6bc996..1fa399a2a 100644
--- a/src/Simplex/FileTransfer/Server/Env.hs
+++ b/src/Simplex/FileTransfer/Server/Env.hs
@@ -11,7 +11,6 @@ module Simplex.FileTransfer.Server.Env where
 
 import Control.Logger.Simple
 import Control.Monad
-import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
@@ -105,17 +104,17 @@ supportedXFTPhandshakes = ["xftp/1"]
 
 newXFTPServerEnv :: XFTPServerConfig -> IO XFTPEnv
 newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, caCertificateFile, certificateFile, privateKeyFile, transportConfig} = do
-  random <- liftIO C.newRandom
-  store <- atomically newFileStore
-  storeLog <- liftIO $ mapM (`readWriteFileStore` store) storeLogFile
+  random <- C.newRandom
+  store <- newFileStore
+  storeLog <- mapM (`readWriteFileStore` store) storeLogFile
   used <- countUsedStorage <$> readTVarIO (files store)
   atomically $ writeTVar (usedStorage store) used
   forM_ fileSizeQuota $ \quota -> do
     logInfo $ "Total / available storage: " <> tshow quota <> " / " <> tshow (quota - used)
     when (quota < used) $ logInfo "WARNING: storage quota is less than used storage, no files can be uploaded!"
-  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
-  Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
-  serverStats <- atomically . newFileServerStats =<< liftIO getCurrentTime
+  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
+  Fingerprint fp <- loadFingerprint caCertificateFile
+  serverStats <- newFileServerStats =<< getCurrentTime
   pure XFTPEnv {config, store, storeLog, random, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}
 
 countUsedStorage :: M.Map k FileRec -> Int64
diff --git a/src/Simplex/FileTransfer/Server/Stats.hs b/src/Simplex/FileTransfer/Server/Stats.hs
index 08813dc2a..1178dd5f6 100644
--- a/src/Simplex/FileTransfer/Server/Stats.hs
+++ b/src/Simplex/FileTransfer/Server/Stats.hs
@@ -43,34 +43,34 @@ data FileServerStatsData = FileServerStatsData
   }
   deriving (Show)
 
-newFileServerStats :: UTCTime -> STM FileServerStats
+newFileServerStats :: UTCTime -> IO FileServerStats
 newFileServerStats ts = do
-  fromTime <- newTVar ts
-  filesCreated <- newTVar 0
-  fileRecipients <- newTVar 0
-  filesUploaded <- newTVar 0
-  filesExpired <- newTVar 0
-  filesDeleted <- newTVar 0
+  fromTime <- newTVarIO ts
+  filesCreated <- newTVarIO 0
+  fileRecipients <- newTVarIO 0
+  filesUploaded <- newTVarIO 0
+  filesExpired <- newTVarIO 0
+  filesDeleted <- newTVarIO 0
   filesDownloaded <- newPeriodStats
-  fileDownloads <- newTVar 0
-  fileDownloadAcks <- newTVar 0
-  filesCount <- newTVar 0
-  filesSize <- newTVar 0
+  fileDownloads <- newTVarIO 0
+  fileDownloadAcks <- newTVarIO 0
+  filesCount <- newTVarIO 0
+  filesSize <- newTVarIO 0
   pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}
 
-getFileServerStatsData :: FileServerStats -> STM FileServerStatsData
+getFileServerStatsData :: FileServerStats -> IO FileServerStatsData
 getFileServerStatsData s = do
-  _fromTime <- readTVar $ fromTime (s :: FileServerStats)
-  _filesCreated <- readTVar $ filesCreated s
-  _fileRecipients <- readTVar $ fileRecipients s
-  _filesUploaded <- readTVar $ filesUploaded s
-  _filesExpired <- readTVar $ filesExpired s
-  _filesDeleted <- readTVar $ filesDeleted s
+  _fromTime <- readTVarIO $ fromTime (s :: FileServerStats)
+  _filesCreated <- readTVarIO $ filesCreated s
+  _fileRecipients <- readTVarIO $ fileRecipients s
+  _filesUploaded <- readTVarIO $ filesUploaded s
+  _filesExpired <- readTVarIO $ filesExpired s
+  _filesDeleted <- readTVarIO $ filesDeleted s
   _filesDownloaded <- getPeriodStatsData $ filesDownloaded s
-  _fileDownloads <- readTVar $ fileDownloads s
-  _fileDownloadAcks <- readTVar $ fileDownloadAcks s
-  _filesCount <- readTVar $ filesCount s
-  _filesSize <- readTVar $ filesSize s
+  _fileDownloads <- readTVarIO $ fileDownloads s
+  _fileDownloadAcks <- readTVarIO $ fileDownloadAcks s
+  _filesCount <- readTVarIO $ filesCount s
+  _filesSize <- readTVarIO $ filesSize s
   pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
 
 setFileServerStats :: FileServerStats -> FileServerStatsData -> STM ()
diff --git a/src/Simplex/FileTransfer/Server/Store.hs b/src/Simplex/FileTransfer/Server/Store.hs
index aa8eaa932..b56b516aa 100644
--- a/src/Simplex/FileTransfer/Server/Store.hs
+++ b/src/Simplex/FileTransfer/Server/Store.hs
@@ -55,11 +55,11 @@ instance StrEncoding FileRecipient where
   strEncode (FileRecipient rId rKey) = strEncode rId <> ":" <> strEncode rKey
   strP = FileRecipient <$> strP <* A.char ':' <*> strP
 
-newFileStore :: STM FileStore
+newFileStore :: IO FileStore
 newFileStore = do
-  files <- TM.empty
-  recipients <- TM.empty
-  usedStorage <- newTVar 0
+  files <- TM.emptyIO
+  recipients <- TM.emptyIO
+  usedStorage <- newTVarIO 0
   pure FileStore {files, recipients, usedStorage}
 
 addFile :: FileStore -> SenderId -> FileInfo -> SystemTime -> STM (Either XFTPErrorType ())
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index f7e70b721..bdf83c8d6 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -207,7 +207,7 @@ getSMPAgentClient_ clientId cfg initServers@InitialAgentServers {smp, xftp} stor
     runAgent = do
       liftIO $ checkServers "SMP" smp >> checkServers "XFTP" xftp
       currentTs <- liftIO getCurrentTime
-      c@AgentClient {acThread} <- atomically . newAgentClient clientId initServers currentTs =<< ask
+      c@AgentClient {acThread} <- liftIO . newAgentClient clientId initServers currentTs =<< ask
       t <- runAgentThreads c `forkFinally` const (liftIO $ disconnectAgentClient c)
       atomically . writeTVar acThread . Just =<< mkWeakThreadId t
       pure c
@@ -235,15 +235,15 @@ logServersStats c = do
   liftIO $ threadDelay' delay
   int <- asks (logStatsInterval . config)
   forever $ do
-    atomically $ waitUntilActive c
+    liftIO $ waitUntilActive c
     saveServersStats c
     liftIO $ threadDelay' int
 
 saveServersStats :: AgentClient -> AM' ()
 saveServersStats c@AgentClient {subQ, smpServersStats, xftpServersStats, ntfServersStats} = do
-  sss <- mapM (lift . getAgentSMPServerStats) =<< readTVarIO smpServersStats
-  xss <- mapM (lift . getAgentXFTPServerStats) =<< readTVarIO xftpServersStats
-  nss <- mapM (lift . getAgentNtfServerStats) =<< readTVarIO ntfServersStats
+  sss <- mapM (liftIO . getAgentSMPServerStats) =<< readTVarIO smpServersStats
+  xss <- mapM (liftIO . getAgentXFTPServerStats) =<< readTVarIO xftpServersStats
+  nss <- mapM (liftIO . getAgentNtfServerStats) =<< readTVarIO ntfServersStats
   let stats = AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss, ntfServersStats = OptionalMap nss}
   tryAgentError' (withStore' c (`updateServersStats` stats)) >>= \case
     Left e -> atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
@@ -1084,7 +1084,7 @@ sendMessagesB_ c reqs connIds = withConnLocks c connIds "sendMessages" $ do
     getConn_ db prev req@(connId, _, _, _) =
       (req,) <$$> 
         if B.null connId
-          then fromMaybe (Left $ INTERNAL "sendMessagesB_: empty prev connId") <$> atomically (readTVar prev)
+          then fromMaybe (Left $ INTERNAL "sendMessagesB_: empty prev connId") <$> readTVarIO prev
           else do
             conn <- first storeError <$> getConn db connId
             conn <$ atomically (writeTVar prev $ Just conn)
@@ -1136,7 +1136,7 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
   forever $ do
     atomically $ endAgentOperation c AOSndNetwork
     lift $ waitForWork doWork
-    atomically $ throwWhenInactive c
+    liftIO $ throwWhenInactive c
     atomically $ beginAgentOperation c AOSndNetwork
     withWork c doWork (`getPendingServerCommand` server_) $ runProcessCmd (riFast ri)
   where
@@ -1254,7 +1254,7 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
             SomeConn _ conn@DuplexConnection {} -> a conn
             _ -> internalErr "command requires duplex connection"
         tryCommand action = withRetryInterval ri $ \_ loop -> do
-          atomically $ waitWhileSuspended c
+          liftIO $ waitWhileSuspended c
           liftIO $ waitForUserNetwork c
           tryError action >>= \case
             Left e
@@ -1363,8 +1363,8 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
   forever $ do
     atomically $ endAgentOperation c AOSndNetwork
     lift $ waitForWork doWork
-    atomically $ throwWhenInactive c
-    atomically $ throwWhenNoDelivery c sq
+    liftIO $ throwWhenInactive c
+    liftIO $ throwWhenNoDelivery c sq
     atomically $ beginAgentOperation c AOSndNetwork
     withWork c doWork (\db -> getPendingQueueMsg db connId sq) $
       \(rq_, PendingMsgData {msgId, msgType, msgBody, pqEncryption, msgFlags, msgRetryState, internalTs}) -> do
@@ -1372,7 +1372,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
         let mId = unId msgId
             ri' = maybe id updateRetryInterval2 msgRetryState ri
         withRetryLock2 ri' qLock $ \riState loop -> do
-          atomically $ waitWhileSuspended c
+          liftIO $ waitWhileSuspended c
           liftIO $ waitForUserNetwork c
           resp <- tryError $ case msgType of
             AM_CONN_INFO -> sendConfirmation c sq msgBody
@@ -1525,7 +1525,7 @@ retrySndOp :: AgentClient -> AM () -> AM ()
 retrySndOp c loop = do
   -- end... is in a separate atomically because if begin... blocks, SUSPENDED won't be sent
   atomically $ endAgentOperation c AOSndNetwork
-  atomically $ throwWhenInactive c
+  liftIO $ throwWhenInactive c
   atomically $ beginAgentOperation c AOSndNetwork
   loop
 
@@ -2030,7 +2030,7 @@ deleteNtfSubs c deleteCmd = do
 sendNtfConnCommands :: AgentClient -> NtfSupervisorCommand -> AM ()
 sendNtfConnCommands c cmd = do
   ns <- asks ntfSupervisor
-  connIds <- atomically $ getSubscriptions c
+  connIds <- liftIO $ getSubscriptions c
   forM_ connIds $ \connId -> do
     withStore' c (`getConnData` connId) >>= \case
       Just (ConnData {enableNtfs}, _) ->
@@ -2113,7 +2113,7 @@ cleanupManager c@AgentClient {subQ} = do
   int <- asks (cleanupInterval . config)
   ttl <- asks $ storedMsgDataTTL . config
   forever $ do
-    atomically $ waitUntilActive c
+    liftIO $ waitUntilActive c
     run ERR deleteConns
     run ERR $ withStore' c (`deleteRcvMsgHashesExpired` ttl)
     run ERR $ withStore' c (`deleteSndMsgsExpired` ttl)
@@ -2133,7 +2133,7 @@ cleanupManager c@AgentClient {subQ} = do
       step <- asks $ cleanupStepInterval . config
       liftIO $ threadDelay step
     -- we are catching it to avoid CRITICAL errors in tests when this is the only remaining handle to active
-    waitActive a = liftIO (E.tryAny . atomically $ waitUntilActive c) >>= either (\_ -> pure ()) (\_ -> void a)
+    waitActive a = liftIO (E.tryAny $ waitUntilActive c) >>= either (\_ -> pure ()) (\_ -> void a)
     deleteConns =
       withLock (deleteLock c) "cleanupManager" $ do
         void $ withStore' c getDeletedConnIds >>= deleteDeletedConns c
@@ -2258,7 +2258,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
               ack' <- handleNotifyAck $ case msg' of
                 SMP.ClientRcvMsgBody {msgTs = srvTs, msgFlags, msgBody} -> processClientMsg srvTs msgFlags msgBody
                 SMP.ClientRcvMsgQuota {} -> queueDrained >> ack
-              whenM (atomically $ hasGetLock c rq) $
+              whenM (liftIO $ hasGetLock c rq) $
                 notify (MSGNTF $ SMP.rcvMessageMeta srvMsgId msg')
               pure ack'
             where
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index d3e1f2eca..d5262d2eb 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -118,7 +118,7 @@ module Simplex.Messaging.Agent.Client
     waitUntilActive,
     UserNetworkInfo (..),
     UserNetworkType (..),
-    getNetworkConfig',
+    getFastNetworkConfig,
     waitForUserNetwork,
     isNetworkOnline,
     isOnline,
@@ -165,7 +165,7 @@ where
 import Control.Applicative ((<|>))
 import Control.Concurrent (ThreadId, forkIO)
 import Control.Concurrent.Async (Async, uninterruptibleCancel)
-import Control.Concurrent.STM (retry, throwSTM)
+import Control.Concurrent.STM (retry)
 import Control.Exception (AsyncException (..), BlockedIndefinitelyOnSTM (..))
 import Control.Logger.Simple
 import Control.Monad
@@ -453,47 +453,47 @@ data UserNetworkType = UNNone | UNCellular | UNWifi | UNEthernet | UNOther
   deriving (Eq, Show)
 
 -- | Creates an SMP agent client instance that receives commands and sends responses via 'TBQueue's.
-newAgentClient :: Int -> InitialAgentServers -> UTCTime -> Env -> STM AgentClient
+newAgentClient :: Int -> InitialAgentServers -> UTCTime -> Env -> IO AgentClient
 newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs agentEnv = do
   let cfg = config agentEnv
       qSize = tbqSize cfg
-  acThread <- newTVar Nothing
-  active <- newTVar True
-  subQ <- newTBQueue qSize
-  msgQ <- newTBQueue qSize
-  smpServers <- newTVar $ M.map mkUserServers smp
-  smpClients <- TM.empty
-  smpProxiedRelays <- TM.empty
-  ntfServers <- newTVar ntf
-  ntfClients <- TM.empty
-  xftpServers <- newTVar $ M.map mkUserServers xftp
-  xftpClients <- TM.empty
-  useNetworkConfig <- newTVar (slowNetworkConfig netCfg, netCfg)
-  userNetworkInfo <- newTVar $ UserNetworkInfo UNOther True
-  userNetworkUpdated <- newTVar Nothing
-  subscrConns <- newTVar S.empty
+  acThread <- newTVarIO Nothing
+  active <- newTVarIO True
+  subQ <- newTBQueueIO qSize
+  msgQ <- newTBQueueIO qSize
+  smpServers <- newTVarIO $ M.map mkUserServers smp
+  smpClients <- TM.emptyIO
+  smpProxiedRelays <- TM.emptyIO
+  ntfServers <- newTVarIO ntf
+  ntfClients <- TM.emptyIO
+  xftpServers <- newTVarIO $ M.map mkUserServers xftp
+  xftpClients <- TM.emptyIO
+  useNetworkConfig <- newTVarIO (slowNetworkConfig netCfg, netCfg)
+  userNetworkInfo <- newTVarIO $ UserNetworkInfo UNOther True
+  userNetworkUpdated <- newTVarIO Nothing
+  subscrConns <- newTVarIO S.empty
   activeSubs <- RQ.empty
   pendingSubs <- RQ.empty
-  removedSubs <- TM.empty
-  workerSeq <- newTVar 0
-  smpDeliveryWorkers <- TM.empty
-  asyncCmdWorkers <- TM.empty
-  connCmdsQueued <- TM.empty
-  ntfNetworkOp <- newTVar $ AgentOpState False 0
-  rcvNetworkOp <- newTVar $ AgentOpState False 0
-  msgDeliveryOp <- newTVar $ AgentOpState False 0
-  sndNetworkOp <- newTVar $ AgentOpState False 0
-  databaseOp <- newTVar $ AgentOpState False 0
-  agentState <- newTVar ASForeground
-  getMsgLocks <- TM.empty
-  connLocks <- TM.empty
-  invLocks <- TM.empty
-  deleteLock <- createLock
-  smpSubWorkers <- TM.empty
-  smpServersStats <- TM.empty
-  xftpServersStats <- TM.empty
-  ntfServersStats <- TM.empty
-  srvStatsStartedAt <- newTVar currentTs
+  removedSubs <- TM.emptyIO
+  workerSeq <- newTVarIO 0
+  smpDeliveryWorkers <- TM.emptyIO
+  asyncCmdWorkers <- TM.emptyIO
+  connCmdsQueued <- TM.emptyIO
+  ntfNetworkOp <- newTVarIO $ AgentOpState False 0
+  rcvNetworkOp <- newTVarIO $ AgentOpState False 0
+  msgDeliveryOp <- newTVarIO $ AgentOpState False 0
+  sndNetworkOp <- newTVarIO $ AgentOpState False 0
+  databaseOp <- newTVarIO $ AgentOpState False 0
+  agentState <- newTVarIO ASForeground
+  getMsgLocks <- TM.emptyIO
+  connLocks <- TM.emptyIO
+  invLocks <- TM.emptyIO
+  deleteLock <- atomically createLock
+  smpSubWorkers <- TM.emptyIO
+  smpServersStats <- TM.emptyIO
+  xftpServersStats <- TM.emptyIO
+  ntfServersStats <- TM.emptyIO
+  srvStatsStartedAt <- newTVarIO currentTs
   return
     AgentClient
       { acThread,
@@ -600,7 +600,7 @@ getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
     >>= either newClient (waitForProtocolClient c tSess smpClients)
   where
     newClient v = do
-      prs <- atomically TM.empty
+      prs <- liftIO TM.emptyIO
       smpConnectClient c tSess prs v
 
 getSMPProxyClient :: AgentClient -> Maybe SMPServerWithAuth -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
@@ -618,11 +618,10 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
       (tSess,auth,) <$> getSessVar workerSeq tSess smpClients ts
     newProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> UTCTime -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
     newProxyClient tSess auth ts v = do
-      (prs, rv) <- atomically $ do
-        prs <- TM.empty
-        -- we do not need to check if it is a new proxied relay session,
-        -- as the client is just created and there are no sessions yet
-        (prs,) . either id id <$> getSessVar workerSeq destSrv prs ts
+      prs <- liftIO TM.emptyIO
+      -- we do not need to check if it is a new proxied relay session,
+      -- as the client is just created and there are no sessions yet
+      rv <- atomically $ either id id <$> getSessVar workerSeq destSrv prs ts
       clnt <- smpConnectClient c tSess prs v
       (clnt,) <$> newProxiedRelay clnt auth rv
     waitForProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
@@ -648,7 +647,7 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
             pure $ Left e
     waitForProxiedRelay :: SMPTransportSession -> ProxiedRelayVar -> AM (Either AgentErrorType ProxiedRelay)
     waitForProxiedRelay (_, srv, _) rv = do
-      NetworkConfig {tcpConnectTimeout} <- atomically $ getNetworkConfig c
+      NetworkConfig {tcpConnectTimeout} <- getNetworkConfig c
       sess_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar rv)
       pure $ case sess_ of
         Just (Right sess) -> Right sess
@@ -709,7 +708,7 @@ resubscribeSMPSession c@AgentClient {smpSubWorkers, workerSeq} tSess = do
   where
     getWorkerVar ts =
       ifM
-        (null <$> getPending)
+        (not <$> RQ.hasSessQueues tSess (pendingSubs c))
         (pure Nothing) -- prevent race with cleanup and adding pending queues in another call
         (Just <$> getSessVar workerSeq tSess smpSubWorkers ts)
     newSubWorker v = do
@@ -718,14 +717,13 @@ resubscribeSMPSession c@AgentClient {smpSubWorkers, workerSeq} tSess = do
     runSubWorker = do
       ri <- asks $ reconnectInterval . config
       withRetryForeground ri isForeground (isNetworkOnline c) $ \_ loop -> do
-        pending <- atomically getPending
+        pending <- liftIO $ RQ.getSessQueues tSess $ pendingSubs c
         forM_ (L.nonEmpty pending) $ \qs -> do
-          atomically $ waitUntilForeground c
+          liftIO $ waitUntilForeground c
           liftIO $ waitForUserNetwork c
           reconnectSMPClient c tSess qs
           loop
     isForeground = (ASForeground ==) <$> readTVar (agentState c)
-    getPending = RQ.getSessQueues tSess $ pendingSubs c
     cleanup :: SessionVar (Async ()) -> STM ()
     cleanup v = do
       -- Here we wait until TMVar is not empty to prevent worker cleanup happening before worker is added to TMVar.
@@ -790,7 +788,7 @@ getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(_, srv
     connectClient :: XFTPClientVar -> AM XFTPClient
     connectClient v = do
       cfg <- asks $ xftpCfg . config
-      xftpNetworkConfig <- atomically $ getNetworkConfig c
+      xftpNetworkConfig <- getNetworkConfig c
       liftError' (protocolClientError XFTP $ B.unpack $ strEncode srv) $
         X.getXFTPClient tSess cfg {xftpNetworkConfig} $
           clientDisconnected v
@@ -809,7 +807,7 @@ waitForProtocolClient ::
   ClientVar msg ->
   AM (Client msg)
 waitForProtocolClient c tSess@(_, srv, _) clients v = do
-  NetworkConfig {tcpConnectTimeout} <- atomically $ getNetworkConfig c
+  NetworkConfig {tcpConnectTimeout} <- getNetworkConfig c
   client_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar v)
   case client_ of
     Just (Right smpClient) -> pure smpClient
@@ -860,26 +858,26 @@ hostEvent' event = event (AProtocolType $ protocolTypeI @(ProtoType msg)) . clie
 getClientConfig :: AgentClient -> (AgentConfig -> ProtocolClientConfig v) -> AM' (ProtocolClientConfig v)
 getClientConfig c cfgSel = do
   cfg <- asks $ cfgSel . config
-  networkConfig <- atomically $ getNetworkConfig c
+  networkConfig <- getNetworkConfig c
   pure cfg {networkConfig}
 
-getNetworkConfig :: AgentClient -> STM NetworkConfig
+getNetworkConfig :: MonadIO m => AgentClient -> m NetworkConfig
 getNetworkConfig c = do
-  (slowCfg, fastCfg) <- readTVar (useNetworkConfig c)
-  UserNetworkInfo {networkType} <- readTVar $ userNetworkInfo c
+  (slowCfg, fastCfg) <- readTVarIO $ useNetworkConfig c
+  UserNetworkInfo {networkType} <- readTVarIO $ userNetworkInfo c
   pure $ case networkType of
     UNCellular -> slowCfg
     UNNone -> slowCfg
     _ -> fastCfg
 
 -- returns fast network config
-getNetworkConfig' :: AgentClient -> IO NetworkConfig
-getNetworkConfig' = fmap snd . readTVarIO . useNetworkConfig
-{-# INLINE getNetworkConfig' #-}
+getFastNetworkConfig :: AgentClient -> IO NetworkConfig
+getFastNetworkConfig = fmap snd . readTVarIO . useNetworkConfig
+{-# INLINE getFastNetworkConfig #-}
 
 waitForUserNetwork :: AgentClient -> IO ()
 waitForUserNetwork c =
-  unlessM (atomically $ isNetworkOnline c) $ do
+  unlessM (isOnline <$> readTVarIO (userNetworkInfo c)) $ do
     delay <- registerDelay $ userNetworkInterval $ config $ agentEnv c
     atomically $ unlessM (isNetworkOnline c) $ unlessM (readTVar delay) retry
 
@@ -911,19 +909,18 @@ cancelWorker Worker {doWork, action} = do
   noWorkToDo doWork
   atomically (tryTakeTMVar action) >>= mapM_ (mapM_ uninterruptibleCancel)
 
-waitUntilActive :: AgentClient -> STM ()
-waitUntilActive c = unlessM (readTVar $ active c) retry
-{-# INLINE waitUntilActive #-}
+waitUntilActive :: AgentClient -> IO ()
+waitUntilActive AgentClient {active} = unlessM (readTVarIO active) $ atomically $ unlessM (readTVar active) retry
 
-throwWhenInactive :: AgentClient -> STM ()
-throwWhenInactive c = unlessM (readTVar $ active c) $ throwSTM ThreadKilled
+throwWhenInactive :: AgentClient -> IO ()
+throwWhenInactive c = unlessM (readTVarIO $ active c) $ E.throwIO ThreadKilled
 {-# INLINE throwWhenInactive #-}
 
 -- this function is used to remove workers once delivery is complete, not when it is removed from the map
-throwWhenNoDelivery :: AgentClient -> SndQueue -> STM ()
+throwWhenNoDelivery :: AgentClient -> SndQueue -> IO ()
 throwWhenNoDelivery c sq =
-  unlessM (TM.member (qAddress sq) $ smpDeliveryWorkers c) $
-    throwSTM ThreadKilled
+  unlessM (TM.memberIO (qAddress sq) $ smpDeliveryWorkers c) $
+    E.throwIO ThreadKilled
 
 closeProtocolServerClients :: ProtocolServerClient v err msg => AgentClient -> (AgentClient -> TMap (TransportSession msg) (ClientVar msg)) -> IO ()
 closeProtocolServerClients c clientsSel =
@@ -949,7 +946,7 @@ closeClient c clientSel tSess =
 
 closeClient_ :: ProtocolServerClient v err msg => AgentClient -> ClientVar msg -> IO ()
 closeClient_ c v = do
-  NetworkConfig {tcpConnectTimeout} <- atomically $ getNetworkConfig c
+  NetworkConfig {tcpConnectTimeout} <- getNetworkConfig c
   E.handle (\BlockedIndefinitelyOnSTM -> pure ()) $
     tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar v) >>= \case
       Just (Right client) -> closeProtocolServerClient (protocolClient client) `catchAll_` pure ()
@@ -1037,7 +1034,7 @@ withLogClient c tSess entId cmdStr action = withLogClient_ c tSess entId cmdStr
 
 withSMPClient :: SMPQueueRec q => AgentClient -> q -> ByteString -> (SMPClient -> ExceptT SMPClientError IO a) -> AM a
 withSMPClient c q cmdStr action = do
-  tSess <- liftIO $ mkSMPTransportSession c q
+  tSess <- mkSMPTransportSession c q
   withLogClient c tSess (queueId q) cmdStr $ action . connectedClient
 
 sendOrProxySMPMessage :: AgentClient -> UserId -> SMPServer -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer)
@@ -1062,8 +1059,8 @@ sendOrProxySMPCommand ::
   (SMPClient -> ExceptT SMPClientError IO ()) ->
   AM (Maybe SMPServer)
 sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
-  sess <- liftIO $ mkTransportSession c userId destSrv senderId
-  ifM (atomically shouldUseProxy) (sendViaProxy Nothing sess) (sendDirectly sess $> Nothing)
+  sess <- mkTransportSession c userId destSrv senderId
+  ifM shouldUseProxy (sendViaProxy Nothing sess) (sendDirectly sess $> Nothing)
   where
     shouldUseProxy = do
       cfg <- getNetworkConfig c
@@ -1080,7 +1077,7 @@ sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDi
         SPFAllow -> True
         SPFAllowProtected -> ipAddressProtected cfg destSrv
         SPFProhibit -> False
-    unknownServer = maybe True (notElem destSrv . knownSrvs) <$> TM.lookup userId (smpServers c)
+    unknownServer = liftIO $ maybe True (notElem destSrv . knownSrvs) <$> TM.lookupIO userId (smpServers c)
     sendViaProxy :: Maybe SMPServerWithAuth -> SMPTransportSession -> AM (Maybe SMPServer)
     sendViaProxy proxySrv_ destSess@(_, _, qId) = do
       r <- tryAgentError . withProxySession c proxySrv_ destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess@ProxiedRelay {prBasicAuth}) -> do
@@ -1126,7 +1123,7 @@ sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDi
           forM_ r' $ \proxySrv -> atomically $ incSMPServerStat c userId proxySrv sentProxied
           pure r'
         Left e
-          | serverHostError e -> ifM (atomically directAllowed) (sendDirectly destSess $> Nothing) (throwE e)
+          | serverHostError e -> ifM directAllowed (sendDirectly destSess $> Nothing) (throwE e)
           | otherwise -> throwE e
     sendDirectly tSess =
       withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
@@ -1152,7 +1149,7 @@ withXFTPClient ::
   (Client msg -> ExceptT (ProtocolClientError err) IO b) ->
   AM b
 withXFTPClient c (userId, srv, entityId) cmdStr action = do
-  tSess <- liftIO $ mkTransportSession c userId srv entityId
+  tSess <- mkTransportSession c userId srv entityId
   withLogClient c tSess entityId cmdStr action
 
 liftClient :: (Show err, Encoding err) => (HostName -> err -> AgentErrorType) -> HostName -> ExceptT (ProtocolClientError err) IO a -> AM a
@@ -1224,7 +1221,7 @@ runXFTPServerTest :: AgentClient -> UserId -> XFTPServerWithAuth -> AM' (Maybe P
 runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
   cfg <- asks $ xftpCfg . config
   g <- asks random
-  xftpNetworkConfig <- atomically $ getNetworkConfig c
+  xftpNetworkConfig <- getNetworkConfig c
   workDir <- getXFTPWorkPath
   filePath <- getTempFilePath workDir
   rcvPath <- getTempFilePath workDir
@@ -1295,7 +1292,7 @@ getXFTPWorkPath = do
   workDir <- readTVarIO =<< asks (xftpWorkDir . xftpAgent)
   maybe getTemporaryDirectory pure workDir
 
-mkTransportSession :: AgentClient -> UserId -> ProtoServer msg -> EntityId -> IO (TransportSession msg)
+mkTransportSession :: MonadIO m => AgentClient -> UserId -> ProtoServer msg -> EntityId -> m (TransportSession msg)
 mkTransportSession c userId srv entityId = mkTSession userId srv entityId <$> getSessionMode c
 {-# INLINE mkTransportSession #-}
 
@@ -1303,7 +1300,7 @@ mkTSession :: UserId -> ProtoServer msg -> EntityId -> TransportSessionMode -> T
 mkTSession userId srv entityId mode = (userId, srv, if mode == TSMEntity then Just entityId else Nothing)
 {-# INLINE mkTSession #-}
 
-mkSMPTransportSession :: SMPQueueRec q => AgentClient -> q -> IO SMPTransportSession
+mkSMPTransportSession :: (SMPQueueRec q, MonadIO m) => AgentClient -> q -> m SMPTransportSession
 mkSMPTransportSession c q = mkSMPTSession q <$> getSessionMode c
 {-# INLINE mkSMPTransportSession #-}
 
@@ -1311,8 +1308,8 @@ mkSMPTSession :: SMPQueueRec q => q -> TransportSessionMode -> SMPTransportSessi
 mkSMPTSession q = mkTSession (qUserId q) (qServer q) (qConnId q)
 {-# INLINE mkSMPTSession #-}
 
-getSessionMode :: AgentClient -> IO TransportSessionMode
-getSessionMode = atomically . fmap sessionMode . getNetworkConfig
+getSessionMode :: MonadIO m => AgentClient -> m TransportSessionMode
+getSessionMode = fmap sessionMode . getNetworkConfig
 {-# INLINE getSessionMode #-}
 
 newRcvQueue :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SubscriptionMode -> SenderCanSecure -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
@@ -1323,7 +1320,7 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode sender
   (dhKey, privDhKey) <- atomically $ C.generateKeyPair g
   (e2eDhKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
   logServer "-->" c srv "" "NEW"
-  tSess <- liftIO $ mkTransportSession c userId srv connId
+  tSess <- mkTransportSession c userId srv connId
   (sessId, QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}) <-
     withClient c tSess $ \(SMPConnectedClient smp _) ->
       (sessionId $ thParams smp,) <$> createSMPQueue smp rKeys dhKey auth subMode senderCanSecure
@@ -1409,7 +1406,7 @@ subscribeQueues c qs = do
   (errs <> rs,) <$> readTVarIO session
   where
     checkQueue rq = do
-      prohibited <- atomically $ hasGetLock c rq
+      prohibited <- liftIO $ hasGetLock c rq
       pure $ if prohibited then Left (rq, Left $ CMD PROHIBITED "subscribeQueues") else Right rq
     subscribeQueues_ :: Env -> TVar (Maybe SessionId) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
     subscribeQueues_ env session smp qs' = do
@@ -1450,7 +1447,7 @@ sendTSessionBatches statCmd toRQ action c qs =
   where
     batchQueues :: AM' [(SMPTransportSession, NonEmpty q)]
     batchQueues = do
-      mode <- atomically $ sessionMode <$> getNetworkConfig c
+      mode <- getSessionMode c
       pure . M.assocs $ foldl' (batch mode) M.empty qs
       where
         batch mode m q =
@@ -1511,8 +1508,8 @@ removeSubscription c connId = do
   RQ.deleteConn connId $ activeSubs c
   RQ.deleteConn connId $ pendingSubs c
 
-getSubscriptions :: AgentClient -> STM (Set ConnId)
-getSubscriptions = readTVar . subscrConns
+getSubscriptions :: AgentClient -> IO (Set ConnId)
+getSubscriptions = readTVarIO . subscrConns
 {-# INLINE getSubscriptions #-}
 
 logServer :: MonadIO m => ByteString -> AgentClient -> ProtocolServer s -> QueueId -> ByteString -> m ()
@@ -1611,9 +1608,9 @@ sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = do
     ackSMPMessage smp rcvPrivateKey rcvId msgId
   atomically $ releaseGetLock c rq
 
-hasGetLock :: AgentClient -> RcvQueue -> STM Bool
+hasGetLock :: AgentClient -> RcvQueue -> IO Bool
 hasGetLock c RcvQueue {server, rcvId} =
-  TM.member (server, rcvId) $ getMsgLocks c
+  TM.memberIO (server, rcvId) $ getMsgLocks c
 
 releaseGetLock :: AgentClient -> RcvQueue -> STM ()
 releaseGetLock c RcvQueue {server, rcvId} =
@@ -1712,7 +1709,7 @@ agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize},
   (sndKey, replicaKey) <- atomically . C.generateAuthKeyPair C.SEd25519 =<< asks random
   let fileInfo = FileInfo {sndKey, size = chunkSize, digest = chunkDigest}
   logServer "-->" c srv "" "FNEW"
-  tSess <- liftIO $ mkTransportSession c userId srv chunkDigest
+  tSess <- mkTransportSession c userId srv chunkDigest
   (sndId, rIds) <- withClient c tSess $ \xftp -> X.createXFTPChunk xftp replicaKey fileInfo (L.map fst rKeys) auth
   logServer "<--" c srv "" $ B.unwords ["SIDS", logSecret sndId]
   pure NewSndChunkReplica {server = srv, replicaId = ChunkReplicaId sndId, replicaKey, rcvIdsKeys = L.toList $ xftpRcvIdsKeys rIds rKeys}
@@ -1865,22 +1862,28 @@ beginAgentOperation c op = do
   -- unsafeIOToSTM $ putStrLn $ "beginOperation! " <> show op <> " " <> show (opsInProgress s + 1)
   writeTVar opVar $! s {opsInProgress = opsInProgress s + 1}
 
-agentOperationBracket :: MonadUnliftIO m => AgentClient -> AgentOperation -> (AgentClient -> STM ()) -> m a -> m a
+agentOperationBracket :: MonadUnliftIO m => AgentClient -> AgentOperation -> (AgentClient -> IO ()) -> m a -> m a
 agentOperationBracket c op check action =
   E.bracket
-    (atomically (check c) >> atomically (beginAgentOperation c op))
+    (liftIO (check c) >> atomically (beginAgentOperation c op))
     (\_ -> atomically $ endAgentOperation c op)
     (const action)
 
-waitUntilForeground :: AgentClient -> STM ()
-waitUntilForeground c = unlessM ((ASForeground ==) <$> readTVar (agentState c)) retry
-{-# INLINE waitUntilForeground #-}
+waitUntilForeground :: AgentClient -> IO ()
+waitUntilForeground c =
+  unlessM (foreground readTVarIO) $ atomically $ unlessM (foreground readTVar) retry
+  where
+    foreground :: Monad m => (TVar AgentState -> m AgentState) -> m Bool
+    foreground rd = (ASForeground ==) <$> rd (agentState c)
 
 -- This function waits while agent is suspended, but will proceed while it is suspending,
 -- to allow completing in-flight operations.
-waitWhileSuspended :: AgentClient -> STM ()
-waitWhileSuspended c = unlessM ((ASSuspended /=) <$> readTVar (agentState c)) retry
-{-# INLINE waitWhileSuspended #-}
+waitWhileSuspended :: AgentClient -> IO ()
+waitWhileSuspended c =
+  whenM (suspended readTVarIO) $ atomically $ whenM (suspended readTVar) retry
+  where
+    suspended :: Monad m => (TVar AgentState -> m AgentState) -> m Bool
+    suspended rd = (ASSuspended ==) <$> rd (agentState c)
 
 withStore' :: AgentClient -> (DB.Connection -> IO a) -> AM a
 withStore' c action = withStore c $ fmap Right . action
@@ -1951,7 +1954,7 @@ getNextServer c userId usedSrvs = withUserServers c userId $ \srvs ->
 
 withUserServers :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> (NonEmpty (ProtoServerWithAuth p) -> AM a) -> AM a
 withUserServers c userId action =
-  atomically (TM.lookup userId $ userServers c) >>= \case
+  liftIO (TM.lookupIO userId $ userServers c) >>= \case
     Just srvs -> action $ enabledSrvs srvs
     _ -> throwE $ INTERNAL "unknown userId - no user servers"
 
@@ -1959,11 +1962,10 @@ withNextSrv :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient -> U
 withNextSrv c userId usedSrvs initUsed action = do
   used <- readTVarIO usedSrvs
   srvAuth@(ProtoServerWithAuth srv _) <- getNextServer c userId used
-  atomically $ do
-    srvs_ <- TM.lookup userId $ userServers c
-    let unused = maybe [] ((\\ used) . map protoServer . L.toList . enabledSrvs) srvs_
-        used' = if null unused then initUsed else srv : used
-    writeTVar usedSrvs $! used'
+  srvs_ <- liftIO $ TM.lookupIO userId $ userServers c
+  let unused = maybe [] ((\\ used) . map protoServer . L.toList . enabledSrvs) srvs_
+      used' = if null unused then initUsed else srv : used
+  atomically $ writeTVar usedSrvs $! used'
   action srvAuth
 
 incSMPServerStat :: AgentClient -> UserId -> SMPServer -> (AgentSMPServerStats -> TVar Int) -> STM ()
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 86203266b..f57cf91e9 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -242,8 +242,8 @@ newSMPAgentEnv :: AgentConfig -> SQLiteStore -> IO Env
 newSMPAgentEnv config store = do
   random <- C.newRandom
   randomServer <- newTVarIO =<< liftIO newStdGen
-  ntfSupervisor <- atomically . newNtfSubSupervisor $ tbqSize config
-  xftpAgent <- atomically newXFTPAgent
+  ntfSupervisor <- newNtfSubSupervisor $ tbqSize config
+  xftpAgent <- newXFTPAgent
   multicastSubscribers <- newTMVarIO 0
   pure Env {config, store, random, randomServer, ntfSupervisor, xftpAgent, multicastSubscribers}
 
@@ -260,12 +260,12 @@ data NtfSupervisor = NtfSupervisor
 data NtfSupervisorCommand = NSCCreate | NSCDelete | NSCSmpDelete | NSCNtfWorker NtfServer | NSCNtfSMPWorker SMPServer
   deriving (Show)
 
-newNtfSubSupervisor :: Natural -> STM NtfSupervisor
+newNtfSubSupervisor :: Natural -> IO NtfSupervisor
 newNtfSubSupervisor qSize = do
-  ntfTkn <- newTVar Nothing
-  ntfSubQ <- newTBQueue qSize
-  ntfWorkers <- TM.empty
-  ntfSMPWorkers <- TM.empty
+  ntfTkn <- newTVarIO Nothing
+  ntfSubQ <- newTBQueueIO qSize
+  ntfWorkers <- TM.emptyIO
+  ntfSMPWorkers <- TM.emptyIO
   pure NtfSupervisor {ntfTkn, ntfSubQ, ntfWorkers, ntfSMPWorkers}
 
 data XFTPAgent = XFTPAgent
@@ -276,12 +276,12 @@ data XFTPAgent = XFTPAgent
     xftpDelWorkers :: TMap XFTPServer Worker
   }
 
-newXFTPAgent :: STM XFTPAgent
+newXFTPAgent :: IO XFTPAgent
 newXFTPAgent = do
-  xftpWorkDir <- newTVar Nothing
-  xftpRcvWorkers <- TM.empty
-  xftpSndWorkers <- TM.empty
-  xftpDelWorkers <- TM.empty
+  xftpWorkDir <- newTVarIO Nothing
+  xftpRcvWorkers <- TM.emptyIO
+  xftpSndWorkers <- TM.emptyIO
+  xftpDelWorkers <- TM.emptyIO
   pure XFTPAgent {xftpWorkDir, xftpRcvWorkers, xftpSndWorkers, xftpDelWorkers}
 
 tryAgentError :: AM a -> AM (Either AgentErrorType a)
diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
index 249aad942..23a88ea70 100644
--- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
+++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
@@ -159,7 +159,7 @@ runNtfWorker c srv Worker {doWork} =
           logInfo $ "runNtfWorker, nextSub " <> tshow nextSub
           ri <- asks $ reconnectInterval . config
           withRetryInterval ri $ \_ loop -> do
-            atomically $ waitWhileSuspended c
+            liftIO $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             processSub nextSub
               `catchAgentError` retryOnError c "NtfWorker" loop (workerInternalError c connId . show)
@@ -244,7 +244,7 @@ runNtfSMPWorker c srv Worker {doWork} = do
           logInfo $ "runNtfSMPWorker, nextSub " <> tshow nextSub
           ri <- asks $ reconnectInterval . config
           withRetryInterval ri $ \_ loop -> do
-            atomically $ waitWhileSuspended c
+            liftIO $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             processSub nextSub
               `catchAgentError` retryOnError c "NtfSMPWorker" loop (workerInternalError c connId . show)
@@ -297,7 +297,7 @@ retryOnError c name loop done e = do
   where
     retryLoop = do
       atomically $ endAgentOperation c AONtfNetwork
-      atomically $ throwWhenInactive c
+      liftIO $ throwWhenInactive c
       atomically $ beginAgentOperation c AONtfNetwork
       loop
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 0bb80069c..20f382d40 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -392,11 +392,10 @@ connectSQLiteStore dbFilePath key keepKey = do
   dbNew <- not <$> doesFileExist dbFilePath
   dbConn <- dbBusyLoop (connectDB dbFilePath key)
   dbConnection <- newMVar dbConn
-  atomically $ do
-    dbKey <- newTVar $! storeKey key keepKey
-    dbClosed <- newTVar False
-    dbSem <- newTVar 0
-    pure SQLiteStore {dbFilePath, dbKey, dbSem, dbConnection, dbNew, dbClosed}
+  dbKey <- newTVarIO $! storeKey key keepKey
+  dbClosed <- newTVarIO False
+  dbSem <- newTVarIO 0
+  pure SQLiteStore {dbFilePath, dbKey, dbSem, dbConnection, dbNew, dbClosed}
 
 connectDB :: FilePath -> ScrubbedBytes -> IO DB.Connection
 connectDB path key = do
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs
index 6b121b0b4..a7ad47f37 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs
@@ -47,7 +47,7 @@ withConnectionPriority SQLiteStore {dbSem, dbConnection} priority action
     lowPriority = wait >> withMVar dbConnection (\db -> ifM free (Just <$> action db) (pure Nothing)) >>= maybe lowPriority pure
     signal = atomically $ modifyTVar' dbSem (+ 1)
     release = atomically $ modifyTVar' dbSem $ \sem -> if sem > 0 then sem - 1 else 0
-    wait = atomically $ unlessM ((0 ==) <$> readTVar dbSem) retry
+    wait = unlessM free $ atomically $ unlessM ((0 ==) <$> readTVar dbSem) retry
     free = (0 ==) <$> readTVarIO dbSem
 
 withConnection :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs b/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs
index 2ae4eb731..b356b3f87 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs
@@ -64,7 +64,7 @@ timeIt slow sql a = do
 open :: String -> IO Connection
 open f = do
   conn <- SQL.open f
-  slow <- atomically $ TM.empty
+  slow <- TM.emptyIO
   pure Connection {conn, slow}
 
 close :: Connection -> IO ()
diff --git a/src/Simplex/Messaging/Agent/TRcvQueues.hs b/src/Simplex/Messaging/Agent/TRcvQueues.hs
index 10e4574cb..3b02f64ae 100644
--- a/src/Simplex/Messaging/Agent/TRcvQueues.hs
+++ b/src/Simplex/Messaging/Agent/TRcvQueues.hs
@@ -11,6 +11,7 @@ module Simplex.Messaging.Agent.TRcvQueues
     addQueue,
     batchAddQueues,
     deleteQueue,
+    hasSessQueues,
     getSessQueues,
     getDelSessQueues,
   )
@@ -39,8 +40,8 @@ data TRcvQueues q = TRcvQueues
     getConnections :: TMap ConnId (NonEmpty (UserId, SMPServer, RecipientId))
   }
 
-empty :: STM (TRcvQueues q)
-empty = TRcvQueues <$> TM.empty <*> TM.empty
+empty :: IO (TRcvQueues q)
+empty = TRcvQueues <$> TM.emptyIO <*> TM.emptyIO
 
 clear :: TRcvQueues q -> STM ()
 clear (TRcvQueues qs cs) = TM.clear qs >> TM.clear cs
@@ -78,8 +79,11 @@ deleteQueue rq (TRcvQueues qs cs) = do
     delQ = L.nonEmpty . L.filter (/= k)
     k = qKey rq
 
-getSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues RcvQueue -> STM [RcvQueue]
-getSessQueues tSess (TRcvQueues qs _) = M.foldl' addQ [] <$> readTVar qs
+hasSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues RcvQueue -> STM Bool
+hasSessQueues tSess (TRcvQueues qs _) = any (`isSession` tSess) <$> readTVar qs
+
+getSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues RcvQueue -> IO [RcvQueue]
+getSessQueues tSess (TRcvQueues qs _) = M.foldl' addQ [] <$> readTVarIO qs
   where
     addQ qs' rq = if rq `isSession` tSess then rq : qs' else qs'
 
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 80fd65ffc..b4567c62e 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -170,17 +170,17 @@ data PClient v err msg = PClient
     msgQ :: Maybe (TBQueue (ServerTransmissionBatch v err msg))
   }
 
-smpClientStub :: TVar ChaChaDRG -> ByteString -> VersionSMP -> Maybe (THandleAuth 'TClient) -> STM SMPClient
+smpClientStub :: TVar ChaChaDRG -> ByteString -> VersionSMP -> Maybe (THandleAuth 'TClient) -> IO SMPClient
 smpClientStub g sessionId thVersion thAuth = do
   let ts = UTCTime (read "2024-03-31") 0
-  connected <- newTVar False
-  clientCorrId <- C.newRandomDRG g
-  sentCommands <- TM.empty
-  sendPings <- newTVar False
-  lastReceived <- newTVar ts
-  timeoutErrorCount <- newTVar 0
-  sndQ <- newTBQueue 100
-  rcvQ <- newTBQueue 100
+  connected <- newTVarIO False
+  clientCorrId <- atomically $ C.newRandomDRG g
+  sentCommands <- TM.emptyIO
+  sendPings <- newTVarIO False
+  lastReceived <- newTVarIO ts
+  timeoutErrorCount <- newTVarIO 0
+  sndQ <- newTBQueueIO 100
+  rcvQ <- newTBQueueIO 100
   return
     ProtocolClient
       { action = Nothing,
@@ -452,21 +452,21 @@ getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> T
 getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret} msgQ disconnected = do
   case chooseTransportHost networkConfig (host srv) of
     Right useHost ->
-      (getCurrentTime >>= atomically . mkProtocolClient useHost >>= runClient useTransport useHost)
+      (getCurrentTime >>= mkProtocolClient useHost >>= runClient useTransport useHost)
         `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
     Left e -> pure $ Left e
   where
     NetworkConfig {tcpConnectTimeout, tcpTimeout, smpPingInterval} = networkConfig
-    mkProtocolClient :: TransportHost -> UTCTime -> STM (PClient v err msg)
+    mkProtocolClient :: TransportHost -> UTCTime -> IO (PClient v err msg)
     mkProtocolClient transportHost ts = do
-      connected <- newTVar False
-      sendPings <- newTVar False
-      lastReceived <- newTVar ts
-      timeoutErrorCount <- newTVar 0
-      clientCorrId <- C.newRandomDRG g
-      sentCommands <- TM.empty
-      sndQ <- newTBQueue qSize
-      rcvQ <- newTBQueue qSize
+      connected <- newTVarIO False
+      sendPings <- newTVarIO False
+      lastReceived <- newTVarIO ts
+      timeoutErrorCount <- newTVarIO 0
+      clientCorrId <- atomically $ C.newRandomDRG g
+      sentCommands <- TM.emptyIO
+      sndQ <- newTBQueueIO qSize
+      rcvQ <- newTBQueueIO qSize
       return
         PClient
           { connected,
@@ -565,7 +565,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
     processMsg ProtocolClient {client_ = PClient {sentCommands}} (_, _, (corrId, entId, respOrErr))
       | B.null $ bs corrId = sendMsg $ STEvent clientResp
       | otherwise =
-          atomically (TM.lookup corrId sentCommands) >>= \case
+          TM.lookupIO corrId sentCommands >>= \case
             Nothing -> sendMsg $ STUnexpectedError unexpected
             Just Request {entityId, command, pending, responseVar} -> do
               wasPending <-
@@ -1089,13 +1089,13 @@ mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentC
   nonce@(C.CbNonce corrId) <- maybe (atomically $ C.randomCbNonce clientCorrId) pure nonce_
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, entityId, command)
       auth = authTransmission (thAuth thParams) pKey_ nonce tForAuth
-  r <- atomically $ mkRequest (CorrId corrId)
+  r <- mkRequest (CorrId corrId)
   pure ((,tToSend) <$> auth, r)
   where
-    mkRequest :: CorrId -> STM (Request err msg)
+    mkRequest :: CorrId -> IO (Request err msg)
     mkRequest corrId = do
-      pending <- newTVar True
-      responseVar <- newEmptyTMVar
+      pending <- newTVarIO True
+      responseVar <- newEmptyTMVarIO
       let r =
             Request
               { corrId,
@@ -1104,7 +1104,7 @@ mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentC
                 pending,
                 responseVar
               }
-      TM.insert corrId r sentCommands
+      atomically $ TM.insert corrId r sentCommands
       pure r
 
 authTransmission :: Maybe (THandleAuth 'TClient) -> Maybe C.APrivateAuthKey -> C.CbNonce -> ByteString -> Either TransportError (Maybe TransmissionAuth)
diff --git a/src/Simplex/Messaging/Client/Agent.hs b/src/Simplex/Messaging/Client/Agent.hs
index a95f706bf..8073f1d48 100644
--- a/src/Simplex/Messaging/Client/Agent.hs
+++ b/src/Simplex/Messaging/Client/Agent.hs
@@ -108,17 +108,17 @@ data SMPClientAgent = SMPClientAgent
 
 type OwnServer = Bool
 
-newSMPClientAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> STM SMPClientAgent
+newSMPClientAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO SMPClientAgent
 newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg = do
-  active <- newTVar True
-  msgQ <- newTBQueue msgQSize
-  agentQ <- newTBQueue agentQSize
-  smpClients <- TM.empty
-  smpSessions <- TM.empty
-  srvSubs <- TM.empty
-  pendingSrvSubs <- TM.empty
-  smpSubWorkers <- TM.empty
-  workerSeq <- newTVar 0
+  active <- newTVarIO True
+  msgQ <- newTBQueueIO msgQSize
+  agentQ <- newTBQueueIO agentQSize
+  smpClients <- TM.emptyIO
+  smpSessions <- TM.emptyIO
+  srvSubs <- TM.emptyIO
+  pendingSrvSubs <- TM.emptyIO
+  smpSubWorkers <- TM.emptyIO
+  workerSeq <- newTVarIO 0
   pure
     SMPClientAgent
       { agentCfg,
@@ -229,7 +229,7 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
   where
     getWorkerVar ts =
       ifM
-        (null <$> getPending)
+        (noPending)
         (pure Nothing) -- prevent race with cleanup and adding pending queues in another call
         (Just <$> getSessVar workerSeq srv smpSubWorkers ts)
     newSubWorker :: SessionVar (Async ()) -> IO ()
@@ -238,12 +238,13 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
       atomically $ putTMVar (sessionVar v) a
     runSubWorker =
       withRetryInterval (reconnectInterval agentCfg) $ \_ loop -> do
-        pending <- atomically getPending
+        pending <- liftIO getPending
         unless (null pending) $ whenM (readTVarIO active) $ do
           void $ tcpConnectTimeout `timeout` runExceptT (reconnectSMPClient ca srv pending)
           loop
     ProtocolClientConfig {networkConfig = NetworkConfig {tcpConnectTimeout}} = smpCfg agentCfg
-    getPending = maybe (pure M.empty) readTVar =<< TM.lookup srv (pendingSrvSubs ca)
+    noPending = maybe (pure True) (fmap M.null . readTVar) =<< TM.lookup srv (pendingSrvSubs ca)
+    getPending = maybe (pure M.empty) readTVarIO =<< TM.lookupIO srv (pendingSrvSubs ca)
     cleanup :: SessionVar (Async ()) -> STM ()
     cleanup v = do
       -- Here we wait until TMVar is not empty to prevent worker cleanup happening before worker is added to TMVar.
@@ -254,7 +255,7 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
 reconnectSMPClient :: SMPClientAgent -> SMPServer -> Map SMPSub C.APrivateAuthKey -> ExceptT SMPClientError IO ()
 reconnectSMPClient ca@SMPClientAgent {agentCfg} srv cs =
   withSMP ca srv $ \smp -> liftIO $ do
-    currSubs <- atomically $ maybe (pure M.empty) readTVar =<< TM.lookup srv (srvSubs ca)
+    currSubs <- maybe (pure M.empty) readTVarIO =<< TM.lookupIO srv (srvSubs ca)
     let (nSubs, rSubs) = foldr (groupSub currSubs) ([], []) $ M.assocs cs
     subscribe_ smp SPNotifier nSubs
     subscribe_ smp SPRecipient rSubs
@@ -289,8 +290,8 @@ getConnectedSMPServerClient SMPClientAgent {smpClients} srv =
             (Nothing <$ atomically (removeSessVar v srv smpClients)) -- proxy will create a new connection
             (pure $ Just $ Left e) -- not expired, returning error
 
-lookupSMPServerClient :: SMPClientAgent -> SessionId -> STM (Maybe (OwnServer, SMPClient))
-lookupSMPServerClient SMPClientAgent {smpSessions} sessId = TM.lookup sessId smpSessions
+lookupSMPServerClient :: SMPClientAgent -> SessionId -> IO (Maybe (OwnServer, SMPClient))
+lookupSMPServerClient SMPClientAgent {smpSessions} sessId = TM.lookupIO sessId smpSessions
 
 closeSMPClientAgent :: SMPClientAgent -> IO ()
 closeSMPClientAgent c = do
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 2bf8dbcbf..1192148ac 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -176,10 +176,10 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
 
     getSMPSubscriber :: SMPServer -> M SMPSubscriber
     getSMPSubscriber smpServer =
-      atomically (TM.lookup smpServer smpSubscribers) >>= maybe createSMPSubscriber pure
+      liftIO (TM.lookupIO smpServer smpSubscribers) >>= maybe createSMPSubscriber pure
       where
         createSMPSubscriber = do
-          sub@SMPSubscriber {subThreadId} <- atomically newSMPSubscriber
+          sub@SMPSubscriber {subThreadId} <- liftIO newSMPSubscriber
           atomically $ TM.insert smpServer sub smpSubscribers
           tId <- mkWeakThreadId =<< forkIO (runSMPSubscriber sub)
           atomically . writeTVar subThreadId $ Just tId
@@ -333,7 +333,7 @@ runNtfClientTransport :: Transport c => THandleNTF c 'TServer -> M ()
 runNtfClientTransport th@THandle {params} = do
   qSize <- asks $ clientQSize . config
   ts <- liftIO getSystemTime
-  c <- atomically $ newNtfServerClient qSize params ts
+  c <- liftIO $ newNtfServerClient qSize params ts
   s <- asks subscriber
   ps <- asks pushServer
   expCfg <- asks $ inactiveClientExpiration . config
@@ -507,7 +507,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
             | otherwise -> do
                 logDebug "TCRN"
                 atomically $ writeTVar tknCronInterval int
-                atomically (TM.lookup tknId intervalNotifiers) >>= \case
+                liftIO (TM.lookupIO tknId intervalNotifiers) >>= \case
                   Nothing -> runIntervalNotifier int
                   Just IntervalNotifier {interval, action} ->
                     unless (interval == int) $ do
@@ -585,7 +585,7 @@ incNtfStat statSel = do
 saveServerStats :: M ()
 saveServerStats =
   asks (serverStatsBackupFile . config)
-    >>= mapM_ (\f -> asks serverStats >>= atomically . getNtfServerStatsData >>= liftIO . saveStats f)
+    >>= mapM_ (\f -> asks serverStats >>= liftIO . getNtfServerStatsData >>= liftIO . saveStats f)
   where
     saveStats f stats = do
       logInfo $ "saving server stats to file " <> T.pack f
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 5ebd5230e..dc0cb0a73 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -10,7 +10,6 @@ module Simplex.Messaging.Notifications.Server.Env where
 import Control.Concurrent (ThreadId)
 import Control.Concurrent.Async (Async)
 import Control.Logger.Simple
-import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
@@ -85,16 +84,16 @@ data NtfEnv = NtfEnv
 
 newNtfServerEnv :: NtfServerConfig -> IO NtfEnv
 newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsConfig, storeLogFile, caCertificateFile, certificateFile, privateKeyFile, transportConfig} = do
-  random <- liftIO C.newRandom
-  store <- atomically newNtfStore
+  random <- C.newRandom
+  store <- newNtfStore
   logInfo "restoring subscriptions..."
-  storeLog <- liftIO $ mapM (`readWriteNtfStore` store) storeLogFile
+  storeLog <- mapM (`readWriteNtfStore` store) storeLogFile
   logInfo "restored subscriptions"
-  subscriber <- atomically $ newNtfSubscriber subQSize smpAgentCfg random
-  pushServer <- atomically $ newNtfPushServer pushQSize apnsConfig
-  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
-  Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
-  serverStats <- atomically . newNtfServerStats =<< liftIO getCurrentTime
+  subscriber <- newNtfSubscriber subQSize smpAgentCfg random
+  pushServer <- newNtfPushServer pushQSize apnsConfig
+  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
+  Fingerprint fp <- loadFingerprint caCertificateFile
+  serverStats <- newNtfServerStats =<< getCurrentTime
   pure NtfEnv {config, subscriber, pushServer, store, storeLog, random, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}
 
 data NtfSubscriber = NtfSubscriber
@@ -103,10 +102,10 @@ data NtfSubscriber = NtfSubscriber
     smpAgent :: SMPClientAgent
   }
 
-newNtfSubscriber :: Natural -> SMPClientAgentConfig -> TVar ChaChaDRG -> STM NtfSubscriber
+newNtfSubscriber :: Natural -> SMPClientAgentConfig -> TVar ChaChaDRG -> IO NtfSubscriber
 newNtfSubscriber qSize smpAgentCfg random = do
-  smpSubscribers <- TM.empty
-  newSubQ <- newTBQueue qSize
+  smpSubscribers <- TM.emptyIO
+  newSubQ <- newTBQueueIO qSize
   smpAgent <- newSMPClientAgent smpAgentCfg random
   pure NtfSubscriber {smpSubscribers, newSubQ, smpAgent}
 
@@ -115,10 +114,10 @@ data SMPSubscriber = SMPSubscriber
     subThreadId :: TVar (Maybe (Weak ThreadId))
   }
 
-newSMPSubscriber :: STM SMPSubscriber
+newSMPSubscriber :: IO SMPSubscriber
 newSMPSubscriber = do
-  newSubQ <- newTQueue
-  subThreadId <- newTVar Nothing
+  newSubQ <- newTQueueIO
+  subThreadId <- newTVarIO Nothing
   pure SMPSubscriber {newSubQ, subThreadId}
 
 data NtfPushServer = NtfPushServer
@@ -134,11 +133,11 @@ data IntervalNotifier = IntervalNotifier
     interval :: Word16
   }
 
-newNtfPushServer :: Natural -> APNSPushClientConfig -> STM NtfPushServer
+newNtfPushServer :: Natural -> APNSPushClientConfig -> IO NtfPushServer
 newNtfPushServer qSize apnsConfig = do
-  pushQ <- newTBQueue qSize
-  pushClients <- TM.empty
-  intervalNotifiers <- TM.empty
+  pushQ <- newTBQueueIO qSize
+  pushClients <- TM.emptyIO
+  intervalNotifiers <- TM.emptyIO
   pure NtfPushServer {pushQ, pushClients, intervalNotifiers, apnsConfig}
 
 newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
@@ -151,7 +150,7 @@ newPushClient NtfPushServer {apnsConfig, pushClients} pp = do
 
 getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 getPushClient s@NtfPushServer {pushClients} pp =
-  atomically (TM.lookup pp pushClients) >>= maybe (newPushClient s pp) pure
+  TM.lookupIO pp pushClients >>= maybe (newPushClient s pp) pure
 
 data NtfRequest
   = NtfReqNew CorrId ANewNtfEntity
@@ -167,11 +166,11 @@ data NtfServerClient = NtfServerClient
     sndActiveAt :: TVar SystemTime
   }
 
-newNtfServerClient :: Natural -> THandleParams NTFVersion 'TServer -> SystemTime -> STM NtfServerClient
+newNtfServerClient :: Natural -> THandleParams NTFVersion 'TServer -> SystemTime -> IO NtfServerClient
 newNtfServerClient qSize ntfThParams ts = do
-  rcvQ <- newTBQueue qSize
-  sndQ <- newTBQueue qSize
-  connected <- newTVar True
-  rcvActiveAt <- newTVar ts
-  sndActiveAt <- newTVar ts
+  rcvQ <- newTBQueueIO qSize
+  sndQ <- newTBQueueIO qSize
+  connected <- newTVarIO True
+  rcvActiveAt <- newTVarIO ts
+  sndActiveAt <- newTVarIO ts
   return NtfServerClient {rcvQ, sndQ, ntfThParams, connected, rcvActiveAt, sndActiveAt}
diff --git a/src/Simplex/Messaging/Notifications/Server/Stats.hs b/src/Simplex/Messaging/Notifications/Server/Stats.hs
index 7debc1ac9..b73e6098f 100644
--- a/src/Simplex/Messaging/Notifications/Server/Stats.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Stats.hs
@@ -40,30 +40,30 @@ data NtfServerStatsData = NtfServerStatsData
     _activeSubs :: PeriodStatsData NotifierId
   }
 
-newNtfServerStats :: UTCTime -> STM NtfServerStats
+newNtfServerStats :: UTCTime -> IO NtfServerStats
 newNtfServerStats ts = do
-  fromTime <- newTVar ts
-  tknCreated <- newTVar 0
-  tknVerified <- newTVar 0
-  tknDeleted <- newTVar 0
-  subCreated <- newTVar 0
-  subDeleted <- newTVar 0
-  ntfReceived <- newTVar 0
-  ntfDelivered <- newTVar 0
+  fromTime <- newTVarIO ts
+  tknCreated <- newTVarIO 0
+  tknVerified <- newTVarIO 0
+  tknDeleted <- newTVarIO 0
+  subCreated <- newTVarIO 0
+  subDeleted <- newTVarIO 0
+  ntfReceived <- newTVarIO 0
+  ntfDelivered <- newTVarIO 0
   activeTokens <- newPeriodStats
   activeSubs <- newPeriodStats
   pure NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs}
 
-getNtfServerStatsData :: NtfServerStats -> STM NtfServerStatsData
+getNtfServerStatsData :: NtfServerStats -> IO NtfServerStatsData
 getNtfServerStatsData s@NtfServerStats {fromTime} = do
-  _fromTime <- readTVar fromTime
-  _tknCreated <- readTVar $ tknCreated s
-  _tknVerified <- readTVar $ tknVerified s
-  _tknDeleted <- readTVar $ tknDeleted s
-  _subCreated <- readTVar $ subCreated s
-  _subDeleted <- readTVar $ subDeleted s
-  _ntfReceived <- readTVar $ ntfReceived s
-  _ntfDelivered <- readTVar $ ntfDelivered s
+  _fromTime <- readTVarIO fromTime
+  _tknCreated <- readTVarIO $ tknCreated s
+  _tknVerified <- readTVarIO $ tknVerified s
+  _tknDeleted <- readTVarIO $ tknDeleted s
+  _subCreated <- readTVarIO $ subCreated s
+  _subDeleted <- readTVarIO $ subDeleted s
+  _ntfReceived <- readTVarIO $ ntfReceived s
+  _ntfDelivered <- readTVarIO $ ntfDelivered s
   _activeTokens <- getPeriodStatsData $ activeTokens s
   _activeSubs <- getPeriodStatsData $ activeSubs s
   pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
diff --git a/src/Simplex/Messaging/Notifications/Server/Store.hs b/src/Simplex/Messaging/Notifications/Server/Store.hs
index 83dc1a4c2..b4d91dc88 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Store.hs
@@ -33,13 +33,13 @@ data NtfStore = NtfStore
     subscriptionLookup :: TMap SMPQueueNtf NtfSubscriptionId
   }
 
-newNtfStore :: STM NtfStore
+newNtfStore :: IO NtfStore
 newNtfStore = do
-  tokens <- TM.empty
-  tokenRegistrations <- TM.empty
-  subscriptions <- TM.empty
-  tokenSubscriptions <- TM.empty
-  subscriptionLookup <- TM.empty
+  tokens <- TM.emptyIO
+  tokenRegistrations <- TM.emptyIO
+  subscriptions <- TM.emptyIO
+  tokenSubscriptions <- TM.emptyIO
+  subscriptionLookup <- TM.emptyIO
   pure NtfStore {tokens, tokenRegistrations, subscriptions, tokenSubscriptions, subscriptionLookup}
 
 data NtfTknData = NtfTknData
@@ -77,6 +77,9 @@ data NtfEntityRec (e :: NtfEntity) where
 getNtfToken :: NtfStore -> NtfTokenId -> STM (Maybe NtfTknData)
 getNtfToken st tknId = TM.lookup tknId (tokens st)
 
+getNtfTokenIO :: NtfStore -> NtfTokenId -> IO (Maybe NtfTknData)
+getNtfTokenIO st tknId = TM.lookupIO tknId (tokens st)
+
 addNtfToken :: NtfStore -> NtfTokenId -> NtfTknData -> STM ()
 addNtfToken st tknId tkn@NtfTknData {token, tknVerifyKey} = do
   TM.insert tknId tkn $ tokens st
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index fb39c3240..c5d067475 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -428,7 +428,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                     putStat label var = getStat var >>= \v -> hPutStrLn h $ label <> ": " <> show v
                     putProxyStat :: String -> (ServerStats -> ProxyStats) -> IO ()
                     putProxyStat label var = do
-                      ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther} <- atomically $ getProxyStatsData $ var ss
+                      ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther} <- getProxyStatsData $ var ss
                       hPutStrLn h $ label <> ": requests=" <> show _pRequests <> ", successes=" <> show _pSuccesses <> ", errorsConnect=" <> show _pErrorsConnect <> ", errorsCompat=" <> show _pErrorsCompat <> ", errorsOther=" <> show _pErrorsOther
                 putStat "fromTime" fromTime
                 putStat "qCreated" qCreated
@@ -472,7 +472,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
 #endif
               CPSockets -> withUserRole $ do
                 (accepted', closed', active') <- unliftIO u $ asks sockets
-                (accepted, closed, active) <- atomically $ (,,) <$> readTVar accepted' <*> readTVar closed' <*> readTVar active'
+                (accepted, closed, active) <- (,,) <$> readTVarIO accepted' <*> readTVarIO closed' <*> readTVarIO active'
                 hPutStrLn h "Sockets: "
                 hPutStrLn h $ "accepted: " <> show accepted
                 hPutStrLn h $ "closed: " <> show closed
@@ -619,10 +619,8 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
   ts <- liftIO getSystemTime
   active <- asks clients
   nextClientId <- asks clientSeq
-  c <- atomically $ do
-    new@Client {clientId} <- newClient nextClientId q thVersion sessionId ts
-    modifyTVar' active $ IM.insert clientId new
-    pure new
+  c@Client {clientId} <- liftIO $ newClient nextClientId q thVersion sessionId ts
+  atomically $ modifyTVar' active $ IM.insert clientId c
   s <- asks server
   expCfg <- asks $ inactiveClientExpiration . config
   th <- newMVar h -- put TH under a fair lock to interleave messages and command responses
@@ -887,7 +885,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
         ProxyAgent {smpAgent = a} <- asks proxyAgent
         ServerStats {pMsgFwds, pMsgFwdsOwn} <- asks serverStats
         let inc = mkIncProxyStats pMsgFwds pMsgFwdsOwn
-        atomically (lookupSMPServerClient a sessId) >>= \case
+        liftIO (lookupSMPServerClient a sessId) >>= \case
           Just (own, smp) -> do
             inc own pRequests
             if v >= sendingProxySMPVersion
@@ -1138,7 +1136,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
 
         acknowledgeMsg :: QueueRec -> MsgId -> M (Transmission BrokerMsg)
         acknowledgeMsg qr msgId = time "ACK" $ do
-          atomically (TM.lookup entId subscriptions) >>= \case
+          liftIO (TM.lookupIO entId subscriptions) >>= \case
             Nothing -> pure $ err NO_MSG
             Just sub ->
               atomically (getDelivered sub) >>= \case
@@ -1524,7 +1522,7 @@ restoreServerMessages =
 saveServerStats :: M ()
 saveServerStats =
   asks (serverStatsBackupFile . config)
-    >>= mapM_ (\f -> asks serverStats >>= atomically . getServerStatsData >>= liftIO . saveStats f)
+    >>= mapM_ (\f -> asks serverStats >>= liftIO . getServerStatsData >>= liftIO . saveStats f)
   where
     saveStats f stats = do
       logInfo $ "saving server stats to file " <> T.pack f
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 7a3bcc362..84e664607 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -10,7 +10,6 @@ module Simplex.Messaging.Server.Env.STM where
 import Control.Concurrent (ThreadId)
 import Control.Logger.Simple
 import Control.Monad
-import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
@@ -175,29 +174,29 @@ data Sub = Sub
     delivered :: TMVar MsgId
   }
 
-newServer :: STM Server
+newServer :: IO Server
 newServer = do
-  subscribedQ <- newTQueue
-  subscribers <- TM.empty
-  ntfSubscribedQ <- newTQueue
-  notifiers <- TM.empty
-  savingLock <- createLock
+  subscribedQ <- newTQueueIO
+  subscribers <- TM.emptyIO
+  ntfSubscribedQ <- newTQueueIO
+  notifiers <- TM.emptyIO
+  savingLock <- atomically createLock
   return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, savingLock}
 
-newClient :: TVar ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> STM Client
+newClient :: TVar ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
 newClient nextClientId qSize thVersion sessionId createdAt = do
-  clientId <- stateTVar nextClientId $ \next -> (next, next + 1)
-  subscriptions <- TM.empty
-  ntfSubscriptions <- TM.empty
-  rcvQ <- newTBQueue qSize
-  sndQ <- newTBQueue qSize
-  msgQ <- newTBQueue qSize
-  procThreads <- newTVar 0
-  endThreads <- newTVar IM.empty
-  endThreadSeq <- newTVar 0
-  connected <- newTVar True
-  rcvActiveAt <- newTVar createdAt
-  sndActiveAt <- newTVar createdAt
+  clientId <- atomically $ stateTVar nextClientId $ \next -> (next, next + 1)
+  subscriptions <- TM.emptyIO
+  ntfSubscriptions <- TM.emptyIO
+  rcvQ <- newTBQueueIO qSize
+  sndQ <- newTBQueueIO qSize
+  msgQ <- newTBQueueIO qSize
+  procThreads <- newTVarIO 0
+  endThreads <- newTVarIO IM.empty
+  endThreadSeq <- newTVarIO 0
+  connected <- newTVarIO True
+  rcvActiveAt <- newTVarIO createdAt
+  sndActiveAt <- newTVarIO createdAt
   return Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, msgQ, procThreads, endThreads, endThreadSeq, thVersion, sessionId, connected, createdAt, rcvActiveAt, sndActiveAt}
 
 newSubscription :: SubscriptionThread -> STM Sub
@@ -213,10 +212,10 @@ newProhibitedSub = do
 
 newEnv :: ServerConfig -> IO Env
 newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile, storeLogFile, smpAgentCfg, transportConfig, information, messageExpiration} = do
-  server <- atomically newServer
-  queueStore <- atomically newQueueStore
-  msgStore <- atomically newMsgStore
-  random <- liftIO C.newRandom
+  server <- newServer
+  queueStore <- newQueueStore
+  msgStore <- newMsgStore
+  random <- C.newRandom
   storeLog <-
     forM storeLogFile $ \f -> do
       logInfo $ "restoring queues from file " <> T.pack f
@@ -224,20 +223,19 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
   tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
   Fingerprint fp <- loadFingerprint caCertificateFile
   let serverIdentity = KeyHash fp
-  serverStats <- atomically . newServerStats =<< getCurrentTime
-  sockets <- atomically newSocketState
+  serverStats <- newServerStats =<< getCurrentTime
+  sockets <- newSocketState
   clientSeq <- newTVarIO 0
   clients <- newTVarIO mempty
-  proxyAgent <- atomically $ newSMPProxyAgent smpAgentCfg random
+  proxyAgent <- newSMPProxyAgent smpAgentCfg random
   pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerParams, serverStats, sockets, clientSeq, clients, proxyAgent}
   where
     restoreQueues :: QueueStore -> FilePath -> IO (StoreLog 'WriteMode)
     restoreQueues QueueStore {queues, senders, notifiers} f = do
       (qs, s) <- readWriteStoreLog f
-      atomically $ do
-        writeTVar queues =<< mapM newTVar qs
-        writeTVar senders $! M.foldr' addSender M.empty qs
-        writeTVar notifiers $! M.foldr' addNotifier M.empty qs
+      atomically . writeTVar queues =<< mapM newTVarIO qs
+      atomically $ writeTVar senders $! M.foldr' addSender M.empty qs
+      atomically $ writeTVar notifiers $! M.foldr' addNotifier M.empty qs
       pure s
     addSender :: QueueRec -> Map SenderId RecipientId -> Map SenderId RecipientId
     addSender q = M.insert (senderId q) (recipientId q)
@@ -263,7 +261,7 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
           | isJust (storeMsgsFile config) = SPMMessages
           | otherwise = SPMQueues
 
-newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> STM ProxyAgent
+newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO ProxyAgent
 newSMPProxyAgent smpAgentCfg random = do
   smpAgent <- newSMPClientAgent smpAgentCfg random
   pure ProxyAgent {smpAgent}
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index 6f9c40e58..e0a5c8b45 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -41,8 +41,8 @@ data MsgQueue = MsgQueue
 
 type STMMsgStore = TMap RecipientId MsgQueue
 
-newMsgStore :: STM STMMsgStore
-newMsgStore = TM.empty
+newMsgStore :: IO STMMsgStore
+newMsgStore = TM.emptyIO
 
 getMsgQueue :: STMMsgStore -> RecipientId -> Int -> STM MsgQueue
 getMsgQueue st rId quota = maybe newQ pure =<< TM.lookup rId st
diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index d6cdaf10a..50907cf9a 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -38,11 +38,11 @@ data QueueStore = QueueStore
     notifiers :: TMap NotifierId RecipientId
   }
 
-newQueueStore :: STM QueueStore
+newQueueStore :: IO QueueStore
 newQueueStore = do
-  queues <- TM.empty
-  senders <- TM.empty
-  notifiers <- TM.empty
+  queues <- TM.emptyIO
+  senders <- TM.emptyIO
+  notifiers <- TM.emptyIO
   pure QueueStore {queues, senders, notifiers}
 
 addQueue :: QueueStore -> QueueRec -> STM (Either ErrorType ())
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index 377fddd1a..f5b430bb6 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -112,51 +112,51 @@ data ServerStatsData = ServerStatsData
   }
   deriving (Show)
 
-newServerStats :: UTCTime -> STM ServerStats
+newServerStats :: UTCTime -> IO ServerStats
 newServerStats ts = do
-  fromTime <- newTVar ts
-  qCreated <- newTVar 0
-  qSecured <- newTVar 0
-  qDeletedAll <- newTVar 0
-  qDeletedNew <- newTVar 0
-  qDeletedSecured <- newTVar 0
-  qSub <- newTVar 0
-  qSubNoMsg <- newTVar 0
-  qSubAuth <- newTVar 0
-  qSubDuplicate <- newTVar 0
-  qSubProhibited <- newTVar 0
-  ntfCreated <- newTVar 0
-  ntfDeleted <- newTVar 0
-  ntfSub <- newTVar 0
-  ntfSubAuth <- newTVar 0
-  ntfSubDuplicate <- newTVar 0
-  msgSent <- newTVar 0
-  msgSentAuth <- newTVar 0
-  msgSentQuota <- newTVar 0
-  msgSentLarge <- newTVar 0
-  msgRecv <- newTVar 0
-  msgRecvGet <- newTVar 0
-  msgGet <- newTVar 0
-  msgGetNoMsg <- newTVar 0
-  msgGetAuth <- newTVar 0
-  msgGetDuplicate <- newTVar 0
-  msgGetProhibited <- newTVar 0
-  msgExpired <- newTVar 0
+  fromTime <- newTVarIO ts
+  qCreated <- newTVarIO 0
+  qSecured <- newTVarIO 0
+  qDeletedAll <- newTVarIO 0
+  qDeletedNew <- newTVarIO 0
+  qDeletedSecured <- newTVarIO 0
+  qSub <- newTVarIO 0
+  qSubNoMsg <- newTVarIO 0
+  qSubAuth <- newTVarIO 0
+  qSubDuplicate <- newTVarIO 0
+  qSubProhibited <- newTVarIO 0
+  ntfCreated <- newTVarIO 0
+  ntfDeleted <- newTVarIO 0
+  ntfSub <- newTVarIO 0
+  ntfSubAuth <- newTVarIO 0
+  ntfSubDuplicate <- newTVarIO 0
+  msgSent <- newTVarIO 0
+  msgSentAuth <- newTVarIO 0
+  msgSentQuota <- newTVarIO 0
+  msgSentLarge <- newTVarIO 0
+  msgRecv <- newTVarIO 0
+  msgRecvGet <- newTVarIO 0
+  msgGet <- newTVarIO 0
+  msgGetNoMsg <- newTVarIO 0
+  msgGetAuth <- newTVarIO 0
+  msgGetDuplicate <- newTVarIO 0
+  msgGetProhibited <- newTVarIO 0
+  msgExpired <- newTVarIO 0
   activeQueues <- newPeriodStats
   subscribedQueues <- newPeriodStats
-  msgSentNtf <- newTVar 0
-  msgRecvNtf <- newTVar 0
+  msgSentNtf <- newTVarIO 0
+  msgRecvNtf <- newTVarIO 0
   activeQueuesNtf <- newPeriodStats
-  msgNtfs <- newTVar 0
-  msgNtfNoSub <- newTVar 0
-  msgNtfLost <- newTVar 0
+  msgNtfs <- newTVarIO 0
+  msgNtfNoSub <- newTVarIO 0
+  msgNtfLost <- newTVarIO 0
   pRelays <- newProxyStats
   pRelaysOwn <- newProxyStats
   pMsgFwds <- newProxyStats
   pMsgFwdsOwn <- newProxyStats
-  pMsgFwdsRecv <- newTVar 0
-  qCount <- newTVar 0
-  msgCount <- newTVar 0
+  pMsgFwdsRecv <- newTVarIO 0
+  qCount <- newTVarIO 0
+  msgCount <- newTVarIO 0
   pure
     ServerStats
       { fromTime,
@@ -204,51 +204,51 @@ newServerStats ts = do
         msgCount
       }
 
-getServerStatsData :: ServerStats -> STM ServerStatsData
+getServerStatsData :: ServerStats -> IO ServerStatsData
 getServerStatsData s = do
-  _fromTime <- readTVar $ fromTime s
-  _qCreated <- readTVar $ qCreated s
-  _qSecured <- readTVar $ qSecured s
-  _qDeletedAll <- readTVar $ qDeletedAll s
-  _qDeletedNew <- readTVar $ qDeletedNew s
-  _qDeletedSecured <- readTVar $ qDeletedSecured s
-  _qSub <- readTVar $ qSub s
-  _qSubNoMsg <- readTVar $ qSubNoMsg s
-  _qSubAuth <- readTVar $ qSubAuth s
-  _qSubDuplicate <- readTVar $ qSubDuplicate s
-  _qSubProhibited <- readTVar $ qSubProhibited s
-  _ntfCreated <- readTVar $ ntfCreated s
-  _ntfDeleted <- readTVar $ ntfDeleted s
-  _ntfSub <- readTVar $ ntfSub s
-  _ntfSubAuth <- readTVar $ ntfSubAuth s
-  _ntfSubDuplicate <- readTVar $ ntfSubDuplicate s
-  _msgSent <- readTVar $ msgSent s
-  _msgSentAuth <- readTVar $ msgSentAuth s
-  _msgSentQuota <- readTVar $ msgSentQuota s
-  _msgSentLarge <- readTVar $ msgSentLarge s
-  _msgRecv <- readTVar $ msgRecv s
-  _msgRecvGet <- readTVar $ msgRecvGet s
-  _msgGet <- readTVar $ msgGet s
-  _msgGetNoMsg <- readTVar $ msgGetNoMsg s
-  _msgGetAuth <- readTVar $ msgGetAuth s
-  _msgGetDuplicate <- readTVar $ msgGetDuplicate s
-  _msgGetProhibited <- readTVar $ msgGetProhibited s
-  _msgExpired <- readTVar $ msgExpired s
+  _fromTime <- readTVarIO $ fromTime s
+  _qCreated <- readTVarIO $ qCreated s
+  _qSecured <- readTVarIO $ qSecured s
+  _qDeletedAll <- readTVarIO $ qDeletedAll s
+  _qDeletedNew <- readTVarIO $ qDeletedNew s
+  _qDeletedSecured <- readTVarIO $ qDeletedSecured s
+  _qSub <- readTVarIO $ qSub s
+  _qSubNoMsg <- readTVarIO $ qSubNoMsg s
+  _qSubAuth <- readTVarIO $ qSubAuth s
+  _qSubDuplicate <- readTVarIO $ qSubDuplicate s
+  _qSubProhibited <- readTVarIO $ qSubProhibited s
+  _ntfCreated <- readTVarIO $ ntfCreated s
+  _ntfDeleted <- readTVarIO $ ntfDeleted s
+  _ntfSub <- readTVarIO $ ntfSub s
+  _ntfSubAuth <- readTVarIO $ ntfSubAuth s
+  _ntfSubDuplicate <- readTVarIO $ ntfSubDuplicate s
+  _msgSent <- readTVarIO $ msgSent s
+  _msgSentAuth <- readTVarIO $ msgSentAuth s
+  _msgSentQuota <- readTVarIO $ msgSentQuota s
+  _msgSentLarge <- readTVarIO $ msgSentLarge s
+  _msgRecv <- readTVarIO $ msgRecv s
+  _msgRecvGet <- readTVarIO $ msgRecvGet s
+  _msgGet <- readTVarIO $ msgGet s
+  _msgGetNoMsg <- readTVarIO $ msgGetNoMsg s
+  _msgGetAuth <- readTVarIO $ msgGetAuth s
+  _msgGetDuplicate <- readTVarIO $ msgGetDuplicate s
+  _msgGetProhibited <- readTVarIO $ msgGetProhibited s
+  _msgExpired <- readTVarIO $ msgExpired s
   _activeQueues <- getPeriodStatsData $ activeQueues s
   _subscribedQueues <- getPeriodStatsData $ subscribedQueues s
-  _msgSentNtf <- readTVar $ msgSentNtf s
-  _msgRecvNtf <- readTVar $ msgRecvNtf s
+  _msgSentNtf <- readTVarIO $ msgSentNtf s
+  _msgRecvNtf <- readTVarIO $ msgRecvNtf s
   _activeQueuesNtf <- getPeriodStatsData $ activeQueuesNtf s
-  _msgNtfs <- readTVar $ msgNtfs s
-  _msgNtfNoSub <- readTVar $ msgNtfNoSub s
-  _msgNtfLost <- readTVar $ msgNtfLost s
+  _msgNtfs <- readTVarIO $ msgNtfs s
+  _msgNtfNoSub <- readTVarIO $ msgNtfNoSub s
+  _msgNtfLost <- readTVarIO $ msgNtfLost s
   _pRelays <- getProxyStatsData $ pRelays s
   _pRelaysOwn <- getProxyStatsData $ pRelaysOwn s
   _pMsgFwds <- getProxyStatsData $ pMsgFwds s
   _pMsgFwdsOwn <- getProxyStatsData $ pMsgFwdsOwn s
-  _pMsgFwdsRecv <- readTVar $ pMsgFwdsRecv s
-  _qCount <- readTVar $ qCount s
-  _msgCount <- readTVar $ msgCount s
+  _pMsgFwdsRecv <- readTVarIO $ pMsgFwdsRecv s
+  _qCount <- readTVarIO $ qCount s
+  _msgCount <- readTVarIO $ msgCount s
   pure
     ServerStatsData
       { _fromTime,
@@ -510,11 +510,11 @@ data PeriodStats a = PeriodStats
     month :: TVar (Set a)
   }
 
-newPeriodStats :: STM (PeriodStats a)
+newPeriodStats :: IO (PeriodStats a)
 newPeriodStats = do
-  day <- newTVar S.empty
-  week <- newTVar S.empty
-  month <- newTVar S.empty
+  day <- newTVarIO S.empty
+  week <- newTVarIO S.empty
+  month <- newTVarIO S.empty
   pure PeriodStats {day, week, month}
 
 data PeriodStatsData a = PeriodStatsData
@@ -527,11 +527,11 @@ data PeriodStatsData a = PeriodStatsData
 newPeriodStatsData :: PeriodStatsData a
 newPeriodStatsData = PeriodStatsData {_day = S.empty, _week = S.empty, _month = S.empty}
 
-getPeriodStatsData :: PeriodStats a -> STM (PeriodStatsData a)
+getPeriodStatsData :: PeriodStats a -> IO (PeriodStatsData a)
 getPeriodStatsData s = do
-  _day <- readTVar $ day s
-  _week <- readTVar $ week s
-  _month <- readTVar $ month s
+  _day <- readTVarIO $ day s
+  _week <- readTVarIO $ week s
+  _month <- readTVarIO $ month s
   pure PeriodStatsData {_day, _week, _month}
 
 setPeriodStats :: PeriodStats a -> PeriodStatsData a -> STM ()
@@ -585,13 +585,13 @@ data ProxyStats = ProxyStats
     pErrorsOther :: TVar Int
   }
 
-newProxyStats :: STM ProxyStats
+newProxyStats :: IO ProxyStats
 newProxyStats = do
-  pRequests <- newTVar 0
-  pSuccesses <- newTVar 0
-  pErrorsConnect <- newTVar 0
-  pErrorsCompat <- newTVar 0
-  pErrorsOther <- newTVar 0
+  pRequests <- newTVarIO 0
+  pSuccesses <- newTVarIO 0
+  pErrorsConnect <- newTVarIO 0
+  pErrorsCompat <- newTVarIO 0
+  pErrorsOther <- newTVarIO 0
   pure ProxyStats {pRequests, pSuccesses, pErrorsConnect, pErrorsCompat, pErrorsOther}
 
 data ProxyStatsData = ProxyStatsData
@@ -606,13 +606,13 @@ data ProxyStatsData = ProxyStatsData
 newProxyStatsData :: ProxyStatsData
 newProxyStatsData = ProxyStatsData {_pRequests = 0, _pSuccesses = 0, _pErrorsConnect = 0, _pErrorsCompat = 0, _pErrorsOther = 0}
 
-getProxyStatsData :: ProxyStats -> STM ProxyStatsData
+getProxyStatsData :: ProxyStats -> IO ProxyStatsData
 getProxyStatsData s = do
-  _pRequests <- readTVar $ pRequests s
-  _pSuccesses <- readTVar $ pSuccesses s
-  _pErrorsConnect <- readTVar $ pErrorsConnect s
-  _pErrorsCompat <- readTVar $ pErrorsCompat s
-  _pErrorsOther <- readTVar $ pErrorsOther s
+  _pRequests <- readTVarIO $ pRequests s
+  _pSuccesses <- readTVarIO $ pSuccesses s
+  _pErrorsConnect <- readTVarIO $ pErrorsConnect s
+  _pErrorsCompat <- readTVarIO $ pErrorsCompat s
+  _pErrorsOther <- readTVarIO $ pErrorsOther s
   pure ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther}
 
 getResetProxyStatsData :: ProxyStats -> STM ProxyStatsData
diff --git a/src/Simplex/Messaging/TMap.hs b/src/Simplex/Messaging/TMap.hs
index 2f6e0cf8a..1bc9bcb60 100644
--- a/src/Simplex/Messaging/TMap.hs
+++ b/src/Simplex/Messaging/TMap.hs
@@ -1,11 +1,13 @@
 module Simplex.Messaging.TMap
   ( TMap,
-    empty,
+    emptyIO,
     singleton,
     clear,
     Simplex.Messaging.TMap.null,
     Simplex.Messaging.TMap.lookup,
+    lookupIO,
     member,
+    memberIO,
     insert,
     delete,
     lookupInsert,
@@ -24,9 +26,9 @@ import qualified Data.Map.Strict as M
 
 type TMap k a = TVar (Map k a)
 
-empty :: STM (TMap k a)
-empty = newTVar M.empty
-{-# INLINE empty #-}
+emptyIO :: IO (TMap k a)
+emptyIO = newTVarIO M.empty
+{-# INLINE emptyIO #-}
 
 singleton :: k -> a -> STM (TMap k a)
 singleton k v = newTVar $ M.singleton k v
@@ -44,10 +46,18 @@ lookup :: Ord k => k -> TMap k a -> STM (Maybe a)
 lookup k m = M.lookup k <$> readTVar m
 {-# INLINE lookup #-}
 
+lookupIO :: Ord k => k -> TMap k a -> IO (Maybe a)
+lookupIO k m = M.lookup k <$> readTVarIO m
+{-# INLINE lookupIO #-}
+
 member :: Ord k => k -> TMap k a -> STM Bool
 member k m = M.member k <$> readTVar m
 {-# INLINE member #-}
 
+memberIO :: Ord k => k -> TMap k a -> IO Bool
+memberIO k m = M.member k <$> readTVarIO m
+{-# INLINE memberIO #-}
+
 insert :: Ord k => k -> a -> TMap k a -> STM ()
 insert k v m = modifyTVar' m $ M.insert k v
 {-# INLINE insert #-}
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index d7f81f563..58843b7f5 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -285,7 +285,7 @@ getTLS :: TransportPeer -> TransportConfig -> X.CertificateChain -> T.Context ->
 getTLS tlsPeer cfg tlsServerCerts cxt = withTlsUnique tlsPeer cxt newTLS
   where
     newTLS tlsUniq = do
-      tlsBuffer <- atomically newTBuffer
+      tlsBuffer <- newTBuffer
       tlsALPN <- T.getNegotiatedProtocol cxt
       pure TLS {tlsContext = cxt, tlsALPN, tlsTransportConfig = cfg, tlsServerCerts, tlsPeer, tlsUniq, tlsBuffer}
 
diff --git a/src/Simplex/Messaging/Transport/Buffer.hs b/src/Simplex/Messaging/Transport/Buffer.hs
index 6de9326f8..a612afafc 100644
--- a/src/Simplex/Messaging/Transport/Buffer.hs
+++ b/src/Simplex/Messaging/Transport/Buffer.hs
@@ -17,10 +17,10 @@ data TBuffer = TBuffer
     getLock :: TMVar ()
   }
 
-newTBuffer :: STM TBuffer
+newTBuffer :: IO TBuffer
 newTBuffer = do
-  buffer <- newTVar ""
-  getLock <- newTMVar ()
+  buffer <- newTVarIO ""
+  getLock <- newTMVarIO ()
   pure TBuffer {buffer, getLock}
 
 withBufferLock :: TBuffer -> IO a -> IO a
diff --git a/src/Simplex/Messaging/Transport/HTTP2.hs b/src/Simplex/Messaging/Transport/HTTP2.hs
index 9c6cd7abc..3b741e6ce 100644
--- a/src/Simplex/Messaging/Transport/HTTP2.hs
+++ b/src/Simplex/Messaging/Transport/HTTP2.hs
@@ -75,7 +75,7 @@ instance HTTP2BodyChunk HS.Request where
 
 getHTTP2Body :: HTTP2BodyChunk a => a -> Int -> IO HTTP2Body
 getHTTP2Body r n = do
-  bodyBuffer <- atomically newTBuffer
+  bodyBuffer <- newTBuffer
   let getPart n' = getBuffered bodyBuffer n' Nothing $ getBodyChunk r
   bodyHead <- getPart n
   let bodySize = fromMaybe 0 $ getBodySize r
diff --git a/src/Simplex/Messaging/Transport/HTTP2/Client.hs b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
index 71757ca6d..d8d3d495d 100644
--- a/src/Simplex/Messaging/Transport/HTTP2/Client.hs
+++ b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
@@ -104,13 +104,13 @@ attachHTTP2Client config host port disconnected bufferSize tls = getVerifiedHTTP
 
 getVerifiedHTTP2ClientWith :: HTTP2ClientConfig -> TransportHost -> ServiceName -> IO () -> ((TLS -> H.Client HTTP2Response) -> IO HTTP2Response) -> IO (Either HTTP2ClientError HTTP2Client)
 getVerifiedHTTP2ClientWith config host port disconnected setup =
-  (atomically mkHTTPS2Client >>= runClient)
+  (mkHTTPS2Client >>= runClient)
     `E.catch` \(e :: IOException) -> pure . Left $ HCIOError e
   where
-    mkHTTPS2Client :: STM HClient
+    mkHTTPS2Client :: IO HClient
     mkHTTPS2Client = do
-      connected <- newTVar False
-      reqQ <- newTBQueue $ qSize config
+      connected <- newTVarIO False
+      reqQ <- newTBQueueIO $ qSize config
       pure HClient {connected, disconnected, host, port, config, reqQ}
 
     runClient :: HClient -> IO (Either HTTP2ClientError HTTP2Client)
diff --git a/src/Simplex/Messaging/Transport/Server.hs b/src/Simplex/Messaging/Transport/Server.hs
index ffde39991..0b4da7833 100644
--- a/src/Simplex/Messaging/Transport/Server.hs
+++ b/src/Simplex/Messaging/Transport/Server.hs
@@ -76,7 +76,7 @@ serverTransportConfig TransportServerConfig {logTLSErrors} =
 -- All accepted connections are passed to the passed function.
 runTransportServer :: forall c. Transport c => TMVar Bool -> ServiceName -> T.ServerParams -> TransportServerConfig -> (c -> IO ()) -> IO ()
 runTransportServer started port params cfg server = do
-  ss <- atomically newSocketState
+  ss <- newSocketState
   runTransportServerState ss started port params cfg server
 
 runTransportServerState :: forall c . Transport c => SocketState -> TMVar Bool -> ServiceName -> T.ServerParams -> TransportServerConfig -> (c -> IO ()) -> IO ()
@@ -85,7 +85,7 @@ runTransportServerState ss started port = runTransportServerSocketState ss start
 -- | Run a transport server with provided connection setup and handler.
 runTransportServerSocket :: Transport a => TMVar Bool -> IO Socket -> String -> T.ServerParams -> TransportServerConfig -> (a -> IO ()) -> IO ()
 runTransportServerSocket started getSocket threadLabel serverParams cfg server = do
-  ss <- atomically newSocketState
+  ss <- newSocketState
   runTransportServerSocketState ss started getSocket threadLabel serverParams cfg server
 
 -- | Run a transport server with provided connection setup and handler.
@@ -109,7 +109,7 @@ tlsServerCredentials serverParams = case T.sharedCredentials $ T.serverShared se
 -- | Run TCP server without TLS
 runTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
 runTCPServer started port server = do
-  ss <- atomically newSocketState
+  ss <- newSocketState
   runTCPServerSocket ss started (startTCPServer started port) server
 
 -- | Wrap socket provider in a TCP server bracket.
@@ -148,8 +148,8 @@ safeAccept sock =
 
 type SocketState = (TVar Int, TVar Int, TVar (IntMap (Weak ThreadId)))
 
-newSocketState :: STM SocketState
-newSocketState = (,,) <$> newTVar 0 <*> newTVar 0 <*> newTVar mempty
+newSocketState :: IO SocketState
+newSocketState = (,,) <$> newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO mempty
 
 closeServer :: TMVar Bool -> TVar (IntMap (Weak ThreadId)) -> Socket -> IO ()
 closeServer started clients sock = do
diff --git a/tests/CoreTests/BatchingTests.hs b/tests/CoreTests/BatchingTests.hs
index caab0637a..5f6beb034 100644
--- a/tests/CoreTests/BatchingTests.hs
+++ b/tests/CoreTests/BatchingTests.hs
@@ -261,7 +261,7 @@ testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
 testClientStub = do
   g <- C.newRandom
   sessId <- atomically $ C.randomBytes 32 g
-  atomically $ smpClientStub g sessId subModeSMPVersion Nothing
+  smpClientStub g sessId subModeSMPVersion Nothing
 
 clientStubV7 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
 clientStubV7 = do
@@ -269,7 +269,7 @@ clientStubV7 = do
   sessId <- atomically $ C.randomBytes 32 g
   (rKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
   thAuth_ <- testTHandleAuth authCmdsSMPVersion g rKey
-  atomically $ smpClientStub g sessId authCmdsSMPVersion thAuth_
+  smpClientStub g sessId authCmdsSMPVersion thAuth_
 
 randomSUB :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSUB = randomSUB_ C.SEd25519 subModeSMPVersion
diff --git a/tests/CoreTests/TRcvQueuesTests.hs b/tests/CoreTests/TRcvQueuesTests.hs
index 7e39d7fd9..24d54fc8e 100644
--- a/tests/CoreTests/TRcvQueuesTests.hs
+++ b/tests/CoreTests/TRcvQueuesTests.hs
@@ -43,7 +43,7 @@ checkDataInvariant trq = atomically $ do
 
 hasConnTest :: IO ()
 hasConnTest = do
-  trq <- atomically RQ.empty
+  trq <- RQ.empty
   atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
   checkDataInvariant trq `shouldReturn` True
   atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
@@ -57,7 +57,7 @@ hasConnTest = do
 
 hasConnTestBatch :: IO ()
 hasConnTestBatch = do
-  trq <- atomically RQ.empty
+  trq <- RQ.empty
   let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1", dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@beta" "c3"]
   atomically $ RQ.batchAddQueues trq qs
   checkDataInvariant trq `shouldReturn` True
@@ -68,7 +68,7 @@ hasConnTestBatch = do
 
 batchIdempotentTest :: IO ()
 batchIdempotentTest = do
-  trq <- atomically RQ.empty
+  trq <- RQ.empty
   let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1", dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@beta" "c3"]
   atomically $ RQ.batchAddQueues trq qs
   checkDataInvariant trq `shouldReturn` True
@@ -81,7 +81,7 @@ batchIdempotentTest = do
 
 deleteConnTest :: IO ()
 deleteConnTest = do
-  trq <- atomically RQ.empty
+  trq <- RQ.empty
   atomically $ do
     RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
     RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
@@ -95,7 +95,7 @@ deleteConnTest = do
 
 getSessQueuesTest :: IO ()
 getSessQueuesTest = do
-  trq <- atomically RQ.empty
+  trq <- RQ.empty
   atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
   checkDataInvariant trq `shouldReturn` True
   atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
@@ -104,14 +104,22 @@ getSessQueuesTest = do
   checkDataInvariant trq `shouldReturn` True
   atomically $ RQ.addQueue (dummyRQ 1 "smp://1234-w==@beta" "c4") trq
   checkDataInvariant trq `shouldReturn` True
-  atomically (RQ.getSessQueues (0, "smp://1234-w==@alpha", Just "c1") trq) `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c1"]
-  atomically (RQ.getSessQueues (1, "smp://1234-w==@alpha", Just "c1") trq) `shouldReturn` []
-  atomically (RQ.getSessQueues (0, "smp://1234-w==@alpha", Just "nope") trq) `shouldReturn` []
-  atomically (RQ.getSessQueues (0, "smp://1234-w==@alpha", Nothing) trq) `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"]
+  let tSess1 = (0, "smp://1234-w==@alpha", Just "c1")
+  RQ.getSessQueues tSess1 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c1"]
+  atomically (RQ.hasSessQueues tSess1 trq) `shouldReturn` True
+  let tSess2 = (1, "smp://1234-w==@alpha", Just "c1")
+  RQ.getSessQueues tSess2 trq `shouldReturn` []
+  atomically (RQ.hasSessQueues tSess2 trq) `shouldReturn` False
+  let tSess3 = (0, "smp://1234-w==@alpha", Just "nope")
+  RQ.getSessQueues tSess3 trq `shouldReturn` []
+  atomically (RQ.hasSessQueues tSess3 trq) `shouldReturn` False
+  let tSess4 = (0, "smp://1234-w==@alpha", Nothing)
+  RQ.getSessQueues tSess4 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"]
+  atomically (RQ.hasSessQueues tSess4 trq) `shouldReturn`True
 
 getDelSessQueuesTest :: IO ()
 getDelSessQueuesTest = do
-  trq <- atomically RQ.empty
+  trq <- RQ.empty
   let qs =
         [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
           ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
@@ -140,7 +148,7 @@ getDelSessQueuesTest = do
 
 removeSubsTest :: IO ()
 removeSubsTest = do
-  aq <- atomically RQ.empty
+  aq <- RQ.empty
   let qs =
         [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
           ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
@@ -149,7 +157,7 @@ removeSubsTest = do
         ]
   atomically $ RQ.batchAddQueues aq qs
 
-  pq <- atomically RQ.empty
+  pq <- RQ.empty
   atomically (totalSize aq pq) `shouldReturn` (4, 4)
 
   atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst

From 47dd0c4c64142cf5106c5448429d5b30273e0f7e Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 9 Aug 2024 21:10:27 +0100
Subject: [PATCH 062/195] agent: do not send worker crash errors when agent is
 not active (stopped) (#1256)

---
 src/Simplex/Messaging/Agent.hs        |  4 ++--
 src/Simplex/Messaging/Agent/Client.hs | 12 +++++++-----
 2 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index bdf83c8d6..672375aaf 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -2112,8 +2112,7 @@ cleanupManager c@AgentClient {subQ} = do
   liftIO $ threadDelay' delay
   int <- asks (cleanupInterval . config)
   ttl <- asks $ storedMsgDataTTL . config
-  forever $ do
-    liftIO $ waitUntilActive c
+  forever $ waitActive $ do
     run ERR deleteConns
     run ERR $ withStore' c (`deleteRcvMsgHashesExpired` ttl)
     run ERR $ withStore' c (`deleteSndMsgsExpired` ttl)
@@ -2133,6 +2132,7 @@ cleanupManager c@AgentClient {subQ} = do
       step <- asks $ cleanupStepInterval . config
       liftIO $ threadDelay step
     -- we are catching it to avoid CRITICAL errors in tests when this is the only remaining handle to active
+    waitActive :: ReaderT Env IO a -> AM' ()
     waitActive a = liftIO (E.tryAny $ waitUntilActive c) >>= either (\_ -> pure ()) (\_ -> void a)
     deleteConns =
       withLock (deleteLock c) "cleanupManager" $ do
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index d5262d2eb..23f0a98d1 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -372,13 +372,15 @@ getAgentWorker' toW fromW name hasWork c key ws work = do
           restart <- atomically $ getWorker >>= maybe (pure False) (shouldRestart e_ (toW w) t maxRestarts)
           when restart runWork
         shouldRestart e_ Worker {workerId = wId, doWork, action, restarts} t maxRestarts w'
-          | wId == workerId (toW w') =
-              checkRestarts . updateRestartCount t =<< readTVar restarts
+          | wId == workerId (toW w') = do
+              rc <- readTVar restarts
+              isActive <- readTVar $ active c
+              checkRestarts isActive $ updateRestartCount t rc
           | otherwise =
               pure False -- there is a new worker in the map, no action
           where
-            checkRestarts rc
-              | restartCount rc < maxRestarts = do
+            checkRestarts isActive rc
+              | isActive && restartCount rc < maxRestarts = do
                   writeTVar restarts rc
                   hasWorkToDo' doWork
                   void $ tryPutTMVar action Nothing
@@ -386,7 +388,7 @@ getAgentWorker' toW fromW name hasWork c key ws work = do
                   pure True
               | otherwise = do
                   TM.delete key ws
-                  notifyErr $ CRITICAL True
+                  when isActive $ notifyErr $ CRITICAL True
                   pure False
               where
                 notifyErr err = do

From 0dd52dc69f197a86f2f03e47b339bf3a94a596a3 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Fri, 9 Aug 2024 23:09:09 +0100
Subject: [PATCH 063/195] v6.0.0 (6.0.0.8)

---
 CHANGELOG.md    | 23 +++++++++++++++++++++++
 package.yaml    |  2 +-
 simplexmq.cabal |  2 +-
 3 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 90706a19e..9696a64b3 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,26 @@
+# 6.0.0
+
+Version 6.0.0.8
+
+Agent:
+- enabled fast handshake support.
+- batch-send multiple messages in each connection.
+- resume subscriptions as soon as agent moves to foreground or as network connection resumes.
+- "known" servers to determine whether to use SMP proxy.
+- retry on SMP proxy NO_SESSION error.
+- fixes to notification subscriptions.
+- persistent server statistics.
+- better concurrency.
+
+SMP server:
+- reduce threads usage.
+- additional statistics.
+- improve disabling inactive clients.
+- additional control port commands for monitoring.
+
+Notification server:
+- support onion-only SMP servers.
+
 # 5.8.2
 
 Agent:
diff --git a/package.yaml b/package.yaml
index fd2139201..26cdcc51a 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.0.7
+version: 6.0.0.8
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 37adcec2e..d557ac509 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.0.7
+version:        6.0.0.8
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From f229e135e33ec5ee1f6d0978bd903d84b0b60efa Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 16 Aug 2024 10:06:22 +0100
Subject: [PATCH 064/195] agent: reduce subscription transactions (#1259)

* agent: reduce subscription transactions

* nub

* remove commented
---
 src/Simplex/Messaging/Agent.hs              | 14 ++++++--------
 src/Simplex/Messaging/Agent/Client.hs       |  4 ----
 src/Simplex/Messaging/Agent/Store/SQLite.hs |  4 ++++
 3 files changed, 10 insertions(+), 12 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 672375aaf..17d11246c 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -131,6 +131,7 @@ import Data.Bifunctor (bimap, first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Composition ((.:), (.:.), (.::), (.::.))
+import Data.Containers.ListUtils (nubOrd)
 import Data.Either (isRight, rights)
 import Data.Foldable (foldl', toList)
 import Data.Functor (($>))
@@ -959,7 +960,7 @@ subscribeConnections' c connIds = do
       errs' = M.map (Left . storeError) errs
       (subRs, rcvQs) = M.mapEither rcvQueueOrResult cs
   mapM_ (mapM_ (\(cData, sqs) -> mapM_ (lift . resumeMsgDelivery c cData) sqs) . sndQueue) cs
-  mapM_ (resumeConnCmds c) $ M.keys cs
+  lift $ resumeConnCmds c $ M.keys cs
   rcvRs <- lift $ connResults . fst <$> subscribeQueues c (concat $ M.elems rcvQs)
   ns <- asks ntfSupervisor
   tkn <- readTVarIO (ntfTkn ns)
@@ -1118,13 +1119,10 @@ resumeSrvCmds :: AgentClient -> Maybe SMPServer -> AM' ()
 resumeSrvCmds = void .: getAsyncCmdWorker False
 {-# INLINE resumeSrvCmds #-}
 
-resumeConnCmds :: AgentClient -> ConnId -> AM ()
-resumeConnCmds c connId =
-  unlessM connQueued $
-    withStore' c (`getPendingCommandServers` connId)
-      >>= mapM_ (lift . resumeSrvCmds c)
-  where
-    connQueued = atomically $ isJust <$> TM.lookupInsert connId True (connCmdsQueued c)
+resumeConnCmds :: AgentClient -> [ConnId] -> AM' ()
+resumeConnCmds c connIds = do
+  srvs <- nubOrd . concat . rights <$> withStoreBatch' c (\db -> fmap (getPendingCommandServers db) connIds)
+  mapM_ (resumeSrvCmds c) srvs
 
 getAsyncCmdWorker :: Bool -> AgentClient -> Maybe SMPServer -> AM' Worker
 getAsyncCmdWorker hasWork c server =
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 23f0a98d1..02b31cb95 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -313,7 +313,6 @@ data AgentClient = AgentClient
     workerSeq :: TVar Int,
     smpDeliveryWorkers :: TMap SndQAddr (Worker, TMVar ()),
     asyncCmdWorkers :: TMap (Maybe SMPServer) Worker,
-    connCmdsQueued :: TMap ConnId Bool,
     ntfNetworkOp :: TVar AgentOpState,
     rcvNetworkOp :: TVar AgentOpState,
     msgDeliveryOp :: TVar AgentOpState,
@@ -480,7 +479,6 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
   workerSeq <- newTVarIO 0
   smpDeliveryWorkers <- TM.emptyIO
   asyncCmdWorkers <- TM.emptyIO
-  connCmdsQueued <- TM.emptyIO
   ntfNetworkOp <- newTVarIO $ AgentOpState False 0
   rcvNetworkOp <- newTVarIO $ AgentOpState False 0
   msgDeliveryOp <- newTVarIO $ AgentOpState False 0
@@ -519,7 +517,6 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
         workerSeq,
         smpDeliveryWorkers,
         asyncCmdWorkers,
-        connCmdsQueued,
         ntfNetworkOp,
         rcvNetworkOp,
         msgDeliveryOp,
@@ -893,7 +890,6 @@ closeAgentClient c = do
   atomically (swapTVar (smpSubWorkers c) M.empty) >>= mapM_ cancelReconnect
   clearWorkers smpDeliveryWorkers >>= mapM_ (cancelWorker . fst)
   clearWorkers asyncCmdWorkers >>= mapM_ cancelWorker
-  clear connCmdsQueued
   atomically . RQ.clear $ activeSubs c
   atomically . RQ.clear $ pendingSubs c
   clear subscrConns
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 20f382d40..e0e4fc58f 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -1909,9 +1909,11 @@ newQueueId_ (Only maxId : _) = DBQueueId (maxId + 1)
 
 getConn :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
 getConn = getAnyConn False
+{-# INLINE getConn #-}
 
 getDeletedConn :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
 getDeletedConn = getAnyConn True
+{-# INLINE getDeletedConn #-}
 
 getAnyConn :: Bool -> DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
 getAnyConn deleted' dbConn connId =
@@ -1932,9 +1934,11 @@ getAnyConn deleted' dbConn connId =
 
 getConns :: DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
 getConns = getAnyConns_ False
+{-# INLINE getConns #-}
 
 getDeletedConns :: DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
 getDeletedConns = getAnyConns_ True
+{-# INLINE getDeletedConns #-}
 
 getAnyConns_ :: Bool -> DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
 getAnyConns_ deleted' db connIds = forM connIds $ E.handle handleDBError . getAnyConn deleted' db

From 5ad6e5f2f33ff7c26122bb53435bdfccbc99b707 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 18 Aug 2024 13:55:12 +0100
Subject: [PATCH 065/195] deps: upgrade tls to 1.9 (#1265)

* deps: use tls-2.0

* roll back RCP "cleanup"

* use tls 1.9

---------

Co-authored-by: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
---
 package.yaml                                  |  2 +-
 simplexmq.cabal                               | 12 ++++++------
 src/Simplex/Messaging/Transport.hs            |  8 +++++---
 src/Simplex/Messaging/Transport/WebSockets.hs | 11 +++++++----
 src/Simplex/RemoteControl/Client.hs           |  2 +-
 5 files changed, 20 insertions(+), 15 deletions(-)

diff --git a/package.yaml b/package.yaml
index 26cdcc51a..ceff0afb9 100644
--- a/package.yaml
+++ b/package.yaml
@@ -69,7 +69,7 @@ dependencies:
   - temporary == 1.3.*
   - time == 1.12.*
   - time-manager == 0.0.*
-  - tls >= 1.7.0 && < 1.8
+  - tls >= 1.9.0 && < 1.10
   - transformers == 0.6.*
   - unliftio == 0.2.*
   - unliftio-core == 0.2.*
diff --git a/simplexmq.cabal b/simplexmq.cabal
index d557ac509..44e39c8ae 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -258,7 +258,7 @@ library
     , temporary ==1.3.*
     , time ==1.12.*
     , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -333,7 +333,7 @@ executable ntf-server
     , temporary ==1.3.*
     , time ==1.12.*
     , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -412,7 +412,7 @@ executable smp-server
     , temporary ==1.3.*
     , time ==1.12.*
     , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -490,7 +490,7 @@ executable xftp
     , temporary ==1.3.*
     , time ==1.12.*
     , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -565,7 +565,7 @@ executable xftp-server
     , temporary ==1.3.*
     , time ==1.12.*
     , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -681,7 +681,7 @@ test-suite simplexmq-test
     , time ==1.12.*
     , time-manager ==0.0.*
     , timeit ==2.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index 58843b7f5..3386f82f3 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -113,6 +113,7 @@ import Simplex.Messaging.Transport.Buffer
 import Simplex.Messaging.Util (bshow, catchAll, catchAll_, liftEitherWith)
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
+import System.IO.Error (isEOFError)
 import UnliftIO.Exception (Exception)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
@@ -339,11 +340,12 @@ instance Transport TLS where
 
   getLn :: TLS -> IO ByteString
   getLn TLS {tlsContext, tlsBuffer} = do
-    getLnBuffered tlsBuffer (T.recvData tlsContext) `E.catch` handleEOF
+    getLnBuffered tlsBuffer (T.recvData tlsContext) `E.catches` [E.Handler handleTlsEOF, E.Handler handleEOF]
     where
-      handleEOF = \case
-        T.Error_EOF -> E.throwIO TEBadBlock
+      handleTlsEOF = \case
+        T.PostHandshake T.Error_EOF -> E.throwIO TEBadBlock
         e -> E.throwIO e
+      handleEOF e = if isEOFError e then E.throwIO TEBadBlock else E.throwIO e
 
 -- * SMP transport
 
diff --git a/src/Simplex/Messaging/Transport/WebSockets.hs b/src/Simplex/Messaging/Transport/WebSockets.hs
index 0883fcc28..866d0d197 100644
--- a/src/Simplex/Messaging/Transport/WebSockets.hs
+++ b/src/Simplex/Messaging/Transport/WebSockets.hs
@@ -25,6 +25,7 @@ import Simplex.Messaging.Transport
     withTlsUnique,
   )
 import Simplex.Messaging.Transport.Buffer (trimCR)
+import System.IO.Error (isEOFError)
 
 data WS = WS
   { wsPeer :: TransportPeer,
@@ -108,9 +109,11 @@ makeTLSContextStream cxt =
   S.makeStream readStream writeStream
   where
     readStream :: IO (Maybe ByteString)
-    readStream =
-      (Just <$> T.recvData cxt) `E.catch` \case
-        T.Error_EOF -> pure Nothing
-        e -> E.throwIO e
+    readStream = (Just <$> T.recvData cxt) `E.catches` [E.Handler handleTlsEOF, E.Handler handleEOF]
+      where
+        handleTlsEOF = \case
+          T.PostHandshake T.Error_EOF -> pure Nothing
+          e -> E.throwIO e
+        handleEOF e = if isEOFError e then pure Nothing else E.throwIO e
     writeStream :: Maybe LB.ByteString -> IO ()
     writeStream = maybe (closeTLS cxt) (T.sendData cxt)
diff --git a/src/Simplex/RemoteControl/Client.hs b/src/Simplex/RemoteControl/Client.hs
index de0cbce3b..381397c6e 100644
--- a/src/Simplex/RemoteControl/Client.hs
+++ b/src/Simplex/RemoteControl/Client.hs
@@ -305,7 +305,7 @@ connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca,
 
 catchRCError :: ExceptT RCErrorType IO a -> (RCErrorType -> ExceptT RCErrorType IO a) -> ExceptT RCErrorType IO a
 catchRCError = catchAllErrors $ \e -> case fromException e of
-  Just (TLS.Terminated _ _ (TLS.Error_Protocol (_, _, TLS.UnknownCa))) -> RCEIdentity
+  Just (TLS.Terminated _ _ (TLS.Error_Protocol _ TLS.UnknownCa)) -> RCEIdentity
   _ -> RCEException $ show e
 {-# INLINE catchRCError #-}
 

From 32a150eb4030e91c59c077440143889c0d0321ff Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 18 Aug 2024 14:07:09 +0100
Subject: [PATCH 066/195] agent: enable notifications for all connections
 (#1262)

---
 src/Simplex/Messaging/Agent.hs | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 17d11246c..6ae73061a 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -959,12 +959,12 @@ subscribeConnections' c connIds = do
   let (errs, cs) = M.mapEither id conns
       errs' = M.map (Left . storeError) errs
       (subRs, rcvQs) = M.mapEither rcvQueueOrResult cs
-  mapM_ (mapM_ (\(cData, sqs) -> mapM_ (lift . resumeMsgDelivery c cData) sqs) . sndQueue) cs
+  lift $ mapM_ (mapM_ (\(cData, sqs) -> mapM_ (resumeMsgDelivery c cData) sqs) . sndQueue) cs
   lift $ resumeConnCmds c $ M.keys cs
   rcvRs <- lift $ connResults . fst <$> subscribeQueues c (concat $ M.elems rcvQs)
   ns <- asks ntfSupervisor
   tkn <- readTVarIO (ntfTkn ns)
-  when (instantNotifications tkn) . void . lift . forkIO . void . runExceptT $ sendNtfCreate ns rcvRs conns
+  lift $ when (instantNotifications tkn) . void . forkIO . void $ sendNtfCreate ns cs
   let rs = M.unions ([errs', subRs, rcvRs] :: [Map ConnId (Either AgentErrorType ())])
   notifyResultError rs
   pure rs
@@ -996,15 +996,15 @@ subscribeConnections' c connIds = do
         order (Active, _) = 2
         order (_, Right _) = 3
         order _ = 4
-    sendNtfCreate :: NtfSupervisor -> Map ConnId (Either AgentErrorType ()) -> Map ConnId (Either StoreError SomeConn) -> AM ()
-    sendNtfCreate ns rcvRs conns =
-      forM_ (M.assocs rcvRs) $ \case
-        (connId, Right _) -> forM_ (M.lookup connId conns) $ \case
-          Right (SomeConn _ conn) -> do
-            let cmd = if enableNtfs $ toConnData conn then NSCCreate else NSCDelete
-            atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)
-          _ -> pure ()
-        _ -> pure ()
+    sendNtfCreate :: NtfSupervisor -> Map ConnId SomeConn -> AM' ()
+    sendNtfCreate ns cs =
+      -- TODO this needs to be batched end to end.
+      -- Currently, the only change is to ignore failed subscriptions.
+      forM_ cs $ \case
+        SomeConn _ conn -> do
+          let cmd = if enableNtfs $ toConnData conn then NSCCreate else NSCDelete
+              ConnData {connId} = toConnData conn
+          atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)            
     sndQueue :: SomeConn -> Maybe (ConnData, NonEmpty SndQueue)
     sndQueue (SomeConn _ conn) = case conn of
       DuplexConnection cData _ sqs -> Just (cData, sqs)

From 571d148bdf9e29403b9bcec6f7daeff815a4db38 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 18 Aug 2024 21:30:06 +0100
Subject: [PATCH 067/195] agent: do not start delivery workers when there are
 no messages to deliver (#1263)

* agent: use weak ThreadId and forkIO in workers instead of async (reduce memory)

* agent: do not start and exit delivery workers when there are no messages to deliver (#1264)

* agent: exit delivery workers when no messages to deliver

* only start delivery workers when there are pending messages

* fix

* focus test

* enable all tests

* lift

* do not exit workers when there is no work
---
 src/Simplex/Messaging/Agent.hs              | 6 +++++-
 src/Simplex/Messaging/Agent/Client.hs       | 9 +++++----
 src/Simplex/Messaging/Agent/Env/SQLite.hs   | 6 ++++--
 src/Simplex/Messaging/Agent/Store/SQLite.hs | 5 +++++
 tests/AgentTests/NotificationTests.hs       | 2 ++
 5 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 6ae73061a..f93a0b1a6 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -959,7 +959,7 @@ subscribeConnections' c connIds = do
   let (errs, cs) = M.mapEither id conns
       errs' = M.map (Left . storeError) errs
       (subRs, rcvQs) = M.mapEither rcvQueueOrResult cs
-  lift $ mapM_ (mapM_ (\(cData, sqs) -> mapM_ (resumeMsgDelivery c cData) sqs) . sndQueue) cs
+  resumeDelivery cs
   lift $ resumeConnCmds c $ M.keys cs
   rcvRs <- lift $ connResults . fst <$> subscribeQueues c (concat $ M.elems rcvQs)
   ns <- asks ntfSupervisor
@@ -1005,6 +1005,10 @@ subscribeConnections' c connIds = do
           let cmd = if enableNtfs $ toConnData conn then NSCCreate else NSCDelete
               ConnData {connId} = toConnData conn
           atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)            
+    resumeDelivery :: Map ConnId SomeConn -> AM ()
+    resumeDelivery conns = do
+      conns' <- M.restrictKeys conns . S.fromList <$> withStore' c getConnectionsForDelivery
+      lift $ mapM_ (mapM_ (\(cData, sqs) -> mapM_ (resumeMsgDelivery c cData) sqs) . sndQueue) conns'
     sndQueue :: SomeConn -> Maybe (ConnData, NonEmpty SndQueue)
     sndQueue (SomeConn _ conn) = case conn of
       DuplexConnection cData _ sqs -> Just (cData, sqs)
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 02b31cb95..fbdb53548 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -163,7 +163,7 @@ module Simplex.Messaging.Agent.Client
 where
 
 import Control.Applicative ((<|>))
-import Control.Concurrent (ThreadId, forkIO)
+import Control.Concurrent (ThreadId, killThread)
 import Control.Concurrent.Async (Async, uninterruptibleCancel)
 import Control.Concurrent.STM (retry)
 import Control.Exception (AsyncException (..), BlockedIndefinitelyOnSTM (..))
@@ -266,10 +266,11 @@ import Simplex.Messaging.Transport (SMPVersion, SessionId, THandleParams (sessio
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
-import System.Mem.Weak (Weak)
+import System.Mem.Weak (Weak, deRefWeak)
 import System.Random (randomR)
 import UnliftIO (mapConcurrently, timeout)
 import UnliftIO.Async (async)
+import UnliftIO.Concurrent (forkIO, mkWeakThreadId)
 import UnliftIO.Directory (doesFileExist, getTemporaryDirectory, removeFile)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
@@ -410,7 +411,7 @@ runWorkerAsync Worker {action} work =
     (atomically . tryPutTMVar action) -- if it was running (or if start crashes), put it back and unlock (don't lock if it was just started)
     (\a -> when (isNothing a) start) -- start worker if it's not running
   where
-    start = atomically . putTMVar action . Just =<< async work
+    start = atomically . putTMVar action . Just =<< mkWeakThreadId =<< forkIO work
 
 data AgentOperation = AONtfNetwork | AORcvNetwork | AOMsgDelivery | AOSndNetwork | AODatabase
   deriving (Eq, Show)
@@ -905,7 +906,7 @@ closeAgentClient c = do
 cancelWorker :: Worker -> IO ()
 cancelWorker Worker {doWork, action} = do
   noWorkToDo doWork
-  atomically (tryTakeTMVar action) >>= mapM_ (mapM_ uninterruptibleCancel)
+  atomically (tryTakeTMVar action) >>= mapM_ (mapM_ $ deRefWeak >=> mapM_ killThread)
 
 waitUntilActive :: AgentClient -> IO ()
 waitUntilActive AgentClient {active} = unlessM (readTVarIO active) $ atomically $ unlessM (readTVar active) retry
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index f57cf91e9..bc5e800c5 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -41,6 +41,7 @@ module Simplex.Messaging.Agent.Env.SQLite
   )
 where
 
+import Control.Concurrent (ThreadId)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
@@ -76,8 +77,9 @@ import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPVersion, TLS, Transport (..))
 import Simplex.Messaging.Transport.Client (defaultSMPPort)
 import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors')
+import System.Mem.Weak (Weak)
 import System.Random (StdGen, newStdGen)
-import UnliftIO (Async, SomeException)
+import UnliftIO (SomeException)
 import UnliftIO.STM
 
 type AM' a = ReaderT Env IO a
@@ -312,7 +314,7 @@ mkInternal = INTERNAL . show
 data Worker = Worker
   { workerId :: Int,
     doWork :: TMVar (),
-    action :: TMVar (Maybe (Async ())),
+    action :: TMVar (Maybe (Weak ThreadId)),
     restarts :: TVar RestartCount
   }
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index e0e4fc58f..fd29bd743 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -110,6 +110,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     getSndMsgViaRcpt,
     updateSndMsgRcpt,
     getPendingQueueMsg,
+    getConnectionsForDelivery,
     updatePendingMsgRIState,
     deletePendingMsgs,
     getExpiredSndMessages,
@@ -1008,6 +1009,10 @@ updateSndMsgRcpt db connId sndMsgId MsgReceipt {agentMsgId, msgRcptStatus} =
     "UPDATE snd_messages SET rcpt_internal_id = ?, rcpt_status = ? WHERE conn_id = ? AND internal_snd_id = ?"
     (agentMsgId, msgRcptStatus, connId, sndMsgId)
 
+getConnectionsForDelivery :: DB.Connection -> IO [ConnId]
+getConnectionsForDelivery db =
+  map fromOnly <$> DB.query_ db "SELECT DISTINCT conn_id FROM snd_message_deliveries WHERE failed = 0"
+
 getPendingQueueMsg :: DB.Connection -> ConnId -> SndQueue -> IO (Either StoreError (Maybe (Maybe RcvQueue, PendingMsgData)))
 getPendingQueueMsg db connId SndQueue {dbQueueId} =
   getWorkItem "message" getMsgId getMsgData markMsgFailed
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index cc79faeca..012da704d 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -508,6 +508,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
   suspendAgent alice 0
   closeSQLiteStore store
   threadDelay 1000000
+  print "before opening the database from another agent"
 
   -- aliceNtf client doesn't have subscription and is allowed to get notification message
   withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do
@@ -515,6 +516,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
     pure ()
 
   threadDelay 1000000
+  print "after closing the database in another agent"
   reopenSQLiteStore store
   foregroundAgent alice
   threadDelay 500000

From 1cbf8c0015a8014bcc9d1894055d734947176684 Mon Sep 17 00:00:00 2001
From: Diogo <diogofncunha@gmail.com>
Date: Tue, 20 Aug 2024 10:57:09 +0100
Subject: [PATCH 068/195] agent: support changing user of the new connection
 (#1267)

* agent: support new connection user id update

* another way for assertion

* add more tests to setConnUserId

* remove fdescribes

* allow rcv connection to change user id

* add functional test to api

* remove fdescribe

* refactor

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
---
 src/Simplex/Messaging/Agent.hs              | 16 +++++++++++++++
 src/Simplex/Messaging/Agent/Store/SQLite.hs |  5 +++++
 tests/AgentTests/FunctionalAPITests.hs      | 22 +++++++++++++++++++++
 tests/AgentTests/SQLiteTests.hs             | 17 ++++++++++++++++
 4 files changed, 60 insertions(+)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index f93a0b1a6..b1674389f 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -53,6 +53,7 @@ module Simplex.Messaging.Agent
     deleteConnectionAsync,
     deleteConnectionsAsync,
     createConnection,
+    changeConnectionUser,
     prepareConnectionToJoin,
     joinConnection,
     allowConnection,
@@ -334,6 +335,11 @@ createConnection :: AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe
 createConnection c userId enableNtfs = withAgentEnv c .:: newConn c userId "" enableNtfs
 {-# INLINE createConnection #-}
 
+-- | Changes the user id associated with a connection 
+changeConnectionUser :: AgentClient -> UserId -> ConnId -> UserId -> AE ()
+changeConnectionUser c oldUserId connId newUserId = withAgentEnv c $ changeConnectionUser' c oldUserId connId newUserId
+{-# INLINE changeConnectionUser #-}
+
 -- | Create SMP agent connection without queue (to be joined with joinConnection passing connection ID).
 -- This method is required to prevent race condition when confirmation from peer is received before
 -- the caller of joinConnection saves connection ID to the database.
@@ -742,6 +748,16 @@ newConn :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe
 newConn c userId connId enableNtfs cMode clientData pqInitKeys subMode =
   getSMPServer c userId >>= newConnSrv c userId connId False enableNtfs cMode clientData pqInitKeys subMode
 
+changeConnectionUser' :: AgentClient -> UserId -> ConnId -> UserId -> AM ()
+changeConnectionUser' c oldUserId connId newUserId = do
+  SomeConn _ conn <- withStore c (`getConn` connId)
+  case conn of
+    NewConnection {} -> updateConn
+    RcvConnection {} -> updateConn
+    _ -> throwE $ CMD PROHIBITED "changeConnectionUser: established connection"
+  where
+    updateConn = withStore' c $ \db -> setConnUserId db oldUserId connId newUserId
+
 newConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, ConnectionRequestUri c)
 newConnSrv c userId connId hasNewConn enableNtfs cMode clientData pqInitKeys subMode srv = do
   connId' <-
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index fd29bd743..69b1b07e9 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -57,6 +57,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     getDeletedConns,
     getConnData,
     setConnDeleted,
+    setConnUserId,
     setConnAgentVersion,
     setConnPQSupport,
     getDeletedConnIds,
@@ -1976,6 +1977,10 @@ setConnDeleted db waitDelivery connId
   | otherwise =
       DB.execute db "UPDATE connections SET deleted = ? WHERE conn_id = ?" (True, connId)
 
+setConnUserId :: DB.Connection -> UserId -> ConnId -> UserId -> IO ()
+setConnUserId db oldUserId connId newUserId = 
+  DB.execute db "UPDATE connections SET user_id = ? WHERE conn_id = ? and user_id = ?" (newUserId, connId, oldUserId)
+
 setConnAgentVersion :: DB.Connection -> ConnId -> VersionSMPA -> IO ()
 setConnAgentVersion db connId aVersion =
   DB.execute db "UPDATE connections SET smp_agent_version = ? WHERE conn_id = ?" (aVersion, connId)
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 4d61d8463..f0a25b758 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -283,6 +283,9 @@ functionalAPITests t = do
     testPQMatrix3 t $ runAgentClientContactTestPQ3 True
   it "should support rejecting contact request" $
     withSmpServer t testRejectContactRequest
+  describe "Changing connection user id" $ do
+    it "should change user id for new connections" $ do
+      withSmpServer t testUpdateConnectionUserId
   describe "Establishing connection asynchronously" $ do
     it "should connect with initiating client going offline" $
       withSmpServer t testAsyncInitiatingOffline
@@ -912,6 +915,25 @@ testRejectContactRequest =
     rejectContact alice addrConnId invId
     liftIO $ noMessages bob "nothing delivered to bob"
 
+testUpdateConnectionUserId :: HasCallStack => IO ()
+testUpdateConnectionUserId =
+  withAgentClients2 $ \alice bob -> runRight_ $ do
+    (connId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
+    newUserId <- createUser alice [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer]
+    _ <- changeConnectionUser alice 1 connId newUserId
+    aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
+    (aliceId', sqSecured') <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+    liftIO $ do
+      aliceId' `shouldBe` aliceId
+      sqSecured' `shouldBe` True
+    ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
+    liftIO $ pqSup' `shouldBe` PQSupportOn
+    allowConnection alice connId confId "alice's connInfo"
+    let pqEnc = CR.pqSupportToEnc PQSupportOn
+    get alice ##> ("", connId, A.CON pqEnc)
+    get bob ##> ("", aliceId, A.INFO PQSupportOn "alice's connInfo")
+    get bob ##> ("", aliceId, A.CON pqEnc)
+
 testAsyncInitiatingOffline :: HasCallStack => IO ()
 testAsyncInitiatingOffline =
   withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> runRight_ $ do
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index 39a4b1b95..95096e800 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -114,6 +114,8 @@ storeTests = do
           testDeleteRcvConn
           testDeleteSndConn
           testDeleteDuplexConn
+        describe "setConnUserId" $ do
+          testSetConnUserIdNewConn
         describe "upgradeRcvConnToDuplex" $ do
           testUpgradeRcvConnToDuplex
         describe "upgradeSndConnToDuplex" $ do
@@ -336,6 +338,21 @@ testGetRcvConn =
     getRcvConn db smpServer recipientId
       `shouldReturn` Right (rq, SomeConn SCRcv (RcvConnection cData1 rq))
 
+testSetConnUserIdNewConn :: SpecWith SQLiteStore
+testSetConnUserIdNewConn =
+  it "should set user id for new connection" . withStoreTransaction $ \db -> do
+    g <- C.newRandom
+    Right connId <- createNewConn db g cData1 {connId = ""} SCMInvitation
+    newUserId <- createUserRecord db
+    _ <- setConnUserId db 1 connId newUserId
+    connResult <- getConn db connId
+    case connResult of
+      Right (SomeConn SCNew (NewConnection connData)) -> do
+        let ConnData {userId} = connData
+        userId `shouldBe` newUserId
+      _ -> do
+         expectationFailure "Failed to get connection"
+
 testDeleteRcvConn :: SpecWith SQLiteStore
 testDeleteRcvConn =
   it "should create RcvConnection and delete it" . withStoreTransaction $ \db -> do

From ac930dff304567712e96c3264edf0a74a120faa7 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 20 Aug 2024 12:25:58 +0100
Subject: [PATCH 069/195] smp server: possible race when creating client that
 might lead to memory leak (#1260)

---
 src/Simplex/Messaging/Server.hs         | 34 +++++++++++++++----------
 src/Simplex/Messaging/Server/Env/STM.hs |  7 +++--
 2 files changed, 23 insertions(+), 18 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index c5d067475..a70995d5e 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -175,7 +175,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           $>>= endPreviousSubscriptions
           >>= liftIO . mapM_ unsub
       where
-        updateSubscribers :: TVar (IM.IntMap Client) -> STM (Maybe (QueueId, Client))
+        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> STM (Maybe (QueueId, Client))
         updateSubscribers cls = do
           (qId, clnt, subscribed) <- readTQueue $ subQ s
           current <- IM.member (clientId clnt) <$> readTVar cls
@@ -412,7 +412,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
               CPClients -> withAdminRole $ do
                 active <- unliftIO u (asks clients) >>= readTVarIO
                 hPutStrLn h "clientId,sessionId,connected,createdAt,rcvActiveAt,sndActiveAt,age,subscriptions"
-                forM_ (IM.toList active) $ \(cid, Client {sessionId, connected, createdAt, rcvActiveAt, sndActiveAt, subscriptions}) -> do
+                forM_ (IM.toList active) $ \(cid, cl) -> forM_ cl $ \Client {sessionId, connected, createdAt, rcvActiveAt, sndActiveAt, subscriptions} -> do
                   connected' <- bshow <$> readTVarIO connected
                   rcvActiveAt' <- strEncode <$> readTVarIO rcvActiveAt
                   sndActiveAt' <- strEncode <$> readTVarIO sndActiveAt
@@ -507,7 +507,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                   activeClients <- readTVarIO clients
                   hPutStrLn h $ "Clients: " <> show (IM.size activeClients)
                   when (r == CPRAdmin) $ do
-                    clQs <- clientTBQueueLengths activeClients
+                    clQs <- clientTBQueueLengths' activeClients
                     hPutStrLn h $ "Client queues (rcvQ, sndQ, msgQ): " <> show clQs
                     (smpSubCnt, smpSubCntByGroup, smpClCnt, smpClQs) <- countClientSubs subscriptions (Just countSMPSubs) activeClients
                     hPutStrLn h $ "SMP subscriptions (via clients): " <> show smpSubCnt
@@ -542,11 +542,12 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                               | otherwise = (cl : cls, IS.insert clientId clSet)
                         countSubClients :: M.Map QueueId Client -> Int
                         countSubClients = IS.size . M.foldr' (IS.insert . clientId) IS.empty
-                    countClientSubs :: (Client -> TMap QueueId a) -> Maybe (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap Client -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
+                    countClientSubs :: (Client -> TMap QueueId a) -> Maybe (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap (Maybe Client) -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
                     countClientSubs subSel countSubs_ = foldM addSubs (0, (0, 0, 0, 0), 0, (0, 0, 0))
                       where
-                        addSubs :: (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural)) -> Client -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
-                        addSubs (!subCnt, cnts@(!c1, !c2, !c3, !c4), !clCnt, !qs) cl = do
+                        addSubs :: (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural)) -> Maybe Client -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
+                        addSubs acc Nothing = pure acc
+                        addSubs (!subCnt, cnts@(!c1, !c2, !c3, !c4), !clCnt, !qs) (Just cl) = do
                           subs <- readTVarIO $ subSel cl
                           cnts' <- case countSubs_ of
                             Nothing -> pure cnts
@@ -559,6 +560,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                           pure (subCnt + cnt, cnts', clCnt', qs')
                     clientTBQueueLengths :: Foldable t => t Client -> IO (Natural, Natural, Natural)
                     clientTBQueueLengths = foldM addQueueLengths (0, 0, 0)
+                    clientTBQueueLengths' :: Foldable t => t (Maybe Client) -> IO (Natural, Natural, Natural)
+                    clientTBQueueLengths' = foldM (\acc -> maybe (pure acc) (addQueueLengths acc)) (0, 0, 0)
                     addQueueLengths (!rl, !sl, !ml) cl = do
                       (rl', sl', ml') <- queueLengths cl
                       pure (rl + rl', sl + sl', ml + ml')
@@ -619,15 +622,18 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
   ts <- liftIO getSystemTime
   active <- asks clients
   nextClientId <- asks clientSeq
-  c@Client {clientId} <- liftIO $ newClient nextClientId q thVersion sessionId ts
-  atomically $ modifyTVar' active $ IM.insert clientId c
-  s <- asks server
-  expCfg <- asks $ inactiveClientExpiration . config
-  th <- newMVar h -- put TH under a fair lock to interleave messages and command responses
-  labelMyThread . B.unpack $ "client $" <> encode sessionId
-  raceAny_ ([liftIO $ send th c, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c expCfg)
-    `finally` clientDisconnected c
+  clientId <- atomically $ stateTVar nextClientId $ \next -> (next, next + 1)
+  atomically $ modifyTVar' active $ IM.insert clientId Nothing
+  c <- liftIO $ newClient clientId q thVersion sessionId ts
+  runClientThreads active c clientId `finally` clientDisconnected c
   where
+    runClientThreads active c clientId = do
+      atomically $ modifyTVar' active $ IM.insert clientId $ Just c
+      s <- asks server
+      expCfg <- asks $ inactiveClientExpiration . config
+      th <- newMVar h -- put TH under a fair lock to interleave messages and command responses
+      labelMyThread . B.unpack $ "client $" <> encode sessionId
+      raceAny_ $ [liftIO $ send th c, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c expCfg
     disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport h (rcvActiveAt c) (sndActiveAt c) expCfg (noSubscriptions c)]
     disconnectThread_ _ _ = []
     noSubscriptions c = atomically $ (&&) <$> TM.null (ntfSubscriptions c) <*> (not . hasSubs <$> readTVar (subscriptions c))
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 84e664607..9b1dd9405 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -127,7 +127,7 @@ data Env = Env
     serverStats :: ServerStats,
     sockets :: SocketState,
     clientSeq :: TVar ClientId,
-    clients :: TVar (IntMap Client),
+    clients :: TVar (IntMap (Maybe Client)),
     proxyAgent :: ProxyAgent -- senders served on this proxy
   }
 
@@ -183,9 +183,8 @@ newServer = do
   savingLock <- atomically createLock
   return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, savingLock}
 
-newClient :: TVar ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
-newClient nextClientId qSize thVersion sessionId createdAt = do
-  clientId <- atomically $ stateTVar nextClientId $ \next -> (next, next + 1)
+newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
+newClient clientId qSize thVersion sessionId createdAt = do
   subscriptions <- TM.emptyIO
   ntfSubscriptions <- TM.emptyIO
   rcvQ <- newTBQueueIO qSize

From 2bdda1ff1fe541fe40754267ecfc613dce75c303 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 20 Aug 2024 13:36:37 +0100
Subject: [PATCH 070/195] servers: safe compacting of store logs (#1269)

* servers: safe compacting of store logs

* fix
---
 src/Simplex/Messaging/Server/StoreLog.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs
index d1ce15ed6..94a340d94 100644
--- a/src/Simplex/Messaging/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Server/StoreLog.hs
@@ -36,7 +36,7 @@ import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore (NtfCreds (..), QueueRec (..), ServerQueueStatus (..))
 import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Util (ifM)
-import System.Directory (doesFileExist)
+import System.Directory (doesFileExist, renameFile)
 import System.IO
 
 -- | opaque container for file handle with a type-safe IOMode
@@ -140,10 +140,12 @@ logDeleteNotifier s = writeStoreLogRecord s . DeleteNotifier
 
 readWriteStoreLog :: FilePath -> IO (Map RecipientId QueueRec, StoreLog 'WriteMode)
 readWriteStoreLog f = do
-  qs <- ifM (doesFileExist f) (readQueues f) (pure M.empty)
+  qs <- ifM (doesFileExist f) readQS (pure M.empty)
   s <- openWriteStoreLog f
   writeQueues s qs
   pure (qs, s)
+  where
+    readQS = readQueues f <* renameFile f (f <> ".bak")
 
 writeQueues :: StoreLog 'WriteMode -> Map RecipientId QueueRec -> IO ()
 writeQueues s = mapM_ $ \q -> when (active q) $ logCreateQueue s q

From 5be81c562f7b7c538983a62b22e0d5f7f85e2335 Mon Sep 17 00:00:00 2001
From: sh <37271604+shumvgolove@users.noreply.github.com>
Date: Tue, 20 Aug 2024 14:57:29 +0000
Subject: [PATCH 071/195] scripts: update install/update (#1271)

---
 README.md                           | 2 +-
 install.sh                          | 6 +++---
 scripts/main/simplex-servers-update | 6 +++---
 3 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/README.md b/README.md
index a2eea480f..b43fe6920 100644
--- a/README.md
+++ b/README.md
@@ -150,7 +150,7 @@ You can install and setup servers automatically using our script:
 
 ```sh
 curl --proto '=https' --tlsv1.2 -sSf https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/install.sh -o simplex-server-install.sh \
-&& if echo '03d8dbc38736a9e58283b88c5f09599fbcab1673eefe803f305e80eaf9539873 simplex-server-install.sh' | sha256sum -c; then chmod +x ./simplex-server-install.sh && ./simplex-server-install.sh; rm ./simplex-server-install.sh; else echo "SHA-256 checksum is incorrect!" && rm ./simplex-server-install.sh; fi
+&& if echo 'c90886104cd640b2ed64921dba80e90691db36788e8d6dcc13d8f33f92f0ea54 simplex-server-install.sh' | sha256sum -c; then chmod +x ./simplex-server-install.sh && ./simplex-server-install.sh; rm ./simplex-server-install.sh; else echo "SHA-256 checksum is incorrect!" && rm ./simplex-server-install.sh; fi
 ```
 
 ### Build from source
diff --git a/install.sh b/install.sh
index a9418571f..461215f71 100755
--- a/install.sh
+++ b/install.sh
@@ -87,9 +87,9 @@ os_test() {
  . /etc/os-release
 
  case "$VERSION_ID" in
-  20.04) : ;;
-  22.04) : ;;
-  *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new" "$VERSION_ID" && exit 1 ;;
+  20.04|22.04) : ;;
+  24.04) VERSION_ID='22.04' ;;
+  *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new\n" "$VERSION_ID" && exit 1 ;;
  esac
 
  version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
diff --git a/scripts/main/simplex-servers-update b/scripts/main/simplex-servers-update
index e069fc813..7e85ff777 100755
--- a/scripts/main/simplex-servers-update
+++ b/scripts/main/simplex-servers-update
@@ -46,9 +46,9 @@ os_test() {
  . /etc/os-release
 
  case "$VERSION_ID" in
-  20.04) : ;;
-  22.04) : ;;
-  *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new" "$VERSION_ID" && exit 1 ;;
+  20.04|22.04) : ;;
+  24.04) VERSION_ID='22.04' ;;
+  *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new\n" "$VERSION_ID" && exit 1 ;;
  esac
 
  version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"

From 39f3cf3082e9a90a2a6564433e6ded19ea56097c Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 20 Aug 2024 16:05:50 +0100
Subject: [PATCH 072/195] agent: only create notification subscriptions to
 connections without errors or with temporary errors (#1270)

---
 src/Simplex/Messaging/Agent.hs | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index b1674389f..176d33403 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -980,7 +980,7 @@ subscribeConnections' c connIds = do
   rcvRs <- lift $ connResults . fst <$> subscribeQueues c (concat $ M.elems rcvQs)
   ns <- asks ntfSupervisor
   tkn <- readTVarIO (ntfTkn ns)
-  lift $ when (instantNotifications tkn) . void . forkIO . void $ sendNtfCreate ns cs
+  lift $ when (instantNotifications tkn) . void . forkIO . void $ sendNtfCreate ns rcvRs cs
   let rs = M.unions ([errs', subRs, rcvRs] :: [Map ConnId (Either AgentErrorType ())])
   notifyResultError rs
   pure rs
@@ -1012,11 +1012,12 @@ subscribeConnections' c connIds = do
         order (Active, _) = 2
         order (_, Right _) = 3
         order _ = 4
-    sendNtfCreate :: NtfSupervisor -> Map ConnId SomeConn -> AM' ()
-    sendNtfCreate ns cs =
+    sendNtfCreate :: NtfSupervisor -> Map ConnId (Either AgentErrorType ()) -> Map ConnId SomeConn -> AM' ()
+    sendNtfCreate ns rcvRs cs = do
       -- TODO this needs to be batched end to end.
       -- Currently, the only change is to ignore failed subscriptions.
-      forM_ cs $ \case
+      let oks = M.keysSet $ M.filter (either temporaryAgentError $ const True) rcvRs
+      forM_ (M.restrictKeys cs oks) $ \case
         SomeConn _ conn -> do
           let cmd = if enableNtfs $ toConnData conn then NSCCreate else NSCDelete
               ConnData {connId} = toConnData conn

From 1d22608f860636f21a5557f1b3fab4a7da09c5cc Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 20 Aug 2024 18:46:42 +0100
Subject: [PATCH 073/195] 6.0.1.0

---
 CHANGELOG.md    | 15 +++++++++++++++
 package.yaml    |  2 +-
 simplexmq.cabal |  2 +-
 3 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 9696a64b3..48e6d77ae 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,18 @@
+# 6.0.1
+
+SMP agent:
+- support changing user of the new connection.
+- do not start delivery workers when there are no messages to deliver.
+- enable notifications for all connections.
+- combine database transactions when subscribing.
+- store query errors, reduce slow query threshold to 1ms.
+
+SMP server:
+- safe compacting of store log.
+- fix possible race when creating client that might lead to memory leak.
+
+Dependencies: upgrade tls to 1.9
+
 # 6.0.0
 
 Version 6.0.0.8
diff --git a/package.yaml b/package.yaml
index ceff0afb9..789e2e151 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.0.8
+version: 6.0.1.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 44e39c8ae..d222352a1 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.0.8
+version:        6.0.1.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 325e679bc458e82e1090b4c8375a6e63999137a3 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 24 Aug 2024 11:34:59 +0100
Subject: [PATCH 074/195] ntf server: reduce PING interval to 1 minute, only
 mark subscriptions with END if it is received by the currently active client
 (#1275)

---
 src/Simplex/Messaging/Client/Agent.hs              | 10 ++++++----
 src/Simplex/Messaging/Notifications/Server.hs      |  6 ++++--
 src/Simplex/Messaging/Notifications/Server/Main.hs |  4 +++-
 3 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/src/Simplex/Messaging/Client/Agent.hs b/src/Simplex/Messaging/Client/Agent.hs
index 8073f1d48..29c485ebd 100644
--- a/src/Simplex/Messaging/Client/Agent.hs
+++ b/src/Simplex/Messaging/Client/Agent.hs
@@ -372,14 +372,16 @@ smpSubscribeQueues party ca smp srv subs = do
     notify_ :: (SMPServer -> SMPSubParty -> NonEmpty a -> SMPClientAgentEvent) -> [a] -> IO ()
     notify_ evt qs = mapM_ (notify ca . evt srv party) $ L.nonEmpty qs
 
-activeClientSession :: SMPClientAgent -> SMPClient -> SMPServer -> STM Bool
-activeClientSession ca smp srv = sameSess <$> tryReadSessVar srv (smpClients ca)
+activeClientSession' :: SMPClientAgent -> SessionId -> SMPServer -> STM Bool
+activeClientSession' ca sessId srv = sameSess <$> tryReadSessVar srv (smpClients ca)
   where
-    sessId = sessionId . thParams
     sameSess = \case
-      Just (Right (_, smp')) -> sessId smp == sessId smp'
+      Just (Right (_, smp')) -> sessId == sessionId (thParams smp')
       _ -> False
 
+activeClientSession :: SMPClientAgent -> SMPClient -> SMPServer -> STM Bool
+activeClientSession ca = activeClientSession' ca . sessionId . thParams
+
 showServer :: SMPServer -> ByteString
 showServer ProtocolServer {host, port} =
   strEncode host <> B.pack (if null port then "" else ':' : port)
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 1192148ac..c75c844bb 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -203,7 +203,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
 
     receiveSMP :: M ()
     receiveSMP = forever $ do
-      ((_, srv, _), _, _, ts) <- atomically $ readTBQueue msgQ
+      ((_, srv, _), _thVersion, sessionId, ts) <- atomically $ readTBQueue msgQ
       forM ts $ \(ntfId, t) -> case t of
         STUnexpectedError e -> logError $ "SMP client unexpected error: " <> tshow e -- uncorrelated response, should not happen
         STResponse {} -> pure () -- it was already reported as timeout error
@@ -220,7 +220,9 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
                 findNtfSubscriptionToken st smpQueue
                   >>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}))
               incNtfStat ntfReceived
-            Right SMP.END -> updateSubStatus smpQueue NSEnd
+            Right SMP.END ->
+              whenM (atomically $ activeClientSession' ca sessionId srv) $
+                updateSubStatus smpQueue NSEnd
             Right (SMP.ERR e) -> logError $ "SMP server error: " <> tshow e
             Right _ -> logError "SMP server unexpected response"
             Left e -> logError $ "SMP client error: " <> tshow e
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index dadeb82fc..cd8561dd3 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -132,7 +133,8 @@ ntfServerCLI cfgPath logPath =
                         { networkConfig =
                             defaultNetworkConfig
                               { socksProxy = either error id <$!> strDecodeIni "SUBSCRIBER" "socks_proxy" ini,
-                                socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini
+                                socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini,
+                                smpPingInterval = 60_000_000 -- 1 minutes
                               }
                         },
                     persistErrorInterval = 0 -- seconds

From ab4acadcc1415da03540ffec09b7c9b33bdb26a6 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 24 Aug 2024 13:54:20 +0100
Subject: [PATCH 075/195] agent: fix stuck connection commands when server is
 not responding (#1276)

* agent: fix stuck connection commands when server is not responding

* fix

* rename

* test SKEY retry
---
 src/Simplex/Messaging/Agent.hs              | 55 +++++++++++++--------
 src/Simplex/Messaging/Agent/Client.hs       |  2 +-
 src/Simplex/Messaging/Agent/Store/SQLite.hs | 31 +++++++++---
 tests/AgentTests/FunctionalAPITests.hs      |  5 +-
 tests/AgentTests/SQLiteTests.hs             | 12 ++---
 5 files changed, 67 insertions(+), 38 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 176d33403..755734fde 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -128,11 +128,10 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
-import Data.Bifunctor (bimap, first)
+import Data.Bifunctor (bimap, first, second)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Composition ((.:), (.:.), (.::), (.::.))
-import Data.Containers.ListUtils (nubOrd)
 import Data.Either (isRight, rights)
 import Data.Foldable (foldl', toList)
 import Data.Functor (($>))
@@ -1134,37 +1133,39 @@ sendMessagesB_ c reqs connIds = withConnLocks c connIds "sendMessages" $ do
 enqueueCommand :: AgentClient -> ACorrId -> ConnId -> Maybe SMPServer -> AgentCommand -> AM ()
 enqueueCommand c corrId connId server aCommand = do
   withStore c $ \db -> createCommand db corrId connId server aCommand
-  lift . void $ getAsyncCmdWorker True c server
+  lift . void $ getAsyncCmdWorker True c connId server
 
-resumeSrvCmds :: AgentClient -> Maybe SMPServer -> AM' ()
-resumeSrvCmds = void .: getAsyncCmdWorker False
+resumeSrvCmds :: AgentClient -> ConnId -> Maybe SMPServer -> AM' ()
+resumeSrvCmds = void .:. getAsyncCmdWorker False
 {-# INLINE resumeSrvCmds #-}
 
 resumeConnCmds :: AgentClient -> [ConnId] -> AM' ()
 resumeConnCmds c connIds = do
-  srvs <- nubOrd . concat . rights <$> withStoreBatch' c (\db -> fmap (getPendingCommandServers db) connIds)
-  mapM_ (resumeSrvCmds c) srvs
+  connSrvs <- rights . zipWith (second . (,)) connIds <$> withStoreBatch' c (\db -> fmap (getPendingCommandServers db) connIds)
+  mapM_ (\(connId, srvs) -> mapM_ (resumeSrvCmds c connId) srvs) connSrvs
 
-getAsyncCmdWorker :: Bool -> AgentClient -> Maybe SMPServer -> AM' Worker
-getAsyncCmdWorker hasWork c server =
-  getAgentWorker "async_cmd" hasWork c server (asyncCmdWorkers c) (runCommandProcessing c server)
+getAsyncCmdWorker :: Bool -> AgentClient -> ConnId -> Maybe SMPServer -> AM' Worker
+getAsyncCmdWorker hasWork c connId server =
+  getAgentWorker "async_cmd" hasWork c (connId, server) (asyncCmdWorkers c) (runCommandProcessing c connId server)
 
-runCommandProcessing :: AgentClient -> Maybe SMPServer -> Worker -> AM ()
-runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
+data CommandCompletion = CCMoved | CCCompleted
+
+runCommandProcessing :: AgentClient -> ConnId -> Maybe SMPServer -> Worker -> AM ()
+runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
   ri <- asks $ messageRetryInterval . config -- different retry interval?
   forever $ do
     atomically $ endAgentOperation c AOSndNetwork
     lift $ waitForWork doWork
     liftIO $ throwWhenInactive c
     atomically $ beginAgentOperation c AOSndNetwork
-    withWork c doWork (`getPendingServerCommand` server_) $ runProcessCmd (riFast ri)
+    withWork c doWork (\db -> getPendingServerCommand db connId server_) $ runProcessCmd (riFast ri)
   where
     runProcessCmd ri cmd = do
       pending <- newTVarIO []
       processCmd ri cmd pending
       mapM_ (atomically . writeTBQueue subQ) . reverse =<< readTVarIO pending
     processCmd :: RetryInterval -> PendingCommand -> TVar [ATransmission] -> AM ()
-    processCmd ri PendingCommand {cmdId, corrId, userId, connId, command} pendingCmds = case command of
+    processCmd ri PendingCommand {cmdId, corrId, userId, command} pendingCmds = case command of
       AClientCommand cmd -> case cmd of
         NEW enableNtfs (ACM cMode) pqEnc subMode -> noServer $ do
           usedSrvs <- newTVarIO ([] :: [SMPServer])
@@ -1190,16 +1191,27 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
       AInternalCommand cmd -> case cmd of
         ICAckDel rId srvMsgId msgId -> withServer $ \srv -> tryWithLock "ICAckDel" $ ack srv rId srvMsgId >> withStore' c (\db -> deleteMsg db connId msgId)
         ICAck rId srvMsgId -> withServer $ \srv -> tryWithLock "ICAck" $ ack srv rId srvMsgId
-        ICAllowSecure _rId senderKey -> withServer' . tryWithLock "ICAllowSecure" $ do
+        ICAllowSecure _rId senderKey -> withServer' . tryMoveableWithLock "ICAllowSecure" $ do
           (SomeConn _ conn, AcceptedConfirmation {senderConf, ownConnInfo}) <-
             withStore c $ \db -> runExceptT $ (,) <$> ExceptT (getConn db connId) <*> ExceptT (getAcceptedConfirmation db connId)
           case conn of
             RcvConnection cData rq -> do
               mapM_ (secure rq) senderKey
               mapM_ (connectReplyQueues c cData ownConnInfo Nothing) (L.nonEmpty $ smpReplyQueues senderConf)
+              pure CCCompleted
             -- duplex connection is matched to handle SKEY retries
-            DuplexConnection cData _ (sq :| _) ->
-              mapM_ (connectReplyQueues c cData ownConnInfo (Just sq)) (L.nonEmpty $ smpReplyQueues senderConf)
+            DuplexConnection cData _ (sq :| _) -> do
+              tryAgentError (mapM_ (connectReplyQueues c cData ownConnInfo (Just sq)) (L.nonEmpty $ smpReplyQueues senderConf)) >>= \case
+                Right () -> pure CCCompleted
+                Left e
+                  | temporaryOrHostError e && Just server /= server_ -> do
+                      -- In case the server is different we update server to remove command from this (connId, srv) queue
+                      withStore c $ \db -> updateCommandServer db cmdId server
+                      lift . void $ getAsyncCmdWorker True c connId (Just server)
+                      pure CCMoved
+                  | otherwise -> throwE e
+              where
+                server = qServer sq
             _ -> throwE $ INTERNAL $ "incorrect connection type " <> show (internalCmdTag cmd)
         ICDuplexSecure _rId senderKey -> withServer' . tryWithLock "ICDuplexSecure" . withDuplexConn $ \(DuplexConnection cData (rq :| _) (sq :| _)) -> do
           secure rq senderKey
@@ -1272,15 +1284,18 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
           withStore c (`getConn` connId) >>= \case
             SomeConn _ conn@DuplexConnection {} -> a conn
             _ -> internalErr "command requires duplex connection"
-        tryCommand action = withRetryInterval ri $ \_ loop -> do
+        tryCommand action = tryMoveableCommand (action $> CCCompleted)
+        tryMoveableCommand action = withRetryInterval ri $ \_ loop -> do
           liftIO $ waitWhileSuspended c
           liftIO $ waitForUserNetwork c
-          tryError action >>= \case
+          tryAgentError action >>= \case
             Left e
               | temporaryOrHostError e -> retrySndOp c loop
               | otherwise -> cmdError e
-            Right () -> withStore' c (`deleteCommand` cmdId)
+            Right CCCompleted -> withStore' c (`deleteCommand` cmdId)
+            Right CCMoved -> pure () -- command processing moved to another command queue
         tryWithLock name = tryCommand . withConnLock c connId name
+        tryMoveableWithLock name = tryMoveableCommand . withConnLock c connId name
         internalErr s = cmdError $ INTERNAL $ s <> ": " <> show (agentCommandTag command)
         cmdError e = notify (ERR e) >> withStore' c (`deleteCommand` cmdId)
         notify :: forall e. AEntityI e => AEvent e -> AM ()
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index fbdb53548..8f339cab7 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -313,7 +313,7 @@ data AgentClient = AgentClient
     removedSubs :: TMap (UserId, SMPServer, SMP.RecipientId) SMPClientError,
     workerSeq :: TVar Int,
     smpDeliveryWorkers :: TMap SndQAddr (Worker, TMVar ()),
-    asyncCmdWorkers :: TMap (Maybe SMPServer) Worker,
+    asyncCmdWorkers :: TMap (ConnId, Maybe SMPServer) Worker,
     ntfNetworkOp :: TVar AgentOpState,
     rcvNetworkOp :: TVar AgentOpState,
     msgDeliveryOp :: TVar AgentOpState,
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 69b1b07e9..97b32eca8 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -137,6 +137,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     createCommand,
     getPendingCommandServers,
     getPendingServerCommand,
+    updateCommandServer,
     deleteCommand,
     -- Notification device token persistence
     createNtfToken,
@@ -1323,38 +1324,39 @@ getPendingCommandServers db connId = do
   where
     smpServer (host, port, keyHash) = SMPServer <$> host <*> port <*> keyHash
 
-getPendingServerCommand :: DB.Connection -> Maybe SMPServer -> IO (Either StoreError (Maybe PendingCommand))
-getPendingServerCommand db srv_ = getWorkItem "command" getCmdId getCommand markCommandFailed
+getPendingServerCommand :: DB.Connection -> ConnId -> Maybe SMPServer -> IO (Either StoreError (Maybe PendingCommand))
+getPendingServerCommand db connId srv_ = getWorkItem "command" getCmdId getCommand markCommandFailed
   where
     getCmdId :: IO (Maybe Int64)
     getCmdId =
       maybeFirstRow fromOnly $ case srv_ of
         Nothing ->
-          DB.query_
+          DB.query
             db
             [sql|
               SELECT command_id FROM commands
-              WHERE host IS NULL AND port IS NULL AND failed = 0
+              WHERE conn_id = ? AND host IS NULL AND port IS NULL AND failed = 0
               ORDER BY created_at ASC, command_id ASC
               LIMIT 1
             |]
+            (Only connId)
         Just (SMPServer host port _) ->
           DB.query
             db
             [sql|
               SELECT command_id FROM commands
-              WHERE host = ? AND port = ? AND failed = 0
+              WHERE conn_id = ? AND host = ? AND port = ? AND failed = 0
               ORDER BY created_at ASC, command_id ASC
               LIMIT 1
             |]
-            (host, port)
+            (connId, host, port)
     getCommand :: Int64 -> IO (Either StoreError PendingCommand)
     getCommand cmdId =
       firstRow pendingCommand err $
         DB.query
           db
           [sql|
-            SELECT c.corr_id, cs.user_id, c.conn_id, c.command
+            SELECT c.corr_id, cs.user_id, c.command
             FROM commands c
             JOIN connections cs USING (conn_id)
             WHERE c.command_id = ?
@@ -1362,9 +1364,22 @@ getPendingServerCommand db srv_ = getWorkItem "command" getCmdId getCommand mark
           (Only cmdId)
       where
         err = SEInternal $ "command  " <> bshow cmdId <> " returned []"
-        pendingCommand (corrId, userId, connId, command) = PendingCommand {cmdId, corrId, userId, connId, command}
+        pendingCommand (corrId, userId, command) = PendingCommand {cmdId, corrId, userId, connId, command}
     markCommandFailed cmdId = DB.execute db "UPDATE commands SET failed = 1 WHERE command_id = ?" (Only cmdId)
 
+updateCommandServer :: DB.Connection -> AsyncCmdId -> SMPServer -> IO (Either StoreError ())
+updateCommandServer db cmdId srv@(SMPServer host port _) = runExceptT $ do
+  serverKeyHash_ <- ExceptT $ getServerKeyHash_ db srv
+  liftIO $
+    DB.execute
+      db
+      [sql|
+        UPDATE commands
+        SET host = ?, port = ?, server_key_hash = ?
+        WHERE command_id = ?
+      |]
+      (host, port, serverKeyHash_, cmdId)
+
 deleteCommand :: DB.Connection -> AsyncCmdId -> IO ()
 deleteCommand db cmdId =
   DB.execute db "DELETE FROM commands WHERE command_id = ?" (Only cmdId)
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index f0a25b758..29725f96a 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -1063,13 +1063,12 @@ testAllowConnectionClientRestart t = do
     threadDelay 250000
 
     alice2 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB
+    runRight_ $ subscribeConnection alice2 bobId
+    threadDelay 500000
 
     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)
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index 95096e800..f876603f5 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -661,30 +661,30 @@ testGetPendingServerCommand :: SQLiteStore -> Expectation
 testGetPendingServerCommand st = do
   g <- C.newRandom
   withTransaction st $ \db -> do
-    Right Nothing <- getPendingServerCommand db Nothing
+    Right Nothing <- getPendingServerCommand db "" Nothing
     Right connId <- createNewConn db g cData1 {connId = ""} SCMInvitation
     Right () <- createCommand db "1" connId Nothing command
     corruptCmd db "1" connId
     Right () <- createCommand db "2" connId Nothing command
 
-    Left e <- getPendingServerCommand db Nothing
+    Left e <- getPendingServerCommand db connId Nothing
     show e `shouldContain` "bad AgentCmdType"
     DB.query_ db "SELECT conn_id, corr_id FROM commands WHERE failed = 1" `shouldReturn` [(connId, "1" :: ByteString)]
 
-    Right (Just PendingCommand {corrId}) <- getPendingServerCommand db Nothing
+    Right (Just PendingCommand {corrId}) <- getPendingServerCommand db connId Nothing
     corrId `shouldBe` "2"
 
     Right _ <- updateNewConnRcv db connId rcvQueue1
-    Right Nothing <- getPendingServerCommand db $ Just smpServer1
+    Right Nothing <- getPendingServerCommand db connId $ Just smpServer1
     Right () <- createCommand db "3" connId (Just smpServer1) command
     corruptCmd db "3" connId
     Right () <- createCommand db "4" connId (Just smpServer1) command
 
-    Left e' <- getPendingServerCommand db (Just smpServer1)
+    Left e' <- getPendingServerCommand db connId (Just smpServer1)
     show e' `shouldContain` "bad AgentCmdType"
     DB.query_ db "SELECT conn_id, corr_id FROM commands WHERE failed = 1" `shouldReturn` [(connId, "1" :: ByteString), (connId, "3" :: ByteString)]
 
-    Right (Just PendingCommand {corrId = corrId'}) <- getPendingServerCommand db (Just smpServer1)
+    Right (Just PendingCommand {corrId = corrId'}) <- getPendingServerCommand db connId (Just smpServer1)
     corrId' `shouldBe` "4"
   where
     command = AClientCommand $ NEW True (ACM SCMInvitation) (IKNoPQ PQSupportOn) SMSubscribe

From 53e829a21c977a1048cb5d225ec5fa4a5b158f65 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 24 Aug 2024 14:51:26 +0100
Subject: [PATCH 076/195] agent: store query errors, reduce slow query
 threshold to 1ms (#1277)

* agent: collect query errors stats

* simplify

* test

* use microseconds

* parens

* revert change to track all queries, reduce threshold to 1 ms
---
 .../Messaging/Agent/Store/SQLite/DB.hs        | 27 ++++++++++++++-----
 src/Simplex/Messaging/Util.hs                 |  4 +--
 tests/AgentTests/NotificationTests.hs         |  4 +--
 3 files changed, 24 insertions(+), 11 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs b/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs
index b356b3f87..4d9dbeb57 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -20,15 +21,19 @@ where
 
 import Control.Concurrent.STM
 import Control.Monad (when)
+import Control.Exception
 import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Text (Text)
 import Data.Time (diffUTCTime, getCurrentTime)
 import Database.SQLite.Simple (FromRow, NamedParam, Query, ToRow)
 import qualified Database.SQLite.Simple as SQL
 import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (diffToMilliseconds)
+import Simplex.Messaging.Util (diffToMilliseconds, tshow)
 
 data Connection = Connection
   { conn :: SQL.Connection,
@@ -38,27 +43,35 @@ data Connection = Connection
 data SlowQueryStats = SlowQueryStats
   { count :: Int64,
     timeMax :: Int64,
-    timeAvg :: Int64
+    timeAvg :: Int64,
+    errs :: Map Text Int
   }
   deriving (Show)
 
 timeIt :: TMap Query SlowQueryStats -> Query -> IO a -> IO a
 timeIt slow sql a = do
   t <- getCurrentTime
-  r <- a
+  r <- a `catch` \e -> do
+    atomically $ TM.alter (Just . updateQueryErrors e) sql slow
+    throwIO e
   t' <- getCurrentTime
   let diff = diffToMilliseconds $ diffUTCTime t' t
-  atomically $ when (diff > 5) $ TM.alter (updateQueryStats diff) sql slow
+  when (diff > 1) $ atomically $ TM.alter (updateQueryStats diff) sql slow
   pure r
   where
+    updateQueryErrors :: SomeException -> Maybe SlowQueryStats -> SlowQueryStats
+    updateQueryErrors e Nothing = SlowQueryStats 0 0 0 $ M.singleton (tshow e) 1
+    updateQueryErrors e (Just stats@SlowQueryStats {errs}) =
+      stats {errs = M.alter (Just . maybe 1 (+ 1)) (tshow e) errs}
     updateQueryStats :: Int64 -> Maybe SlowQueryStats -> Maybe SlowQueryStats
-    updateQueryStats diff Nothing = Just $ SlowQueryStats 1 diff diff
-    updateQueryStats diff (Just SlowQueryStats {count, timeMax, timeAvg}) =
+    updateQueryStats diff Nothing = Just $ SlowQueryStats 1 diff diff M.empty
+    updateQueryStats diff (Just SlowQueryStats {count, timeMax, timeAvg, errs}) =
       Just $
         SlowQueryStats
           { count = count + 1,
             timeMax = max timeMax diff,
-            timeAvg = (timeAvg * count + diff) `div` (count + 1)
+            timeAvg = (timeAvg * count + diff) `div` (count + 1),
+            errs
           }
 
 open :: String -> IO Connection
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index b023f460a..e46681ea7 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -166,10 +166,10 @@ threadDelay' = loop
           loop $ time - maxWait
 
 diffToMicroseconds :: NominalDiffTime -> Int64
-diffToMicroseconds diff = fromIntegral ((truncate $ diff * 1000000) :: Integer)
+diffToMicroseconds diff = truncate $ diff * 1000000
 
 diffToMilliseconds :: NominalDiffTime -> Int64
-diffToMilliseconds diff = fromIntegral ((truncate $ diff * 1000) :: Integer)
+diffToMilliseconds diff = truncate $ diff * 1000
 
 labelMyThread :: MonadIO m => String -> m ()
 labelMyThread label = liftIO $ myThreadId >>= (`labelThread` label)
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 012da704d..c45c37124 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -508,7 +508,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
   suspendAgent alice 0
   closeSQLiteStore store
   threadDelay 1000000
-  print "before opening the database from another agent"
+  putStrLn "before opening the database from another agent"
 
   -- aliceNtf client doesn't have subscription and is allowed to get notification message
   withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do
@@ -516,7 +516,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
     pure ()
 
   threadDelay 1000000
-  print "after closing the database in another agent"
+  putStrLn "after closing the database in another agent"
   reopenSQLiteStore store
   foregroundAgent alice
   threadDelay 500000

From 56986f82c89b04beae84a61208db8b55eb0098e3 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sat, 24 Aug 2024 14:54:32 +0100
Subject: [PATCH 077/195] 6.0.2.0

---
 CHANGELOG.md    | 11 ++++++++++-
 package.yaml    |  2 +-
 simplexmq.cabal |  2 +-
 3 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 48e6d77ae..15d93378e 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,13 @@
+# 6.0.2
+
+SMP agent:
+- fix stuck connection commands when a server is not responding.
+- store query errors, reduce slow query threshold to 1ms.
+
+Notification server:
+- reduce PING interval to 1 minute.
+- fix subscriptions disabled on race condition (only mark subscriptions with END status when received via the active connection).
+
 # 6.0.1
 
 SMP agent:
@@ -5,7 +15,6 @@ SMP agent:
 - do not start delivery workers when there are no messages to deliver.
 - enable notifications for all connections.
 - combine database transactions when subscribing.
-- store query errors, reduce slow query threshold to 1ms.
 
 SMP server:
 - safe compacting of store log.
diff --git a/package.yaml b/package.yaml
index 789e2e151..1b30d0f2c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.1.0
+version: 6.0.2.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index d222352a1..0e84119ac 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.1.0
+version:        6.0.2.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 16cf5c862818a916b79b8369cfd911319282c6f8 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 26 Aug 2024 14:58:18 +0100
Subject: [PATCH 078/195] smp server: stats for END events and for SUB/DEL
 event batches (#1281)

* smp server: count queued and sent END events

* fix

* shadowing

* stats for batches

* fix
---
 src/Simplex/Messaging/Server.hs       | 73 +++++++++++++++++++-----
 src/Simplex/Messaging/Server/Stats.hs | 80 +++++++++++++++++++++++++++
 tests/CoreTests/BatchingTests.hs      | 22 ++++++++
 tests/ServerTests.hs                  |  6 +-
 4 files changed, 164 insertions(+), 17 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index a70995d5e..87fe3e9cb 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -52,7 +52,7 @@ import qualified Data.ByteString.Builder as BLD
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Either (fromRight, partitionEithers)
+import Data.Either (fromRight, partitionEithers, rights)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
@@ -61,7 +61,7 @@ import Data.List (intercalate, mapAccumR)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe)
 import qualified Data.Set as S
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
@@ -170,9 +170,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
     serverThread s label subQ subs clientSubs unsub = do
       labelMyThread label
       cls <- asks clients
+      stats <- asks serverStats
       forever $
         atomically (updateSubscribers cls)
-          $>>= endPreviousSubscriptions
+          $>>= endPreviousSubscriptions stats
           >>= liftIO . mapM_ unsub
       where
         updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> STM (Maybe (QueueId, Client))
@@ -189,10 +190,12 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                     yes <- readTVar $ connected c'
                     pure $ if yes then Just (qId, c') else Nothing
           updateSub qId (subs s) $>>= clientToBeNotified
-        endPreviousSubscriptions :: (QueueId, Client) -> M (Maybe s)
-        endPreviousSubscriptions (qId, c) = do
-          forkClient c (label <> ".endPreviousSubscriptions") $
+        endPreviousSubscriptions :: ServerStats -> (QueueId, Client) -> M (Maybe s)
+        endPreviousSubscriptions stats (qId, c) = do
+          forkClient c (label <> ".endPreviousSubscriptions") $ do
             atomically $ writeTBQueue (sndQ c) [(CorrId "", qId, END)]
+            incStat $ qSubEnd stats
+            incStat $ qSubEndB stats
           atomically $ TM.lookupDelete qId (clientSubs c)
 
     receiveFromProxyAgent :: ProxyAgent -> M ()
@@ -238,7 +241,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
       liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
       liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
-      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubNoMsg, qSubAuth, qSubDuplicate, qSubProhibited, ntfCreated, ntfDeleted, ntfSub, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, subscribedQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv}
+      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedAllB, qDeletedNew, qDeletedSecured, qSub, qSubNoMsg, qSubAllB, qSubAuth, qSubDuplicate, qSubProhibited, qSubEnd, qSubEndB, qSubEndSent, qSubEndSentB, ntfCreated, ntfDeleted, ntfDeletedB, ntfSub, ntfSubB, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, subscribedQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv}
         <- asks serverStats
       QueueStore {queues, notifiers} <- asks queueStore
       let interval = 1000000 * logInterval
@@ -250,16 +253,24 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           qCreated' <- atomically $ swapTVar qCreated 0
           qSecured' <- atomically $ swapTVar qSecured 0
           qDeletedAll' <- atomically $ swapTVar qDeletedAll 0
+          qDeletedAllB' <- atomically $ swapTVar qDeletedAllB 0
           qDeletedNew' <- atomically $ swapTVar qDeletedNew 0
           qDeletedSecured' <- atomically $ swapTVar qDeletedSecured 0
           qSub' <- atomically $ swapTVar qSub 0
           qSubNoMsg' <- atomically $ swapTVar qSubNoMsg 0
+          qSubAllB' <- atomically $ swapTVar qSubAllB 0
           qSubAuth' <- atomically $ swapTVar qSubAuth 0
           qSubDuplicate' <- atomically $ swapTVar qSubDuplicate 0
           qSubProhibited' <- atomically $ swapTVar qSubProhibited 0
+          qSubEnd' <- atomically $ swapTVar qSubEnd 0
+          qSubEndB' <- atomically $ swapTVar qSubEndB 0
+          qSubEndSent' <- atomically $ swapTVar qSubEndSent 0
+          qSubEndSentB' <- atomically $ swapTVar qSubEndSentB 0
           ntfCreated' <- atomically $ swapTVar ntfCreated 0
           ntfDeleted' <- atomically $ swapTVar ntfDeleted 0
+          ntfDeletedB' <- atomically $ swapTVar ntfDeletedB 0
           ntfSub' <- atomically $ swapTVar ntfSub 0
+          ntfSubB' <- atomically $ swapTVar ntfSubB 0
           ntfSubAuth' <- atomically $ swapTVar ntfSubAuth 0
           ntfSubDuplicate' <- atomically $ swapTVar ntfSubDuplicate 0
           msgSent' <- atomically $ swapTVar msgSent 0
@@ -345,7 +356,15 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                        show ntfSub',
                        show ntfSubAuth',
                        show ntfSubDuplicate',
-                       show ntfCount'
+                       show ntfCount',
+                       show qDeletedAllB',
+                       show qSubAllB',
+                       show qSubEnd',
+                       show qSubEndB',
+                       show qSubEndSent',
+                       show qSubEndSentB',
+                       show ntfDeletedB',
+                       show ntfSubB'
                      ]
               )
         liftIO $ threadDelay' interval
@@ -434,14 +453,20 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                 putStat "qCreated" qCreated
                 putStat "qSecured" qSecured
                 putStat "qDeletedAll" qDeletedAll
+                putStat "qDeletedAllB" qDeletedAllB
                 putStat "qDeletedNew" qDeletedNew
                 putStat "qDeletedSecured" qDeletedSecured
                 getStat (day . activeQueues) >>= \v -> hPutStrLn h $ "daily active queues: " <> show (S.size v)
                 getStat (day . subscribedQueues) >>= \v -> hPutStrLn h $ "daily subscribed queues: " <> show (S.size v)
                 putStat "qSub" qSub
                 putStat "qSubNoMsg" qSubNoMsg
+                putStat "qSubAllB" qSubAllB
+                subEnds <- (,,,) <$> getStat qSubEnd <*> getStat qSubEndB <*> getStat qSubEndSent <*> getStat qSubEndSentB
+                hPutStrLn h $ "SUB ENDs (queued, queued batches, sent, sent batches): " <> show subEnds
                 subs <- (,,) <$> getStat qSubAuth <*> getStat qSubDuplicate <*> getStat qSubProhibited
                 hPutStrLn h $ "other SUB events (auth, duplicate, prohibited): " <> show subs
+                putStat "qSubEnd" qSubEnd
+                putStat "qSubEndSent" qSubEndSent
                 putStat "msgSent" msgSent
                 putStat "msgRecv" msgRecv
                 putStat "msgRecvGet" msgRecvGet
@@ -631,9 +656,10 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
       atomically $ modifyTVar' active $ IM.insert clientId $ Just c
       s <- asks server
       expCfg <- asks $ inactiveClientExpiration . config
+      stats <- asks serverStats
       th <- newMVar h -- put TH under a fair lock to interleave messages and command responses
       labelMyThread . B.unpack $ "client $" <> encode sessionId
-      raceAny_ $ [liftIO $ send th c, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c expCfg
+      raceAny_ $ [liftIO $ send th c stats, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c expCfg
     disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport h (rcvActiveAt c) (sndActiveAt c) expCfg (noSubscriptions c)]
     disconnectThread_ _ _ = []
     noSubscriptions c = atomically $ (&&) <$> TM.null (ntfSubscriptions c) <*> (not . hasSubs <$> readTVar (subscriptions c))
@@ -679,10 +705,19 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
     ts <- L.toList <$> liftIO (tGet h)
     atomically . (writeTVar rcvActiveAt $!) =<< liftIO getSystemTime
     stats <- asks serverStats
+    let cmd = listToMaybe $ rights $ map (\(_, _, (_, _, cmdOrError)) -> cmdOrError) ts
+    forM_ (cmd >>= batchStatSel) $ \sel -> incStat $ sel stats
     (errs, cmds) <- partitionEithers <$> mapM (cmdAction stats) ts
     write sndQ errs
     write rcvQ cmds
   where
+    batchStatSel :: Cmd -> Maybe (ServerStats -> TVar Int)
+    batchStatSel (Cmd _ cmd) = case cmd of
+      SUB -> Just qSubAllB
+      DEL -> Just qDeletedAllB
+      NSUB -> Just ntfSubB
+      NDEL -> Just ntfDeletedB
+      _ -> Nothing
     cmdAction :: ServerStats -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
     cmdAction stats (tAuth, authorized, (corrId, entId, cmdOrError)) =
       case cmdOrError of
@@ -701,17 +736,20 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
                 pure $ Left (corrId, entId, ERR AUTH)
     write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
 
-send :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO ()
-send th c@Client {sndQ, msgQ, sessionId} = do
+send :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> ServerStats -> IO ()
+send th c@Client {sndQ, msgQ, sessionId} stats = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " send"
-  forever $ atomically (readTBQueue sndQ) >>= sendTransmissions
+  forever $ do
+    ts <- atomically (readTBQueue sndQ)
+    sendTransmissions ts
+    updateENDStats ts
   where
     sendTransmissions :: NonEmpty (Transmission BrokerMsg) -> IO ()
     sendTransmissions ts
       | L.length ts <= 2 = tSend th c ts
       | otherwise = do
           let (msgs_, ts') = mapAccumR splitMessages [] ts
-          -- If the request had batched subscriptions (L.length ts > 2)
+          -- If the request had batched subscriptions and L.length ts > 2
           -- this will reply OK to all SUBs in the first batched transmission,
           -- to reduce client timeouts.
           tSend th c ts'
@@ -725,7 +763,14 @@ send th c@Client {sndQ, msgQ, sessionId} = do
           -- replace MSG response with OK, accumulating MSG in a separate list.
           MSG {} -> ((CorrId "", entId, cmd) : msgs, (corrId, entId, OK))
           _ -> (msgs, t)
-
+    updateENDStats :: NonEmpty (Transmission BrokerMsg) -> IO ()
+    updateENDStats = \case
+      ts@((_, _, END) :| _) -> do -- END events are not combined with others
+        let len = L.length ts
+        atomically $ modifyTVar' (qSubEndSent stats) (+ len)
+        atomically $ modifyTVar' (qSubEndSentB stats) (+ len `div` 255) -- up to 255 ENDs in the batch
+      _ -> pure ()
+        
 sendMsg :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO ()
 sendMsg th c@Client {msgQ, sessionId} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " sendMsg"
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index f5b430bb6..7f1f0eab1 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -24,16 +24,24 @@ data ServerStats = ServerStats
     qCreated :: TVar Int,
     qSecured :: TVar Int,
     qDeletedAll :: TVar Int,
+    qDeletedAllB :: TVar Int,
     qDeletedNew :: TVar Int,
     qDeletedSecured :: TVar Int,
     qSub :: TVar Int,
     qSubNoMsg :: TVar Int,
+    qSubAllB :: TVar Int,
     qSubAuth :: TVar Int,
     qSubDuplicate :: TVar Int,
     qSubProhibited :: TVar Int,
+    qSubEnd :: TVar Int,
+    qSubEndB :: TVar Int,
+    qSubEndSent :: TVar Int,
+    qSubEndSentB :: TVar Int,
     ntfCreated :: TVar Int,
     ntfDeleted :: TVar Int,
+    ntfDeletedB :: TVar Int,
     ntfSub :: TVar Int,
+    ntfSubB :: TVar Int,
     ntfSubAuth :: TVar Int,
     ntfSubDuplicate :: TVar Int,
     msgSent :: TVar Int,
@@ -70,16 +78,24 @@ data ServerStatsData = ServerStatsData
     _qCreated :: Int,
     _qSecured :: Int,
     _qDeletedAll :: Int,
+    _qDeletedAllB :: Int,
     _qDeletedNew :: Int,
     _qDeletedSecured :: Int,
     _qSub :: Int,
     _qSubNoMsg :: Int,
+    _qSubAllB :: Int,
     _qSubAuth :: Int,
     _qSubDuplicate :: Int,
     _qSubProhibited :: Int,
+    _qSubEnd :: Int,
+    _qSubEndB :: Int,
+    _qSubEndSent :: Int,
+    _qSubEndSentB :: Int,
     _ntfCreated :: Int,
     _ntfDeleted :: Int,
+    _ntfDeletedB :: Int,
     _ntfSub :: Int,
+    _ntfSubB :: Int,
     _ntfSubAuth :: Int,
     _ntfSubDuplicate :: Int,
     _msgSent :: Int,
@@ -118,16 +134,24 @@ newServerStats ts = do
   qCreated <- newTVarIO 0
   qSecured <- newTVarIO 0
   qDeletedAll <- newTVarIO 0
+  qDeletedAllB <- newTVarIO 0
   qDeletedNew <- newTVarIO 0
   qDeletedSecured <- newTVarIO 0
   qSub <- newTVarIO 0
   qSubNoMsg <- newTVarIO 0
+  qSubAllB <- newTVarIO 0
   qSubAuth <- newTVarIO 0
   qSubDuplicate <- newTVarIO 0
   qSubProhibited <- newTVarIO 0
+  qSubEnd <- newTVarIO 0
+  qSubEndB <- newTVarIO 0
+  qSubEndSent <- newTVarIO 0
+  qSubEndSentB <- newTVarIO 0
   ntfCreated <- newTVarIO 0
   ntfDeleted <- newTVarIO 0
+  ntfDeletedB <- newTVarIO 0
   ntfSub <- newTVarIO 0
+  ntfSubB <- newTVarIO 0
   ntfSubAuth <- newTVarIO 0
   ntfSubDuplicate <- newTVarIO 0
   msgSent <- newTVarIO 0
@@ -163,16 +187,24 @@ newServerStats ts = do
         qCreated,
         qSecured,
         qDeletedAll,
+        qDeletedAllB,
         qDeletedNew,
         qDeletedSecured,
         qSub,
         qSubNoMsg,
+        qSubAllB,
         qSubAuth,
         qSubDuplicate,
         qSubProhibited,
+        qSubEnd,
+        qSubEndB,
+        qSubEndSent,
+        qSubEndSentB,
         ntfCreated,
         ntfDeleted,
+        ntfDeletedB,
         ntfSub,
+        ntfSubB,
         ntfSubAuth,
         ntfSubDuplicate,
         msgSent,
@@ -210,16 +242,24 @@ getServerStatsData s = do
   _qCreated <- readTVarIO $ qCreated s
   _qSecured <- readTVarIO $ qSecured s
   _qDeletedAll <- readTVarIO $ qDeletedAll s
+  _qDeletedAllB <- readTVarIO $ qDeletedAllB s
   _qDeletedNew <- readTVarIO $ qDeletedNew s
   _qDeletedSecured <- readTVarIO $ qDeletedSecured s
   _qSub <- readTVarIO $ qSub s
   _qSubNoMsg <- readTVarIO $ qSubNoMsg s
+  _qSubAllB <- readTVarIO $ qSubAllB s
   _qSubAuth <- readTVarIO $ qSubAuth s
   _qSubDuplicate <- readTVarIO $ qSubDuplicate s
   _qSubProhibited <- readTVarIO $ qSubProhibited s
+  _qSubEnd <- readTVarIO $ qSubEnd s
+  _qSubEndB <- readTVarIO $ qSubEndB s
+  _qSubEndSent <- readTVarIO $ qSubEndSent s
+  _qSubEndSentB <- readTVarIO $ qSubEndSentB s
   _ntfCreated <- readTVarIO $ ntfCreated s
   _ntfDeleted <- readTVarIO $ ntfDeleted s
+  _ntfDeletedB <- readTVarIO $ ntfDeletedB s
   _ntfSub <- readTVarIO $ ntfSub s
+  _ntfSubB <- readTVarIO $ ntfSubB s
   _ntfSubAuth <- readTVarIO $ ntfSubAuth s
   _ntfSubDuplicate <- readTVarIO $ ntfSubDuplicate s
   _msgSent <- readTVarIO $ msgSent s
@@ -255,16 +295,24 @@ getServerStatsData s = do
         _qCreated,
         _qSecured,
         _qDeletedAll,
+        _qDeletedAllB,
         _qDeletedNew,
         _qDeletedSecured,
         _qSub,
         _qSubNoMsg,
+        _qSubAllB,
         _qSubAuth,
         _qSubDuplicate,
         _qSubProhibited,
+        _qSubEnd,
+        _qSubEndB,
+        _qSubEndSent,
+        _qSubEndSentB,
         _ntfCreated,
         _ntfDeleted,
+        _ntfDeletedB,
         _ntfSub,
+        _ntfSubB,
         _ntfSubAuth,
         _ntfSubDuplicate,
         _msgSent,
@@ -302,16 +350,24 @@ setServerStats s d = do
   writeTVar (qCreated s) $! _qCreated d
   writeTVar (qSecured s) $! _qSecured d
   writeTVar (qDeletedAll s) $! _qDeletedAll d
+  writeTVar (qDeletedAllB s) $! _qDeletedAllB d
   writeTVar (qDeletedNew s) $! _qDeletedNew d
   writeTVar (qDeletedSecured s) $! _qDeletedSecured d
   writeTVar (qSub s) $! _qSub d
   writeTVar (qSubNoMsg s) $! _qSubNoMsg d
+  writeTVar (qSubAllB s) $! _qSubAllB d
   writeTVar (qSubAuth s) $! _qSubAuth d
   writeTVar (qSubDuplicate s) $! _qSubDuplicate d
   writeTVar (qSubProhibited s) $! _qSubProhibited d
+  writeTVar (qSubEnd s) $! _qSubEnd d
+  writeTVar (qSubEndB s) $! _qSubEndB d
+  writeTVar (qSubEndSent s) $! _qSubEndSent d
+  writeTVar (qSubEndSentB s) $! _qSubEndSentB d
   writeTVar (ntfCreated s) $! _ntfCreated d
   writeTVar (ntfDeleted s) $! _ntfDeleted d
+  writeTVar (ntfDeletedB s) $! _ntfDeletedB d
   writeTVar (ntfSub s) $! _ntfSub d
+  writeTVar (ntfSubB s) $! _ntfSubB d
   writeTVar (ntfSubAuth s) $! _ntfSubAuth d
   writeTVar (ntfSubDuplicate s) $! _ntfSubDuplicate d
   writeTVar (msgSent s) $! _msgSent d
@@ -351,15 +407,23 @@ instance StrEncoding ServerStatsData where
         "qDeletedAll=" <> strEncode (_qDeletedAll d),
         "qDeletedNew=" <> strEncode (_qDeletedNew d),
         "qDeletedSecured=" <> strEncode (_qDeletedSecured d),
+        "qDeletedAllB=" <> strEncode (_qDeletedAllB d),
         "qCount=" <> strEncode (_qCount d),
         "qSub=" <> strEncode (_qSub d),
         "qSubNoMsg=" <> strEncode (_qSubNoMsg d),
+        "qSubAllB=" <> strEncode (_qSubAllB d),
         "qSubAuth=" <> strEncode (_qSubAuth d),
         "qSubDuplicate=" <> strEncode (_qSubDuplicate d),
         "qSubProhibited=" <> strEncode (_qSubProhibited d),
+        "qSubEnd=" <> strEncode (_qSubEnd d),
+        "qSubEndB=" <> strEncode (_qSubEndB d),
+        "qSubEndSent=" <> strEncode (_qSubEndSent d),
+        "qSubEndSentB=" <> strEncode (_qSubEndSentB d),
         "ntfCreated=" <> strEncode (_ntfCreated d),
         "ntfDeleted=" <> strEncode (_ntfDeleted d),
+        "ntfDeletedB=" <> strEncode (_ntfDeletedB d),
         "ntfSub=" <> strEncode (_ntfSub d),
+        "ntfSubB=" <> strEncode (_ntfSubB d),
         "ntfSubAuth=" <> strEncode (_ntfSubAuth d),
         "ntfSubDuplicate=" <> strEncode (_ntfSubDuplicate d),
         "msgSent=" <> strEncode (_msgSent d),
@@ -402,15 +466,23 @@ instance StrEncoding ServerStatsData where
     (_qDeletedAll, _qDeletedNew, _qDeletedSecured) <-
       (,0,0) <$> ("qDeleted=" *> strP <* A.endOfLine)
         <|> ((,,) <$> ("qDeletedAll=" *> strP <* A.endOfLine) <*> ("qDeletedNew=" *> strP <* A.endOfLine) <*> ("qDeletedSecured=" *> strP <* A.endOfLine))
+    _qDeletedAllB <- opt "qDeletedAllB="
     _qCount <- opt "qCount="
     _qSub <- opt "qSub="
     _qSubNoMsg <- opt "qSubNoMsg="
+    _qSubAllB <- opt "qSubAllB="
     _qSubAuth <- opt "qSubAuth="
     _qSubDuplicate <- opt "qSubDuplicate="
     _qSubProhibited <- opt "qSubProhibited="
+    _qSubEnd <- opt "qSubEnd="
+    _qSubEndB <- opt "qSubEndB="
+    _qSubEndSent <- opt "qSubEndSent="
+    _qSubEndSentB <- opt "qSubEndSentB="
     _ntfCreated <- opt "ntfCreated="
     _ntfDeleted <- opt "ntfDeleted="
+    _ntfDeletedB <- opt "ntfDeletedB="
     _ntfSub <- opt "ntfSub="
+    _ntfSubB <- opt "ntfSubB="
     _ntfSubAuth <- opt "ntfSubAuth="
     _ntfSubDuplicate <- opt "ntfSubDuplicate="
     _msgSent <- "msgSent=" *> strP <* A.endOfLine
@@ -457,16 +529,24 @@ instance StrEncoding ServerStatsData where
           _qCreated,
           _qSecured,
           _qDeletedAll,
+          _qDeletedAllB,
           _qDeletedNew,
           _qDeletedSecured,
           _qSub,
           _qSubNoMsg,
+          _qSubAllB,
           _qSubAuth,
           _qSubDuplicate,
           _qSubProhibited,
+          _qSubEnd,
+          _qSubEndB,
+          _qSubEndSent,
+          _qSubEndSentB,
           _ntfCreated,
           _ntfDeleted,
+          _ntfDeletedB,
           _ntfSub,
+          _ntfSubB,
           _ntfSubAuth,
           _ntfSubDuplicate,
           _msgSent,
diff --git a/tests/CoreTests/BatchingTests.hs b/tests/CoreTests/BatchingTests.hs
index 5f6beb034..023f6de04 100644
--- a/tests/CoreTests/BatchingTests.hs
+++ b/tests/CoreTests/BatchingTests.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -40,6 +41,7 @@ batchingTests = do
       it "should break on large message" testClientBatchWithLargeMessage
     describe "v7 (next)" $ do
       it "should batch with 136 subscriptions per batch" testClientBatchSubscriptionsV7
+      it "should batch with N ENDs per batch" testClientBatchENDs
       it "should break on message that does not fit" testClientBatchWithMessageV7
       it "should break on large message" testClientBatchWithLargeMessageV7
 
@@ -165,6 +167,20 @@ testClientBatchSubscriptionsV7 = do
   (length rs1, length rs2, length rs3) `shouldBe` (28, 136, 136)
   all lenOk [s1, s2, s3] `shouldBe` True
 
+testClientBatchENDs :: IO ()
+testClientBatchENDs = do
+  client <- clientStubV7
+  ends <- replicateM 300 randomENDCmd
+  let ends' = map (\t -> Right (Nothing, encodeTransmission (thParams client) t)) ends
+      batches1 = batchTransmissions False smpBlockSize $ L.fromList ends'
+  all lenOk1 batches1 `shouldBe` True
+  let batches = batchTransmissions True smpBlockSize $ L.fromList ends'
+  length batches `shouldBe` 2
+  [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2] <- pure batches
+  (n1, n2) `shouldBe` (45, 255)
+  (length rs1, length rs2) `shouldBe` (45, 255)
+  all lenOk [s1, s2] `shouldBe` True
+
 testClientBatchWithMessage :: IO ()
 testClientBatchWithMessage = do
   client <- testClientStub
@@ -301,6 +317,12 @@ randomSUBCmd_ a c = do
   (_, rpKey) <- atomically $ C.generateAuthKeyPair a g
   mkTransmission c (Just rpKey, rId, Cmd SRecipient SUB)
 
+randomENDCmd :: IO (Transmission BrokerMsg)
+randomENDCmd = do
+  g <- C.newRandom
+  rId <- atomically $ C.randomBytes 24 g
+  pure (CorrId "", rId, END)
+
 randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSEND = randomSEND_ C.SEd25519 subModeSMPVersion
 
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 60aa1dd1c..47a6c07f1 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -610,7 +610,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 2
     logSize testStoreMsgsFile `shouldReturn` 5
-    logSize testServerStatsBackupFile `shouldReturn` 71
+    logSize testServerStatsBackupFile `shouldReturn` 79
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
 
@@ -628,7 +628,7 @@ testRestoreMessages at@(ATransport t) =
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
     logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 71
+    logSize testServerStatsBackupFile `shouldReturn` 79
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
@@ -647,7 +647,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     logSize testStoreMsgsFile `shouldReturn` 0
-    logSize testServerStatsBackupFile `shouldReturn` 71
+    logSize testServerStatsBackupFile `shouldReturn` 79
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
 

From aa60bd67700394a048a595230ae46100444c182f Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 26 Aug 2024 19:33:37 +0100
Subject: [PATCH 079/195] use strict Maps, fix stats for sent END batches

---
 src/Simplex/FileTransfer/Client/Main.hs                | 2 +-
 src/Simplex/FileTransfer/Description.hs                | 2 +-
 src/Simplex/FileTransfer/Server.hs                     | 4 ++--
 src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs | 2 +-
 src/Simplex/Messaging/Agent/TRcvQueues.hs              | 2 +-
 src/Simplex/Messaging/Server.hs                        | 4 ++--
 6 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs
index 1eea6ef5a..079392a1b 100644
--- a/src/Simplex/FileTransfer/Client/Main.hs
+++ b/src/Simplex/FileTransfer/Client/Main.hs
@@ -44,7 +44,7 @@ import Data.List (foldl', sortOn)
 import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
-import qualified Data.Map as M
+import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, listToMaybe)
 import qualified Data.Text as T
 import Data.Word (Word32)
diff --git a/src/Simplex/FileTransfer/Description.hs b/src/Simplex/FileTransfer/Description.hs
index c702a177f..8c27d80e7 100644
--- a/src/Simplex/FileTransfer/Description.hs
+++ b/src/Simplex/FileTransfer/Description.hs
@@ -53,7 +53,7 @@ import Data.List (foldl', sortOn)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
-import qualified Data.Map as M
+import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe)
 import Data.String
 import Data.Text (Text)
diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index 819be9a81..be4c7d85f 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -475,7 +475,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
                 pure FROk
               Left e -> do
                 us <- asks $ usedStorage . store
-                atomically . modifyTVar' us $ subtract (fromIntegral size)
+                atomically $ modifyTVar' us $ subtract (fromIntegral size)
                 liftIO $ whenM (doesFileExist fPath) (removeFile fPath) `catch` logFileError
                 pure $ FRErr e
           receiveChunk spec = do
@@ -571,7 +571,7 @@ withFileLog action = liftIO . mapM_ action =<< asks storeLog
 incFileStat :: (FileServerStats -> TVar Int) -> M ()
 incFileStat statSel = do
   stats <- asks serverStats
-  atomically $ modifyTVar (statSel stats) (+ 1)
+  atomically $ modifyTVar' (statSel stats) (+ 1)
 
 saveServerStats :: M ()
 saveServerStats =
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
index 131561f4d..8e17d9af6 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
@@ -29,7 +29,7 @@ import Control.Monad (forM_, when)
 import qualified Data.Aeson.TH as J
 import Data.List (intercalate, sortOn)
 import Data.List.NonEmpty (NonEmpty)
-import qualified Data.Map as M
+import qualified Data.Map.Strict as M
 import Data.Maybe (isNothing, mapMaybe)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1)
diff --git a/src/Simplex/Messaging/Agent/TRcvQueues.hs b/src/Simplex/Messaging/Agent/TRcvQueues.hs
index 3b02f64ae..38a60d6e0 100644
--- a/src/Simplex/Messaging/Agent/TRcvQueues.hs
+++ b/src/Simplex/Messaging/Agent/TRcvQueues.hs
@@ -63,7 +63,7 @@ addQueue rq (TRcvQueues qs cs) = do
     addQ = Just . maybe (k :| []) (k <|)
     k = qKey rq
 
--- Save time by aggregating modifyTVar
+-- Save time by aggregating modifyTVar'
 batchAddQueues :: (Foldable t, Queue q) => TRcvQueues q -> t q -> STM ()
 batchAddQueues (TRcvQueues qs cs) rqs = do
   modifyTVar' qs $ \now -> foldl' (\rqs' rq -> M.insert (qKey rq) rq rqs') now rqs
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 87fe3e9cb..b583f578c 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -768,7 +768,7 @@ send th c@Client {sndQ, msgQ, sessionId} stats = do
       ts@((_, _, END) :| _) -> do -- END events are not combined with others
         let len = L.length ts
         atomically $ modifyTVar' (qSubEndSent stats) (+ len)
-        atomically $ modifyTVar' (qSubEndSentB stats) (+ len `div` 255) -- up to 255 ENDs in the batch
+        atomically $ modifyTVar' (qSubEndSentB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
       _ -> pure ()
         
 sendMsg :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO ()
@@ -1315,7 +1315,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                   void $ setDelivered s msg
                 forkDeliver (rc@Client {sndQ = q}, s@Sub {delivered}, st) = do
                   t <- mkWeakThreadId =<< forkIO deliverThread
-                  atomically . modifyTVar' st $ \case
+                  atomically $ modifyTVar' st $ \case
                     -- this case is needed because deliverThread can exit before it
                     SubPending -> SubThread t
                     st' -> st'

From 2c9ad74599e391724b47c57a4105c9f431c5c36c Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Wed, 28 Aug 2024 10:14:41 +0100
Subject: [PATCH 080/195] smp server: batch END responses when subscribed
 client switches (version 2) (#1283)

* fix incorrect entity ID for notification subscription END when queue is deleted

* throttle sending ENDs

* fix stats

* clean up
---
 src/Simplex/Messaging/Server.hs         | 44 +++++++++++++++++--------
 src/Simplex/Messaging/Server/Env/STM.hs |  6 +++-
 src/Simplex/Messaging/Server/Main.hs    |  1 +
 tests/SMPClient.hs                      |  1 +
 4 files changed, 37 insertions(+), 15 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index b583f578c..503ed597f 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -58,7 +58,7 @@ import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
 import Data.List (intercalate, mapAccumR)
-import Data.List.NonEmpty (NonEmpty (..))
+import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe)
@@ -138,6 +138,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
   raceAny_
     ( serverThread s "server subscribedQ" subscribedQ subscribers subscriptions cancelSub
         : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubscriptions (\_ -> pure ())
+        : sendPendingENDsThread s
         : receiveFromProxyAgent pa
         : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
     )
@@ -170,15 +171,13 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
     serverThread s label subQ subs clientSubs unsub = do
       labelMyThread label
       cls <- asks clients
-      stats <- asks serverStats
       forever $
-        atomically (updateSubscribers cls)
-          $>>= endPreviousSubscriptions stats
+        (atomically (readTQueue $ subQ s) >>= atomically . updateSubscribers cls)
+          $>>= endPreviousSubscriptions
           >>= liftIO . mapM_ unsub
       where
-        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> STM (Maybe (QueueId, Client))
-        updateSubscribers cls = do
-          (qId, clnt, subscribed) <- readTQueue $ subQ s
+        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, Client, Bool) -> STM (Maybe (QueueId, Client))
+        updateSubscribers cls (qId, clnt, subscribed) = do
           current <- IM.member (clientId clnt) <$> readTVar cls
           let updateSub
                 | not subscribed = TM.lookupDelete
@@ -190,14 +189,30 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                     yes <- readTVar $ connected c'
                     pure $ if yes then Just (qId, c') else Nothing
           updateSub qId (subs s) $>>= clientToBeNotified
-        endPreviousSubscriptions :: ServerStats -> (QueueId, Client) -> M (Maybe s)
-        endPreviousSubscriptions stats (qId, c) = do
-          forkClient c (label <> ".endPreviousSubscriptions") $ do
-            atomically $ writeTBQueue (sndQ c) [(CorrId "", qId, END)]
-            incStat $ qSubEnd stats
-            incStat $ qSubEndB stats
+        endPreviousSubscriptions :: (QueueId, Client) -> M (Maybe s)
+        endPreviousSubscriptions (qId, c) = do
+          atomically $ modifyTVar' (pendingENDs s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
           atomically $ TM.lookupDelete qId (clientSubs c)
 
+    sendPendingENDsThread :: Server -> M ()
+    sendPendingENDsThread s = do
+      endInt <- asks $ pendingENDInterval . config
+      cls <- asks clients
+      forever $ do
+        threadDelay endInt
+        ends <- atomically $ swapTVar (pendingENDs s) IM.empty
+        unless (null ends) $ forM_ (IM.assocs ends) $ \(cId, qIds) ->
+          queueENDs qIds . IM.lookup cId =<< readTVarIO cls
+      where
+        queueENDs qIds = \case
+          Just (Just c) -> forkClient c ("sendPendingENDsThread.queueENDs") $ do
+            stats <- asks serverStats
+            atomically $ writeTBQueue (sndQ c) $ L.map (CorrId "",,END) qIds
+            let len = L.length qIds
+            atomically $ modifyTVar' (qSubEnd stats) (+ len)
+            atomically $ modifyTVar' (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
+          _ -> pure ()
+
     receiveFromProxyAgent :: ProxyAgent -> M ()
     receiveFromProxyAgent ProxyAgent {smpAgent = SMPClientAgent {agentQ}} =
       forever $
@@ -1446,7 +1461,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             Right q -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
               atomically $ writeTQueue subscribedQ (entId, clnt, False)
-              atomically $ writeTQueue ntfSubscribedQ (entId, clnt, False)
+              forM_ (notifierId <$> notifier q) $ \nId ->
+                atomically $ writeTQueue ntfSubscribedQ (nId, clnt, False)
               updateDeletedStats q
               pure ok
             Left e -> pure $ err e
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 9b1dd9405..ce89fd633 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -76,6 +76,8 @@ data ServerConfig = ServerConfig
     serverStatsLogFile :: FilePath,
     -- | file to save and restore stats
     serverStatsBackupFile :: Maybe FilePath,
+    -- | interval between sending pending END events to unsubscribed clients, seconds
+    pendingENDInterval :: Int,
     -- | CA certificate private key is not needed for initialization
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
@@ -138,6 +140,7 @@ data Server = Server
     subscribers :: TMap RecipientId Client,
     ntfSubscribedQ :: TQueue (NotifierId, Client, Subscribed),
     notifiers :: TMap NotifierId Client,
+    pendingENDs :: TVar (IntMap (NonEmpty QueueId)),
     savingLock :: Lock
   }
 
@@ -180,8 +183,9 @@ newServer = do
   subscribers <- TM.emptyIO
   ntfSubscribedQ <- newTQueueIO
   notifiers <- TM.emptyIO
+  pendingENDs <- newTVarIO IM.empty
   savingLock <- atomically createLock
-  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, savingLock}
+  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, pendingENDs, savingLock}
 
 newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
 newClient clientId qSize thVersion sessionId createdAt = do
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 784d0504a..e06bdd3ee 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -289,6 +289,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
               logStatsStartTime = 0, -- seconds from 00:00 UTC
               serverStatsLogFile = combine logPath "smp-server-stats.daily.log",
               serverStatsBackupFile = logStats $> combine logPath "smp-server-stats.log",
+              pendingENDInterval = 15000000, -- 15 seconds
               smpServerVRange = supportedServerSMPRelayVRange,
               transportConfig =
                 defaultTransportServerConfig
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 736016b3b..96f64b8f5 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -115,6 +115,7 @@ cfg =
       logStatsStartTime = 0,
       serverStatsLogFile = "tests/smp-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
+      pendingENDInterval = 500000,
       caCertificateFile = "tests/fixtures/ca.crt",
       privateKeyFile = "tests/fixtures/server.key",
       certificateFile = "tests/fixtures/server.crt",

From 2e7e476f813bf32722721a90a626d63d8c3c93f9 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Wed, 28 Aug 2024 18:20:44 +0100
Subject: [PATCH 081/195] smp server: remove "expensive" stats (#1285)

---
 src/Simplex/Messaging/Server.hs       | 78 +++++++++++----------------
 src/Simplex/Messaging/Server/Stats.hs | 51 +++---------------
 tests/ServerTests.hs                  |  6 +--
 3 files changed, 42 insertions(+), 93 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 503ed597f..c5f4d72f0 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -52,7 +52,7 @@ import qualified Data.ByteString.Builder as BLD
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Either (fromRight, partitionEithers, rights)
+import Data.Either (fromRight, partitionEithers)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
@@ -61,7 +61,7 @@ import Data.List (intercalate, mapAccumR)
 import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe)
+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
 import qualified Data.Set as S
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
@@ -256,7 +256,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
       liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
       liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
-      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedAllB, qDeletedNew, qDeletedSecured, qSub, qSubNoMsg, qSubAllB, qSubAuth, qSubDuplicate, qSubProhibited, qSubEnd, qSubEndB, qSubEndSent, qSubEndSentB, ntfCreated, ntfDeleted, ntfDeletedB, ntfSub, ntfSubB, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, subscribedQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv}
+      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedAllB, qDeletedNew, qDeletedSecured, qSub, qSubAllB, qSubAuth, qSubDuplicate, qSubProhibited, qSubEnd, qSubEndB, ntfCreated, ntfDeleted, ntfDeletedB, ntfSub, ntfSubB, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv}
         <- asks serverStats
       QueueStore {queues, notifiers} <- asks queueStore
       let interval = 1000000 * logInterval
@@ -272,15 +272,12 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           qDeletedNew' <- atomically $ swapTVar qDeletedNew 0
           qDeletedSecured' <- atomically $ swapTVar qDeletedSecured 0
           qSub' <- atomically $ swapTVar qSub 0
-          qSubNoMsg' <- atomically $ swapTVar qSubNoMsg 0
           qSubAllB' <- atomically $ swapTVar qSubAllB 0
           qSubAuth' <- atomically $ swapTVar qSubAuth 0
           qSubDuplicate' <- atomically $ swapTVar qSubDuplicate 0
           qSubProhibited' <- atomically $ swapTVar qSubProhibited 0
           qSubEnd' <- atomically $ swapTVar qSubEnd 0
           qSubEndB' <- atomically $ swapTVar qSubEndB 0
-          qSubEndSent' <- atomically $ swapTVar qSubEndSent 0
-          qSubEndSentB' <- atomically $ swapTVar qSubEndSentB 0
           ntfCreated' <- atomically $ swapTVar ntfCreated 0
           ntfDeleted' <- atomically $ swapTVar ntfDeleted 0
           ntfDeletedB' <- atomically $ swapTVar ntfDeletedB 0
@@ -301,7 +298,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           msgGetProhibited' <- atomically $ swapTVar msgGetProhibited 0
           msgExpired' <- atomically $ swapTVar msgExpired 0
           ps <- atomically $ periodStatCounts activeQueues ts
-          psSub <- atomically $ periodStatCounts subscribedQueues ts
           msgSentNtf' <- atomically $ swapTVar msgSentNtf 0
           msgRecvNtf' <- atomically $ swapTVar msgRecvNtf 0
           psNtf <- atomically $ periodStatCounts activeQueuesNtf ts
@@ -355,16 +351,18 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                        show msgNtfs',
                        show msgNtfNoSub',
                        show msgNtfLost',
-                       show qSubNoMsg',
+                       "0", -- qSubNoMsg' is removed for performance.
+                       -- Use qSubAllB for the approximate number of all subscriptions.
+                       -- Average observed batch size is 25-30 subscriptions.
                        show msgRecvGet',
                        show msgGet',
                        show msgGetNoMsg',
                        show msgGetAuth',
                        show msgGetDuplicate',
                        show msgGetProhibited',
-                       dayCount psSub,
-                       weekCount psSub,
-                       monthCount psSub,
+                       "0", -- dayCount psSub; psSub is removed to reduce memory usage
+                       "0", -- weekCount psSub
+                       "0", -- monthCount psSub
                        show qCount'',
                        show ntfCreated',
                        show ntfDeleted',
@@ -376,8 +374,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                        show qSubAllB',
                        show qSubEnd',
                        show qSubEndB',
-                       show qSubEndSent',
-                       show qSubEndSentB',
                        show ntfDeletedB',
                        show ntfSubB'
                      ]
@@ -472,16 +468,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                 putStat "qDeletedNew" qDeletedNew
                 putStat "qDeletedSecured" qDeletedSecured
                 getStat (day . activeQueues) >>= \v -> hPutStrLn h $ "daily active queues: " <> show (S.size v)
-                getStat (day . subscribedQueues) >>= \v -> hPutStrLn h $ "daily subscribed queues: " <> show (S.size v)
+                -- removed to reduce memory usage
+                -- getStat (day . subscribedQueues) >>= \v -> hPutStrLn h $ "daily subscribed queues: " <> show (S.size v)
                 putStat "qSub" qSub
-                putStat "qSubNoMsg" qSubNoMsg
                 putStat "qSubAllB" qSubAllB
-                subEnds <- (,,,) <$> getStat qSubEnd <*> getStat qSubEndB <*> getStat qSubEndSent <*> getStat qSubEndSentB
-                hPutStrLn h $ "SUB ENDs (queued, queued batches, sent, sent batches): " <> show subEnds
+                putStat "qSubEnd" qSubEnd
+                putStat "qSubEndB" qSubEndB
                 subs <- (,,) <$> getStat qSubAuth <*> getStat qSubDuplicate <*> getStat qSubProhibited
                 hPutStrLn h $ "other SUB events (auth, duplicate, prohibited): " <> show subs
-                putStat "qSubEnd" qSubEnd
-                putStat "qSubEndSent" qSubEndSent
                 putStat "msgSent" msgSent
                 putStat "msgRecv" msgRecv
                 putStat "msgRecvGet" msgRecvGet
@@ -671,10 +665,9 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
       atomically $ modifyTVar' active $ IM.insert clientId $ Just c
       s <- asks server
       expCfg <- asks $ inactiveClientExpiration . config
-      stats <- asks serverStats
       th <- newMVar h -- put TH under a fair lock to interleave messages and command responses
       labelMyThread . B.unpack $ "client $" <> encode sessionId
-      raceAny_ $ [liftIO $ send th c stats, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c expCfg
+      raceAny_ $ [liftIO $ send th c, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c expCfg
     disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport h (rcvActiveAt c) (sndActiveAt c) expCfg (noSubscriptions c)]
     disconnectThread_ _ _ = []
     noSubscriptions c = atomically $ (&&) <$> TM.null (ntfSubscriptions c) <*> (not . hasSubs <$> readTVar (subscriptions c))
@@ -720,19 +713,22 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
     ts <- L.toList <$> liftIO (tGet h)
     atomically . (writeTVar rcvActiveAt $!) =<< liftIO getSystemTime
     stats <- asks serverStats
-    let cmd = listToMaybe $ rights $ map (\(_, _, (_, _, cmdOrError)) -> cmdOrError) ts
-    forM_ (cmd >>= batchStatSel) $ \sel -> incStat $ sel stats
     (errs, cmds) <- partitionEithers <$> mapM (cmdAction stats) ts
+    updateBatchStats stats cmds
     write sndQ errs
     write rcvQ cmds
   where
-    batchStatSel :: Cmd -> Maybe (ServerStats -> TVar Int)
-    batchStatSel (Cmd _ cmd) = case cmd of
-      SUB -> Just qSubAllB
-      DEL -> Just qDeletedAllB
-      NSUB -> Just ntfSubB
-      NDEL -> Just ntfDeletedB
-      _ -> Nothing
+    updateBatchStats :: ServerStats -> [(Maybe QueueRec, Transmission Cmd)] -> M ()
+    updateBatchStats stats = \case
+      (_, (_, _, (Cmd _ cmd))) : _ -> do
+        let sel_ = case cmd of
+              SUB -> Just qSubAllB
+              DEL -> Just qDeletedAllB
+              NSUB -> Just ntfSubB
+              NDEL -> Just ntfDeletedB
+              _ -> Nothing
+        mapM_ (\sel -> incStat $ sel stats) sel_
+      [] -> pure ()
     cmdAction :: ServerStats -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
     cmdAction stats (tAuth, authorized, (corrId, entId, cmdOrError)) =
       case cmdOrError of
@@ -751,13 +747,10 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
                 pure $ Left (corrId, entId, ERR AUTH)
     write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
 
-send :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> ServerStats -> IO ()
-send th c@Client {sndQ, msgQ, sessionId} stats = do
+send :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO ()
+send th c@Client {sndQ, msgQ, sessionId} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " send"
-  forever $ do
-    ts <- atomically (readTBQueue sndQ)
-    sendTransmissions ts
-    updateENDStats ts
+  forever $ atomically (readTBQueue sndQ) >>= sendTransmissions
   where
     sendTransmissions :: NonEmpty (Transmission BrokerMsg) -> IO ()
     sendTransmissions ts
@@ -778,13 +771,6 @@ send th c@Client {sndQ, msgQ, sessionId} stats = do
           -- replace MSG response with OK, accumulating MSG in a separate list.
           MSG {} -> ((CorrId "", entId, cmd) : msgs, (corrId, entId, OK))
           _ -> (msgs, t)
-    updateENDStats :: NonEmpty (Transmission BrokerMsg) -> IO ()
-    updateENDStats = \case
-      ts@((_, _, END) :| _) -> do -- END events are not combined with others
-        let len = L.length ts
-        atomically $ modifyTVar' (qSubEndSent stats) (+ len)
-        atomically $ modifyTVar' (qSubEndSentB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
-      _ -> pure ()
         
 sendMsg :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO ()
 sendMsg th c@Client {msgQ, sessionId} = do
@@ -1140,10 +1126,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             deliver inc sub = do
               q <- getStoreMsgQueue "SUB" rId
               msg_ <- atomically $ tryPeekMsg q
-              when inc $ do
-                stats <- asks serverStats
-                incStat $ (if isJust msg_ then qSub else qSubNoMsg) stats
-                atomically $ updatePeriodStats (subscribedQueues stats) rId
+              when (inc && isJust msg_) $
+                incStat . qSub =<< asks serverStats
               deliverMessage "SUB" qr rId sub msg_
 
         getMessage :: QueueRec -> M (Transmission BrokerMsg)
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index 7f1f0eab1..8afb1668a 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Simplex.Messaging.Server.Stats where
 
@@ -27,16 +28,14 @@ data ServerStats = ServerStats
     qDeletedAllB :: TVar Int,
     qDeletedNew :: TVar Int,
     qDeletedSecured :: TVar Int,
-    qSub :: TVar Int,
-    qSubNoMsg :: TVar Int,
-    qSubAllB :: TVar Int,
+    qSub :: TVar Int, -- only includes subscriptions when there were pending messages
+    -- qSubNoMsg :: TVar Int, -- this stat creates too many STM transactions
+    qSubAllB :: TVar Int, -- count of all subscription batches (with and without pending messages)
     qSubAuth :: TVar Int,
     qSubDuplicate :: TVar Int,
     qSubProhibited :: TVar Int,
     qSubEnd :: TVar Int,
     qSubEndB :: TVar Int,
-    qSubEndSent :: TVar Int,
-    qSubEndSentB :: TVar Int,
     ntfCreated :: TVar Int,
     ntfDeleted :: TVar Int,
     ntfDeletedB :: TVar Int,
@@ -57,7 +56,7 @@ data ServerStats = ServerStats
     msgGetProhibited :: TVar Int,
     msgExpired :: TVar Int,
     activeQueues :: PeriodStats RecipientId,
-    subscribedQueues :: PeriodStats RecipientId,
+    -- subscribedQueues :: PeriodStats RecipientId, -- this stat uses too much memory
     msgSentNtf :: TVar Int, -- sent messages with NTF flag
     msgRecvNtf :: TVar Int, -- received messages with NTF flag
     activeQueuesNtf :: PeriodStats RecipientId,
@@ -82,15 +81,12 @@ data ServerStatsData = ServerStatsData
     _qDeletedNew :: Int,
     _qDeletedSecured :: Int,
     _qSub :: Int,
-    _qSubNoMsg :: Int,
     _qSubAllB :: Int,
     _qSubAuth :: Int,
     _qSubDuplicate :: Int,
     _qSubProhibited :: Int,
     _qSubEnd :: Int,
     _qSubEndB :: Int,
-    _qSubEndSent :: Int,
-    _qSubEndSentB :: Int,
     _ntfCreated :: Int,
     _ntfDeleted :: Int,
     _ntfDeletedB :: Int,
@@ -111,7 +107,6 @@ data ServerStatsData = ServerStatsData
     _msgGetProhibited :: Int,
     _msgExpired :: Int,
     _activeQueues :: PeriodStatsData RecipientId,
-    _subscribedQueues :: PeriodStatsData RecipientId,
     _msgSentNtf :: Int,
     _msgRecvNtf :: Int,
     _activeQueuesNtf :: PeriodStatsData RecipientId,
@@ -138,15 +133,12 @@ newServerStats ts = do
   qDeletedNew <- newTVarIO 0
   qDeletedSecured <- newTVarIO 0
   qSub <- newTVarIO 0
-  qSubNoMsg <- newTVarIO 0
   qSubAllB <- newTVarIO 0
   qSubAuth <- newTVarIO 0
   qSubDuplicate <- newTVarIO 0
   qSubProhibited <- newTVarIO 0
   qSubEnd <- newTVarIO 0
   qSubEndB <- newTVarIO 0
-  qSubEndSent <- newTVarIO 0
-  qSubEndSentB <- newTVarIO 0
   ntfCreated <- newTVarIO 0
   ntfDeleted <- newTVarIO 0
   ntfDeletedB <- newTVarIO 0
@@ -167,7 +159,6 @@ newServerStats ts = do
   msgGetProhibited <- newTVarIO 0
   msgExpired <- newTVarIO 0
   activeQueues <- newPeriodStats
-  subscribedQueues <- newPeriodStats
   msgSentNtf <- newTVarIO 0
   msgRecvNtf <- newTVarIO 0
   activeQueuesNtf <- newPeriodStats
@@ -191,15 +182,12 @@ newServerStats ts = do
         qDeletedNew,
         qDeletedSecured,
         qSub,
-        qSubNoMsg,
         qSubAllB,
         qSubAuth,
         qSubDuplicate,
         qSubProhibited,
         qSubEnd,
         qSubEndB,
-        qSubEndSent,
-        qSubEndSentB,
         ntfCreated,
         ntfDeleted,
         ntfDeletedB,
@@ -220,7 +208,6 @@ newServerStats ts = do
         msgGetProhibited,
         msgExpired,
         activeQueues,
-        subscribedQueues,
         msgSentNtf,
         msgRecvNtf,
         activeQueuesNtf,
@@ -246,15 +233,12 @@ getServerStatsData s = do
   _qDeletedNew <- readTVarIO $ qDeletedNew s
   _qDeletedSecured <- readTVarIO $ qDeletedSecured s
   _qSub <- readTVarIO $ qSub s
-  _qSubNoMsg <- readTVarIO $ qSubNoMsg s
   _qSubAllB <- readTVarIO $ qSubAllB s
   _qSubAuth <- readTVarIO $ qSubAuth s
   _qSubDuplicate <- readTVarIO $ qSubDuplicate s
   _qSubProhibited <- readTVarIO $ qSubProhibited s
   _qSubEnd <- readTVarIO $ qSubEnd s
   _qSubEndB <- readTVarIO $ qSubEndB s
-  _qSubEndSent <- readTVarIO $ qSubEndSent s
-  _qSubEndSentB <- readTVarIO $ qSubEndSentB s
   _ntfCreated <- readTVarIO $ ntfCreated s
   _ntfDeleted <- readTVarIO $ ntfDeleted s
   _ntfDeletedB <- readTVarIO $ ntfDeletedB s
@@ -275,7 +259,6 @@ getServerStatsData s = do
   _msgGetProhibited <- readTVarIO $ msgGetProhibited s
   _msgExpired <- readTVarIO $ msgExpired s
   _activeQueues <- getPeriodStatsData $ activeQueues s
-  _subscribedQueues <- getPeriodStatsData $ subscribedQueues s
   _msgSentNtf <- readTVarIO $ msgSentNtf s
   _msgRecvNtf <- readTVarIO $ msgRecvNtf s
   _activeQueuesNtf <- getPeriodStatsData $ activeQueuesNtf s
@@ -299,15 +282,12 @@ getServerStatsData s = do
         _qDeletedNew,
         _qDeletedSecured,
         _qSub,
-        _qSubNoMsg,
         _qSubAllB,
         _qSubAuth,
         _qSubDuplicate,
         _qSubProhibited,
         _qSubEnd,
         _qSubEndB,
-        _qSubEndSent,
-        _qSubEndSentB,
         _ntfCreated,
         _ntfDeleted,
         _ntfDeletedB,
@@ -328,7 +308,6 @@ getServerStatsData s = do
         _msgGetProhibited,
         _msgExpired,
         _activeQueues,
-        _subscribedQueues,
         _msgSentNtf,
         _msgRecvNtf,
         _activeQueuesNtf,
@@ -354,15 +333,12 @@ setServerStats s d = do
   writeTVar (qDeletedNew s) $! _qDeletedNew d
   writeTVar (qDeletedSecured s) $! _qDeletedSecured d
   writeTVar (qSub s) $! _qSub d
-  writeTVar (qSubNoMsg s) $! _qSubNoMsg d
   writeTVar (qSubAllB s) $! _qSubAllB d
   writeTVar (qSubAuth s) $! _qSubAuth d
   writeTVar (qSubDuplicate s) $! _qSubDuplicate d
   writeTVar (qSubProhibited s) $! _qSubProhibited d
   writeTVar (qSubEnd s) $! _qSubEnd d
   writeTVar (qSubEndB s) $! _qSubEndB d
-  writeTVar (qSubEndSent s) $! _qSubEndSent d
-  writeTVar (qSubEndSentB s) $! _qSubEndSentB d
   writeTVar (ntfCreated s) $! _ntfCreated d
   writeTVar (ntfDeleted s) $! _ntfDeleted d
   writeTVar (ntfDeletedB s) $! _ntfDeletedB d
@@ -383,7 +359,6 @@ setServerStats s d = do
   writeTVar (msgGetProhibited s) $! _msgGetProhibited d
   writeTVar (msgExpired s) $! _msgExpired d
   setPeriodStats (activeQueues s) (_activeQueues d)
-  setPeriodStats (subscribedQueues s) (_subscribedQueues d)
   writeTVar (msgSentNtf s) $! _msgSentNtf d
   writeTVar (msgRecvNtf s) $! _msgRecvNtf d
   setPeriodStats (activeQueuesNtf s) (_activeQueuesNtf d)
@@ -410,15 +385,12 @@ instance StrEncoding ServerStatsData where
         "qDeletedAllB=" <> strEncode (_qDeletedAllB d),
         "qCount=" <> strEncode (_qCount d),
         "qSub=" <> strEncode (_qSub d),
-        "qSubNoMsg=" <> strEncode (_qSubNoMsg d),
         "qSubAllB=" <> strEncode (_qSubAllB d),
         "qSubAuth=" <> strEncode (_qSubAuth d),
         "qSubDuplicate=" <> strEncode (_qSubDuplicate d),
         "qSubProhibited=" <> strEncode (_qSubProhibited d),
         "qSubEnd=" <> strEncode (_qSubEnd d),
         "qSubEndB=" <> strEncode (_qSubEndB d),
-        "qSubEndSent=" <> strEncode (_qSubEndSent d),
-        "qSubEndSentB=" <> strEncode (_qSubEndSentB d),
         "ntfCreated=" <> strEncode (_ntfCreated d),
         "ntfDeleted=" <> strEncode (_ntfDeleted d),
         "ntfDeletedB=" <> strEncode (_ntfDeletedB d),
@@ -445,8 +417,6 @@ instance StrEncoding ServerStatsData where
         "msgNtfLost=" <> strEncode (_msgNtfLost d),
         "activeQueues:",
         strEncode (_activeQueues d),
-        "subscribedQueues:",
-        strEncode (_subscribedQueues d),
         "activeQueuesNtf:",
         strEncode (_activeQueuesNtf d),
         "pRelays:",
@@ -469,15 +439,13 @@ instance StrEncoding ServerStatsData where
     _qDeletedAllB <- opt "qDeletedAllB="
     _qCount <- opt "qCount="
     _qSub <- opt "qSub="
-    _qSubNoMsg <- opt "qSubNoMsg="
+    _qSubNoMsg <- skipInt "qSubNoMsg=" -- skipping it for backward compatibility
     _qSubAllB <- opt "qSubAllB="
     _qSubAuth <- opt "qSubAuth="
     _qSubDuplicate <- opt "qSubDuplicate="
     _qSubProhibited <- opt "qSubProhibited="
     _qSubEnd <- opt "qSubEnd="
     _qSubEndB <- opt "qSubEndB="
-    _qSubEndSent <- opt "qSubEndSent="
-    _qSubEndSentB <- opt "qSubEndSentB="
     _ntfCreated <- opt "ntfCreated="
     _ntfDeleted <- opt "ntfDeleted="
     _ntfDeletedB <- opt "ntfDeletedB="
@@ -512,7 +480,7 @@ instance StrEncoding ServerStatsData where
           pure PeriodStatsData {_day, _week, _month}
     _subscribedQueues <-
       optional ("subscribedQueues:" <* A.endOfLine) >>= \case
-        Just _ -> strP <* optional A.endOfLine
+        Just _ -> newPeriodStatsData <$ (strP @(PeriodStatsData RecipientId) <* optional A.endOfLine)
         _ -> pure newPeriodStatsData
     _activeQueuesNtf <-
       optional ("activeQueuesNtf:" <* A.endOfLine) >>= \case
@@ -533,15 +501,12 @@ instance StrEncoding ServerStatsData where
           _qDeletedNew,
           _qDeletedSecured,
           _qSub,
-          _qSubNoMsg,
           _qSubAllB,
           _qSubAuth,
           _qSubDuplicate,
           _qSubProhibited,
           _qSubEnd,
           _qSubEndB,
-          _qSubEndSent,
-          _qSubEndSentB,
           _ntfCreated,
           _ntfDeleted,
           _ntfDeletedB,
@@ -567,7 +532,6 @@ instance StrEncoding ServerStatsData where
           _msgNtfNoSub,
           _msgNtfLost,
           _activeQueues,
-          _subscribedQueues,
           _activeQueuesNtf,
           _pRelays,
           _pRelaysOwn,
@@ -579,6 +543,7 @@ instance StrEncoding ServerStatsData where
         }
     where
       opt s = A.string s *> strP <* A.endOfLine <|> pure 0
+      skipInt s = (0 :: Int) <$ optional (A.string s *> strP @Int *> A.endOfLine)
       proxyStatsP key =
         optional (A.string key >> A.endOfLine) >>= \case
           Just _ -> strP <* optional A.endOfLine
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 47a6c07f1..30521c8a8 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -610,7 +610,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 2
     logSize testStoreMsgsFile `shouldReturn` 5
-    logSize testServerStatsBackupFile `shouldReturn` 79
+    logSize testServerStatsBackupFile `shouldReturn` 72
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
 
@@ -628,7 +628,7 @@ testRestoreMessages at@(ATransport t) =
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
     logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 79
+    logSize testServerStatsBackupFile `shouldReturn` 72
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
@@ -647,7 +647,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     logSize testStoreMsgsFile `shouldReturn` 0
-    logSize testServerStatsBackupFile `shouldReturn` 79
+    logSize testServerStatsBackupFile `shouldReturn` 72
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
 

From 9596a0313986eaf9406d1f335f53f7b244284d5e Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 29 Aug 2024 13:18:12 +0100
Subject: [PATCH 082/195] servers: reduce STM transactions (#1287)

* servers: reduce STM transactions

* switch stats and pending ENDs to IORef

* more IORef, split pending ENDs to use in one thread
---
 src/Simplex/FileTransfer/Server.hs            |  57 ++-
 src/Simplex/FileTransfer/Server/Stats.hs      |  85 ++--
 src/Simplex/Messaging/Notifications/Server.hs |  34 +-
 .../Messaging/Notifications/Server/Stats.hs   |  69 +--
 src/Simplex/Messaging/Server.hs               | 152 +++---
 src/Simplex/Messaging/Server/Env/STM.hs       |   9 +-
 src/Simplex/Messaging/Server/Stats.hs         | 437 +++++++++---------
 src/Simplex/Messaging/Util.hs                 |   6 +-
 8 files changed, 435 insertions(+), 414 deletions(-)

diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index be4c7d85f..00b320f68 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -37,6 +37,7 @@ import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Word (Word32)
 import qualified Data.X509 as X
 import GHC.IO.Handle (hSetNewlineMode)
+import GHC.IORef (atomicSwapIORef)
 import GHC.Stats (getRTSStats)
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Server as H
@@ -207,17 +208,17 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
           hSetBuffering h LineBuffering
           ts <- getCurrentTime
-          fromTime' <- atomically $ swapTVar fromTime ts
-          filesCreated' <- atomically $ swapTVar filesCreated 0
-          fileRecipients' <- atomically $ swapTVar fileRecipients 0
-          filesUploaded' <- atomically $ swapTVar filesUploaded 0
-          filesExpired' <- atomically $ swapTVar filesExpired 0
-          filesDeleted' <- atomically $ swapTVar filesDeleted 0
-          files <- atomically $ periodStatCounts filesDownloaded ts
-          fileDownloads' <- atomically $ swapTVar fileDownloads 0
-          fileDownloadAcks' <- atomically $ swapTVar fileDownloadAcks 0
-          filesCount' <- readTVarIO filesCount
-          filesSize' <- readTVarIO filesSize
+          fromTime' <- atomicSwapIORef fromTime ts
+          filesCreated' <- atomicSwapIORef filesCreated 0
+          fileRecipients' <- atomicSwapIORef fileRecipients 0
+          filesUploaded' <- atomicSwapIORef filesUploaded 0
+          filesExpired' <- atomicSwapIORef filesExpired 0
+          filesDeleted' <- atomicSwapIORef filesDeleted 0
+          files <- liftIO $ periodStatCounts filesDownloaded ts
+          fileDownloads' <- atomicSwapIORef fileDownloads 0
+          fileDownloadAcks' <- atomicSwapIORef fileDownloadAcks 0
+          filesCount' <- readIORef filesCount
+          filesSize' <- readIORef filesSize
           hPutStrLn h $
             intercalate
               ","
@@ -405,8 +406,8 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
           logAddFile sl sId file ts
           logAddRecipients sl sId rcps
         stats <- asks serverStats
-        atomically $ modifyTVar' (filesCreated stats) (+ 1)
-        atomically $ modifyTVar' (fileRecipients stats) (+ length rks)
+        lift $ incFileStat filesCreated
+        liftIO $ atomicModifyIORef'_ (fileRecipients stats) (+ length rks)
         let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
         pure $ FRSndIds sId rIds
       pure $ either FRErr id r
@@ -435,7 +436,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
         rcps <- mapM (ExceptT . addRecipientRetry st 3 sId) rks
         lift $ withFileLog $ \sl -> logAddRecipients sl sId rcps
         stats <- asks serverStats
-        atomically $ modifyTVar' (fileRecipients stats) (+ length rks)
+        liftIO $ atomicModifyIORef'_ (fileRecipients stats) (+ length rks)
         let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
         pure $ FRRcvIds rIds
       pure $ either FRErr id r
@@ -469,9 +470,9 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
                 stats <- asks serverStats
                 withFileLog $ \sl -> logPutFile sl senderId fPath
                 atomically $ writeTVar filePath (Just fPath)
-                atomically $ modifyTVar' (filesUploaded stats) (+ 1)
-                atomically $ modifyTVar' (filesCount stats) (+ 1)
-                atomically $ modifyTVar' (filesSize stats) (+ fromIntegral size)
+                incFileStat filesUploaded
+                incFileStat filesCount
+                liftIO $ atomicModifyIORef'_ (filesSize stats) (+ fromIntegral size)
                 pure FROk
               Left e -> do
                 us <- asks $ usedStorage . store
@@ -494,8 +495,8 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
               case LC.cbInit dhSecret cbNonce of
                 Right sbState -> do
                   stats <- asks serverStats
-                  atomically $ modifyTVar' (fileDownloads stats) (+ 1)
-                  atomically $ updatePeriodStats (filesDownloaded stats) senderId
+                  incFileStat fileDownloads
+                  liftIO $ updatePeriodStats (filesDownloaded stats) senderId
                   pure (FRFile sDhKey cbNonce, Just ServerFile {filePath = path, fileSize = size, sbState})
                 _ -> pure (FRErr INTERNAL, Nothing)
         _ -> pure (FRErr NO_FILE, Nothing)
@@ -511,8 +512,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
       withFileLog (`logAckFile` rId)
       st <- asks store
       atomically $ deleteRecipient st rId fr
-      stats <- asks serverStats
-      atomically $ modifyTVar' (fileDownloadAcks stats) (+ 1)
+      incFileStat fileDownloadAcks
       pure FROk
 
 deleteServerFile_ :: FileRec -> M (Either XFTPErrorType ())
@@ -524,11 +524,11 @@ deleteServerFile_ FileRec {senderId, fileInfo, filePath} = do
     ExceptT $ first (\(_ :: SomeException) -> FILE_IO) <$> try (forM_ path $ \p -> whenM (doesFileExist p) (removeFile p >> deletedStats stats))
     st <- asks store
     void $ atomically $ deleteFile st senderId
-    atomically $ modifyTVar' (filesDeleted stats) (+ 1)
+    lift $ incFileStat filesDeleted
   where
     deletedStats stats = do
-      atomically $ modifyTVar' (filesCount stats) (subtract 1)
-      atomically $ modifyTVar' (filesSize stats) (subtract $ fromIntegral $ size fileInfo)
+      liftIO $ atomicModifyIORef'_ (filesCount stats) (subtract 1)
+      liftIO $ atomicModifyIORef'_ (filesSize stats) (subtract $ fromIntegral $ size fileInfo)
 
 expireServerFiles :: Maybe Int -> ExpirationConfig -> M ()
 expireServerFiles itemDelay expCfg = do
@@ -554,8 +554,7 @@ expireServerFiles itemDelay expCfg = do
     delete st sId = do
       withFileLog (`logDeleteFile` sId)
       void . atomically $ deleteFile st sId -- will not update usedStorage if sId isn't in store
-      FileServerStats {filesExpired} <- asks serverStats
-      atomically $ modifyTVar' filesExpired (+ 1)
+      incFileStat filesExpired
 
 randomId :: Int -> M ByteString
 randomId n = atomically . C.randomBytes n =<< asks random
@@ -568,10 +567,10 @@ getFileId = do
 withFileLog :: (StoreLog 'WriteMode -> IO a) -> M ()
 withFileLog action = liftIO . mapM_ action =<< asks storeLog
 
-incFileStat :: (FileServerStats -> TVar Int) -> M ()
+incFileStat :: (FileServerStats -> IORef Int) -> M ()
 incFileStat statSel = do
   stats <- asks serverStats
-  atomically $ modifyTVar' (statSel stats) (+ 1)
+  liftIO $ atomicModifyIORef'_ (statSel stats) (+ 1)
 
 saveServerStats :: M ()
 saveServerStats =
@@ -594,7 +593,7 @@ restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStat
           FileStore {files, usedStorage} <- asks store
           _filesCount <- M.size <$> readTVarIO files
           _filesSize <- readTVarIO usedStorage
-          atomically $ setFileServerStats s d {_filesCount, _filesSize}
+          liftIO $ setFileServerStats s d {_filesCount, _filesSize}
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
           when (statsFilesCount /= _filesCount) $ logWarn $ "Files count differs: stats: " <> tshow statsFilesCount <> ", store: " <> tshow _filesCount
diff --git a/src/Simplex/FileTransfer/Server/Stats.hs b/src/Simplex/FileTransfer/Server/Stats.hs
index 1178dd5f6..8737e6f78 100644
--- a/src/Simplex/FileTransfer/Server/Stats.hs
+++ b/src/Simplex/FileTransfer/Server/Stats.hs
@@ -7,25 +7,25 @@ module Simplex.FileTransfer.Server.Stats where
 import Control.Applicative ((<|>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
+import Data.IORef
 import Data.Int (Int64)
 import Data.Time.Clock (UTCTime)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (SenderId)
 import Simplex.Messaging.Server.Stats (PeriodStats, PeriodStatsData, getPeriodStatsData, newPeriodStats, setPeriodStats)
-import UnliftIO.STM
 
 data FileServerStats = FileServerStats
-  { fromTime :: TVar UTCTime,
-    filesCreated :: TVar Int,
-    fileRecipients :: TVar Int,
-    filesUploaded :: TVar Int,
-    filesExpired :: TVar Int,
-    filesDeleted :: TVar Int,
+  { fromTime :: IORef UTCTime,
+    filesCreated :: IORef Int,
+    fileRecipients :: IORef Int,
+    filesUploaded :: IORef Int,
+    filesExpired :: IORef Int,
+    filesDeleted :: IORef Int,
     filesDownloaded :: PeriodStats SenderId,
-    fileDownloads :: TVar Int,
-    fileDownloadAcks :: TVar Int,
-    filesCount :: TVar Int,
-    filesSize :: TVar Int64
+    fileDownloads :: IORef Int,
+    fileDownloadAcks :: IORef Int,
+    filesCount :: IORef Int,
+    filesSize :: IORef Int64
   }
 
 data FileServerStatsData = FileServerStatsData
@@ -45,47 +45,48 @@ data FileServerStatsData = FileServerStatsData
 
 newFileServerStats :: UTCTime -> IO FileServerStats
 newFileServerStats ts = do
-  fromTime <- newTVarIO ts
-  filesCreated <- newTVarIO 0
-  fileRecipients <- newTVarIO 0
-  filesUploaded <- newTVarIO 0
-  filesExpired <- newTVarIO 0
-  filesDeleted <- newTVarIO 0
+  fromTime <- newIORef ts
+  filesCreated <- newIORef 0
+  fileRecipients <- newIORef 0
+  filesUploaded <- newIORef 0
+  filesExpired <- newIORef 0
+  filesDeleted <- newIORef 0
   filesDownloaded <- newPeriodStats
-  fileDownloads <- newTVarIO 0
-  fileDownloadAcks <- newTVarIO 0
-  filesCount <- newTVarIO 0
-  filesSize <- newTVarIO 0
+  fileDownloads <- newIORef 0
+  fileDownloadAcks <- newIORef 0
+  filesCount <- newIORef 0
+  filesSize <- newIORef 0
   pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}
 
 getFileServerStatsData :: FileServerStats -> IO FileServerStatsData
 getFileServerStatsData s = do
-  _fromTime <- readTVarIO $ fromTime (s :: FileServerStats)
-  _filesCreated <- readTVarIO $ filesCreated s
-  _fileRecipients <- readTVarIO $ fileRecipients s
-  _filesUploaded <- readTVarIO $ filesUploaded s
-  _filesExpired <- readTVarIO $ filesExpired s
-  _filesDeleted <- readTVarIO $ filesDeleted s
+  _fromTime <- readIORef $ fromTime (s :: FileServerStats)
+  _filesCreated <- readIORef $ filesCreated s
+  _fileRecipients <- readIORef $ fileRecipients s
+  _filesUploaded <- readIORef $ filesUploaded s
+  _filesExpired <- readIORef $ filesExpired s
+  _filesDeleted <- readIORef $ filesDeleted s
   _filesDownloaded <- getPeriodStatsData $ filesDownloaded s
-  _fileDownloads <- readTVarIO $ fileDownloads s
-  _fileDownloadAcks <- readTVarIO $ fileDownloadAcks s
-  _filesCount <- readTVarIO $ filesCount s
-  _filesSize <- readTVarIO $ filesSize s
+  _fileDownloads <- readIORef $ fileDownloads s
+  _fileDownloadAcks <- readIORef $ fileDownloadAcks s
+  _filesCount <- readIORef $ filesCount s
+  _filesSize <- readIORef $ filesSize s
   pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
 
-setFileServerStats :: FileServerStats -> FileServerStatsData -> STM ()
+-- this function is not thread safe, it is used on server start only
+setFileServerStats :: FileServerStats -> FileServerStatsData -> IO ()
 setFileServerStats s d = do
-  writeTVar (fromTime (s :: FileServerStats)) $! _fromTime (d :: FileServerStatsData)
-  writeTVar (filesCreated s) $! _filesCreated d
-  writeTVar (fileRecipients s) $! _fileRecipients d
-  writeTVar (filesUploaded s) $! _filesUploaded d
-  writeTVar (filesExpired s) $! _filesExpired d
-  writeTVar (filesDeleted s) $! _filesDeleted d
+  writeIORef (fromTime (s :: FileServerStats)) $! _fromTime (d :: FileServerStatsData)
+  writeIORef (filesCreated s) $! _filesCreated d
+  writeIORef (fileRecipients s) $! _fileRecipients d
+  writeIORef (filesUploaded s) $! _filesUploaded d
+  writeIORef (filesExpired s) $! _filesExpired d
+  writeIORef (filesDeleted s) $! _filesDeleted d
   setPeriodStats (filesDownloaded s) $! _filesDownloaded d
-  writeTVar (fileDownloads s) $! _fileDownloads d
-  writeTVar (fileDownloadAcks s) $! _fileDownloadAcks d
-  writeTVar (filesCount s) $! _filesCount d
-  writeTVar (filesSize s) $! _filesSize d
+  writeIORef (fileDownloads s) $! _fileDownloads d
+  writeIORef (fileDownloadAcks s) $! _fileDownloadAcks d
+  writeIORef (filesCount s) $! _filesCount d
+  writeIORef (filesSize s) $! _filesSize d
 
 instance StrEncoding FileServerStatsData where
   strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize} =
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index c75c844bb..21f551199 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -19,6 +19,7 @@ import Control.Monad.Reader
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
+import Data.IORef
 import Data.Int (Int64)
 import Data.List (intercalate, sort)
 import Data.List.NonEmpty (NonEmpty (..))
@@ -30,6 +31,7 @@ import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Clock.System (getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
+import GHC.IORef (atomicSwapIORef)
 import Network.Socket (ServiceName)
 import Simplex.Messaging.Client (ProtocolClientError (..), SMPClientError, ServerTransmission (..))
 import Simplex.Messaging.Client.Agent
@@ -118,16 +120,16 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
           hSetBuffering h LineBuffering
           ts <- getCurrentTime
-          fromTime' <- atomically $ swapTVar fromTime ts
-          tknCreated' <- atomically $ swapTVar tknCreated 0
-          tknVerified' <- atomically $ swapTVar tknVerified 0
-          tknDeleted' <- atomically $ swapTVar tknDeleted 0
-          subCreated' <- atomically $ swapTVar subCreated 0
-          subDeleted' <- atomically $ swapTVar subDeleted 0
-          ntfReceived' <- atomically $ swapTVar ntfReceived 0
-          ntfDelivered' <- atomically $ swapTVar ntfDelivered 0
-          tkn <- atomically $ periodStatCounts activeTokens ts
-          sub <- atomically $ periodStatCounts activeSubs ts
+          fromTime' <- atomicSwapIORef fromTime ts
+          tknCreated' <- atomicSwapIORef tknCreated 0
+          tknVerified' <- atomicSwapIORef tknVerified 0
+          tknDeleted' <- atomicSwapIORef tknDeleted 0
+          subCreated' <- atomicSwapIORef subCreated 0
+          subDeleted' <- atomicSwapIORef subDeleted 0
+          ntfReceived' <- atomicSwapIORef ntfReceived 0
+          ntfDelivered' <- atomicSwapIORef ntfDelivered 0
+          tkn <- liftIO $ periodStatCounts activeTokens ts
+          sub <- liftIO $ periodStatCounts activeSubs ts
           hPutStrLn h $
             intercalate
               ","
@@ -215,7 +217,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
               st <- asks store
               NtfPushServer {pushQ} <- asks pushServer
               stats <- asks serverStats
-              atomically $ updatePeriodStats (activeSubs stats) ntfId
+              liftIO $ updatePeriodStats (activeSubs stats) ntfId
               atomically $
                 findNtfSubscriptionToken st smpQueue
                   >>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}))
@@ -299,7 +301,7 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
       void $ deliverNotification pp tkn ntf
     PNMessage {} -> checkActiveTkn status $ do
       stats <- asks serverStats
-      atomically $ updatePeriodStats (activeTokens stats) ntfTknId
+      liftIO $ updatePeriodStats (activeTokens stats) ntfTknId
       void $ deliverNotification pp tkn ntf
       incNtfStat ntfDelivered
   where
@@ -575,14 +577,14 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
 withNtfLog :: (StoreLog 'WriteMode -> IO a) -> M ()
 withNtfLog action = liftIO . mapM_ action =<< asks storeLog
 
-incNtfStatT :: DeviceToken -> (NtfServerStats -> TVar Int) -> M ()
+incNtfStatT :: DeviceToken -> (NtfServerStats -> IORef Int) -> M ()
 incNtfStatT (DeviceToken PPApnsNull _) _ = pure ()
 incNtfStatT _ statSel = incNtfStat statSel
 
-incNtfStat :: (NtfServerStats -> TVar Int) -> M ()
+incNtfStat :: (NtfServerStats -> IORef Int) -> M ()
 incNtfStat statSel = do
   stats <- asks serverStats
-  atomically $ modifyTVar' (statSel stats) (+ 1)
+  liftIO $ atomicModifyIORef'_ (statSel stats) (+ 1)
 
 saveServerStats :: M ()
 saveServerStats =
@@ -602,7 +604,7 @@ restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStat
       liftIO (strDecode <$> B.readFile f) >>= \case
         Right d -> do
           s <- asks serverStats
-          atomically $ setNtfServerStats s d
+          liftIO $ setNtfServerStats s d
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
         Left e -> do
diff --git a/src/Simplex/Messaging/Notifications/Server/Stats.hs b/src/Simplex/Messaging/Notifications/Server/Stats.hs
index b73e6098f..2c469e335 100644
--- a/src/Simplex/Messaging/Notifications/Server/Stats.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Stats.hs
@@ -7,22 +7,22 @@ module Simplex.Messaging.Notifications.Server.Stats where
 import Control.Applicative (optional)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
+import Data.IORef
 import Data.Time.Clock (UTCTime)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (NtfTokenId)
 import Simplex.Messaging.Protocol (NotifierId)
 import Simplex.Messaging.Server.Stats
-import UnliftIO.STM
 
 data NtfServerStats = NtfServerStats
-  { fromTime :: TVar UTCTime,
-    tknCreated :: TVar Int,
-    tknVerified :: TVar Int,
-    tknDeleted :: TVar Int,
-    subCreated :: TVar Int,
-    subDeleted :: TVar Int,
-    ntfReceived :: TVar Int,
-    ntfDelivered :: TVar Int,
+  { fromTime :: IORef UTCTime,
+    tknCreated :: IORef Int,
+    tknVerified :: IORef Int,
+    tknDeleted :: IORef Int,
+    subCreated :: IORef Int,
+    subDeleted :: IORef Int,
+    ntfReceived :: IORef Int,
+    ntfDelivered :: IORef Int,
     activeTokens :: PeriodStats NtfTokenId,
     activeSubs :: PeriodStats NotifierId
   }
@@ -42,42 +42,43 @@ data NtfServerStatsData = NtfServerStatsData
 
 newNtfServerStats :: UTCTime -> IO NtfServerStats
 newNtfServerStats ts = do
-  fromTime <- newTVarIO ts
-  tknCreated <- newTVarIO 0
-  tknVerified <- newTVarIO 0
-  tknDeleted <- newTVarIO 0
-  subCreated <- newTVarIO 0
-  subDeleted <- newTVarIO 0
-  ntfReceived <- newTVarIO 0
-  ntfDelivered <- newTVarIO 0
+  fromTime <- newIORef ts
+  tknCreated <- newIORef 0
+  tknVerified <- newIORef 0
+  tknDeleted <- newIORef 0
+  subCreated <- newIORef 0
+  subDeleted <- newIORef 0
+  ntfReceived <- newIORef 0
+  ntfDelivered <- newIORef 0
   activeTokens <- newPeriodStats
   activeSubs <- newPeriodStats
   pure NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs}
 
 getNtfServerStatsData :: NtfServerStats -> IO NtfServerStatsData
 getNtfServerStatsData s@NtfServerStats {fromTime} = do
-  _fromTime <- readTVarIO fromTime
-  _tknCreated <- readTVarIO $ tknCreated s
-  _tknVerified <- readTVarIO $ tknVerified s
-  _tknDeleted <- readTVarIO $ tknDeleted s
-  _subCreated <- readTVarIO $ subCreated s
-  _subDeleted <- readTVarIO $ subDeleted s
-  _ntfReceived <- readTVarIO $ ntfReceived s
-  _ntfDelivered <- readTVarIO $ ntfDelivered s
+  _fromTime <- readIORef fromTime
+  _tknCreated <- readIORef $ tknCreated s
+  _tknVerified <- readIORef $ tknVerified s
+  _tknDeleted <- readIORef $ tknDeleted s
+  _subCreated <- readIORef $ subCreated s
+  _subDeleted <- readIORef $ subDeleted s
+  _ntfReceived <- readIORef $ ntfReceived s
+  _ntfDelivered <- readIORef $ ntfDelivered s
   _activeTokens <- getPeriodStatsData $ activeTokens s
   _activeSubs <- getPeriodStatsData $ activeSubs s
   pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
 
-setNtfServerStats :: NtfServerStats -> NtfServerStatsData -> STM ()
+-- this function is not thread safe, it is used on server start only
+setNtfServerStats :: NtfServerStats -> NtfServerStatsData -> IO ()
 setNtfServerStats s@NtfServerStats {fromTime} d@NtfServerStatsData {_fromTime} = do
-  writeTVar fromTime $! _fromTime
-  writeTVar (tknCreated s) $! _tknCreated d
-  writeTVar (tknVerified s) $! _tknVerified d
-  writeTVar (tknDeleted s) $! _tknDeleted d
-  writeTVar (subCreated s) $! _subCreated d
-  writeTVar (subDeleted s) $! _subDeleted d
-  writeTVar (ntfReceived s) $! _ntfReceived d
-  writeTVar (ntfDelivered s) $! _ntfDelivered d
+  writeIORef fromTime $! _fromTime
+  writeIORef (tknCreated s) $! _tknCreated d
+  writeIORef (tknVerified s) $! _tknVerified d
+  writeIORef (tknDeleted s) $! _tknDeleted d
+  writeIORef (subCreated s) $! _subCreated d
+  writeIORef (subDeleted s) $! _subDeleted d
+  writeIORef (ntfReceived s) $! _ntfReceived d
+  writeIORef (ntfDelivered s) $! _ntfDelivered d
   setPeriodStats (activeTokens s) (_activeTokens d)
   setPeriodStats (activeSubs s) (_activeSubs d)
 
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index c5f4d72f0..fb840fbb1 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -54,6 +54,7 @@ import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Either (fromRight, partitionEithers)
 import Data.Functor (($>))
+import Data.IORef
 import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
@@ -69,6 +70,7 @@ import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Type.Equality
+import GHC.IORef (atomicSwapIORef)
 import GHC.Stats (getRTSStats)
 import GHC.TypeLits (KnownNat)
 import Network.Socket (ServiceName, Socket, socketToHandle)
@@ -136,8 +138,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
   expired <- restoreServerMessages
   restoreServerStats expired
   raceAny_
-    ( serverThread s "server subscribedQ" subscribedQ subscribers subscriptions cancelSub
-        : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubscriptions (\_ -> pure ())
+    ( serverThread s "server subscribedQ" subscribedQ subscribers pendingENDs subscriptions cancelSub
+        : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers pendingNtfENDs ntfSubscriptions (\_ -> pure ())
         : sendPendingENDsThread s
         : receiveFromProxyAgent pa
         : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
@@ -165,16 +167,17 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       String ->
       (Server -> TQueue (QueueId, Client, Subscribed)) ->
       (Server -> TMap QueueId Client) ->
+      (Server -> IORef (IM.IntMap (NonEmpty RecipientId))) ->
       (Client -> TMap QueueId s) ->
       (s -> IO ()) ->
       M ()
-    serverThread s label subQ subs clientSubs unsub = do
+    serverThread s label subQ subs ends clientSubs unsub = do
       labelMyThread label
       cls <- asks clients
-      forever $
+      liftIO . forever $
         (atomically (readTQueue $ subQ s) >>= atomically . updateSubscribers cls)
           $>>= endPreviousSubscriptions
-          >>= liftIO . mapM_ unsub
+          >>= mapM_ unsub
       where
         updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, Client, Bool) -> STM (Maybe (QueueId, Client))
         updateSubscribers cls (qId, clnt, subscribed) = do
@@ -189,9 +192,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                     yes <- readTVar $ connected c'
                     pure $ if yes then Just (qId, c') else Nothing
           updateSub qId (subs s) $>>= clientToBeNotified
-        endPreviousSubscriptions :: (QueueId, Client) -> M (Maybe s)
+        endPreviousSubscriptions :: (QueueId, Client) -> IO (Maybe s)
         endPreviousSubscriptions (qId, c) = do
-          atomically $ modifyTVar' (pendingENDs s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
+          atomicModifyIORef'_ (ends s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
           atomically $ TM.lookupDelete qId (clientSubs c)
 
     sendPendingENDsThread :: Server -> M ()
@@ -200,17 +203,20 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       cls <- asks clients
       forever $ do
         threadDelay endInt
-        ends <- atomically $ swapTVar (pendingENDs s) IM.empty
-        unless (null ends) $ forM_ (IM.assocs ends) $ \(cId, qIds) ->
-          queueENDs qIds . IM.lookup cId =<< readTVarIO cls
+        sendPending cls $ pendingENDs s
+        sendPending cls $ pendingNtfENDs s
       where
+        sendPending cls ref = do
+          ends <- liftIO $ atomicSwapIORef ref IM.empty
+          unless (null ends) $ forM_ (IM.assocs ends) $ \(cId, qIds) ->
+            queueENDs qIds . IM.lookup cId =<< readTVarIO cls
         queueENDs qIds = \case
           Just (Just c) -> forkClient c ("sendPendingENDsThread.queueENDs") $ do
             stats <- asks serverStats
             atomically $ writeTBQueue (sndQ c) $ L.map (CorrId "",,END) qIds
             let len = L.length qIds
-            atomically $ modifyTVar' (qSubEnd stats) (+ len)
-            atomically $ modifyTVar' (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
+            liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
+            liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
           _ -> pure ()
 
     receiveFromProxyAgent :: ProxyAgent -> M ()
@@ -243,7 +249,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
         forM_ rIds $ \rId -> do
           q <- atomically (getMsgQueue ms rId quota)
           deleted <- atomically $ deleteExpiredMsgs q old
-          atomically $ modifyTVar' (msgExpired stats) (+ deleted)
+          liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
 
     serverStatsThread_ :: ServerConfig -> [M ()]
     serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime, serverStatsLogFile} =
@@ -264,55 +270,55 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
           hSetBuffering h LineBuffering
           ts <- getCurrentTime
-          fromTime' <- atomically $ swapTVar fromTime ts
-          qCreated' <- atomically $ swapTVar qCreated 0
-          qSecured' <- atomically $ swapTVar qSecured 0
-          qDeletedAll' <- atomically $ swapTVar qDeletedAll 0
-          qDeletedAllB' <- atomically $ swapTVar qDeletedAllB 0
-          qDeletedNew' <- atomically $ swapTVar qDeletedNew 0
-          qDeletedSecured' <- atomically $ swapTVar qDeletedSecured 0
-          qSub' <- atomically $ swapTVar qSub 0
-          qSubAllB' <- atomically $ swapTVar qSubAllB 0
-          qSubAuth' <- atomically $ swapTVar qSubAuth 0
-          qSubDuplicate' <- atomically $ swapTVar qSubDuplicate 0
-          qSubProhibited' <- atomically $ swapTVar qSubProhibited 0
-          qSubEnd' <- atomically $ swapTVar qSubEnd 0
-          qSubEndB' <- atomically $ swapTVar qSubEndB 0
-          ntfCreated' <- atomically $ swapTVar ntfCreated 0
-          ntfDeleted' <- atomically $ swapTVar ntfDeleted 0
-          ntfDeletedB' <- atomically $ swapTVar ntfDeletedB 0
-          ntfSub' <- atomically $ swapTVar ntfSub 0
-          ntfSubB' <- atomically $ swapTVar ntfSubB 0
-          ntfSubAuth' <- atomically $ swapTVar ntfSubAuth 0
-          ntfSubDuplicate' <- atomically $ swapTVar ntfSubDuplicate 0
-          msgSent' <- atomically $ swapTVar msgSent 0
-          msgSentAuth' <- atomically $ swapTVar msgSentAuth 0
-          msgSentQuota' <- atomically $ swapTVar msgSentQuota 0
-          msgSentLarge' <- atomically $ swapTVar msgSentLarge 0
-          msgRecv' <- atomically $ swapTVar msgRecv 0
-          msgRecvGet' <- atomically $ swapTVar msgRecvGet 0
-          msgGet' <- atomically $ swapTVar msgGet 0
-          msgGetNoMsg' <- atomically $ swapTVar msgGetNoMsg 0
-          msgGetAuth' <- atomically $ swapTVar msgGetAuth 0
-          msgGetDuplicate' <- atomically $ swapTVar msgGetDuplicate 0
-          msgGetProhibited' <- atomically $ swapTVar msgGetProhibited 0
-          msgExpired' <- atomically $ swapTVar msgExpired 0
-          ps <- atomically $ periodStatCounts activeQueues ts
-          msgSentNtf' <- atomically $ swapTVar msgSentNtf 0
-          msgRecvNtf' <- atomically $ swapTVar msgRecvNtf 0
-          psNtf <- atomically $ periodStatCounts activeQueuesNtf ts
-          msgNtfs' <- atomically $ swapTVar (msgNtfs ss) 0
-          msgNtfNoSub' <- atomically $ swapTVar (msgNtfNoSub ss) 0
-          msgNtfLost' <- atomically $ swapTVar (msgNtfLost ss) 0
-          pRelays' <- atomically $ getResetProxyStatsData pRelays
-          pRelaysOwn' <- atomically $ getResetProxyStatsData pRelaysOwn
-          pMsgFwds' <- atomically $ getResetProxyStatsData pMsgFwds
-          pMsgFwdsOwn' <- atomically $ getResetProxyStatsData pMsgFwdsOwn
-          pMsgFwdsRecv' <- atomically $ swapTVar pMsgFwdsRecv 0
-          qCount' <- readTVarIO qCount
+          fromTime' <- atomicSwapIORef fromTime ts
+          qCreated' <- atomicSwapIORef qCreated 0
+          qSecured' <- atomicSwapIORef qSecured 0
+          qDeletedAll' <- atomicSwapIORef qDeletedAll 0
+          qDeletedAllB' <- atomicSwapIORef qDeletedAllB 0
+          qDeletedNew' <- atomicSwapIORef qDeletedNew 0
+          qDeletedSecured' <- atomicSwapIORef qDeletedSecured 0
+          qSub' <- atomicSwapIORef qSub 0
+          qSubAllB' <- atomicSwapIORef qSubAllB 0
+          qSubAuth' <- atomicSwapIORef qSubAuth 0
+          qSubDuplicate' <- atomicSwapIORef qSubDuplicate 0
+          qSubProhibited' <- atomicSwapIORef qSubProhibited 0
+          qSubEnd' <- atomicSwapIORef qSubEnd 0
+          qSubEndB' <- atomicSwapIORef qSubEndB 0
+          ntfCreated' <- atomicSwapIORef ntfCreated 0
+          ntfDeleted' <- atomicSwapIORef ntfDeleted 0
+          ntfDeletedB' <- atomicSwapIORef ntfDeletedB 0
+          ntfSub' <- atomicSwapIORef ntfSub 0
+          ntfSubB' <- atomicSwapIORef ntfSubB 0
+          ntfSubAuth' <- atomicSwapIORef ntfSubAuth 0
+          ntfSubDuplicate' <- atomicSwapIORef ntfSubDuplicate 0
+          msgSent' <- atomicSwapIORef msgSent 0
+          msgSentAuth' <- atomicSwapIORef msgSentAuth 0
+          msgSentQuota' <- atomicSwapIORef msgSentQuota 0
+          msgSentLarge' <- atomicSwapIORef msgSentLarge 0
+          msgRecv' <- atomicSwapIORef msgRecv 0
+          msgRecvGet' <- atomicSwapIORef msgRecvGet 0
+          msgGet' <- atomicSwapIORef msgGet 0
+          msgGetNoMsg' <- atomicSwapIORef msgGetNoMsg 0
+          msgGetAuth' <- atomicSwapIORef msgGetAuth 0
+          msgGetDuplicate' <- atomicSwapIORef msgGetDuplicate 0
+          msgGetProhibited' <- atomicSwapIORef msgGetProhibited 0
+          msgExpired' <- atomicSwapIORef msgExpired 0
+          ps <- liftIO $ periodStatCounts activeQueues ts
+          msgSentNtf' <- atomicSwapIORef msgSentNtf 0
+          msgRecvNtf' <- atomicSwapIORef msgRecvNtf 0
+          psNtf <- liftIO $ periodStatCounts activeQueuesNtf ts
+          msgNtfs' <- atomicSwapIORef (msgNtfs ss) 0
+          msgNtfNoSub' <- atomicSwapIORef (msgNtfNoSub ss) 0
+          msgNtfLost' <- atomicSwapIORef (msgNtfLost ss) 0
+          pRelays' <- getResetProxyStatsData pRelays
+          pRelaysOwn' <- getResetProxyStatsData pRelaysOwn
+          pMsgFwds' <- getResetProxyStatsData pMsgFwds
+          pMsgFwdsOwn' <- getResetProxyStatsData pMsgFwdsOwn
+          pMsgFwdsRecv' <- atomicSwapIORef pMsgFwdsRecv 0
+          qCount' <- readIORef qCount
           qCount'' <- M.size <$> readTVarIO queues
           ntfCount' <- M.size <$> readTVarIO notifiers
-          msgCount' <- readTVarIO msgCount
+          msgCount' <- readIORef msgCount
           hPutStrLn h $
             intercalate
               ","
@@ -452,9 +458,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                   hPutStrLn h . B.unpack $ B.intercalate "," [bshow cid, encode sessionId, connected', strEncode createdAt, rcvActiveAt', sndActiveAt', bshow age, subscriptions']
               CPStats -> withUserRole $ do
                 ss <- unliftIO u $ asks serverStats
-                let getStat :: (ServerStats -> TVar a) -> IO a
-                    getStat var = readTVarIO (var ss)
-                    putStat :: Show a => String -> (ServerStats -> TVar a) -> IO ()
+                let getStat :: (ServerStats -> IORef a) -> IO a
+                    getStat var = readIORef (var ss)
+                    putStat :: Show a => String -> (ServerStats -> IORef a) -> IO ()
                     putStat label var = getStat var >>= \v -> hPutStrLn h $ label <> ": " <> show v
                     putProxyStat :: String -> (ServerStats -> ProxyStats) -> IO ()
                     putProxyStat label var = do
@@ -968,7 +974,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             signal = atomically $ modifyTVar' procThreads (\t -> t - 1)
     transportErr :: TransportError -> ErrorType
     transportErr = PROXY . BROKER . TRANSPORT
-    mkIncProxyStats :: MonadIO m => ProxyStats -> ProxyStats -> OwnServer -> (ProxyStats -> TVar Int) -> m ()
+    mkIncProxyStats :: MonadIO m => ProxyStats -> ProxyStats -> OwnServer -> (ProxyStats -> IORef Int) -> m ()
     mkIncProxyStats ps psOwn own sel = do
       incStat $ sel ps
       when own $ incStat $ sel psOwn
@@ -1216,11 +1222,11 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 stats <- asks serverStats
                 incStat $ msgRecv stats
                 when isGet $ incStat $ msgRecvGet stats
-                atomically $ modifyTVar' (msgCount stats) (subtract 1)
-                atomically $ updatePeriodStats (activeQueues stats) entId
+                liftIO $ atomicModifyIORef'_ (msgCount stats) (subtract 1)
+                liftIO $ updatePeriodStats (activeQueues stats) entId
                 when (notification msgFlags) $ do
                   incStat $ msgRecvNtf stats
-                  atomically $ updatePeriodStats (activeQueuesNtf stats) entId
+                  liftIO $ updatePeriodStats (activeQueuesNtf stats) entId
 
         sendMessage :: QueueRec -> MsgFlags -> MsgBody -> M (Transmission BrokerMsg)
         sendMessage qr msgFlags msgBody
@@ -1259,10 +1265,10 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                                   logWarn "Dropped message notification"
                                 Just True -> incStat $ msgNtfs stats
                             incStat $ msgSentNtf stats
-                            atomically $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
+                            liftIO $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
                           incStat $ msgSent stats
                           incStat $ msgCount stats
-                          atomically $ updatePeriodStats (activeQueues stats) (recipientId qr)
+                          liftIO $ updatePeriodStats (activeQueues stats) (recipientId qr)
                           pure ok
           where
             THandleParams {thVersion} = thParams'
@@ -1279,7 +1285,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
               deleted <- atomically $ sum <$> mapM (deleteExpiredMsgs q) old
               when (deleted > 0) $ do
                 stats <- asks serverStats
-                atomically $ modifyTVar' (msgExpired stats) (+ deleted)
+                liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
 
             -- The condition for delivery of the message is:
             -- - the queue was empty when the message was sent,
@@ -1490,8 +1496,8 @@ updateDeletedStats q = do
   incStat $ qDeletedAll stats
   incStat $ qCount stats
 
-incStat :: MonadIO m => TVar Int -> m ()
-incStat v = atomically $ modifyTVar' v (+ 1)
+incStat :: MonadIO m => IORef Int -> m ()
+incStat r = liftIO $ atomicModifyIORef'_ r (+ 1)
 {-# INLINE incStat #-}
 
 withLog :: (StoreLog 'WriteMode -> IO a) -> M ()
@@ -1590,7 +1596,7 @@ restoreServerStats expiredWhileRestoring = asks (serverStatsBackupFile . config)
           s <- asks serverStats
           _qCount <- fmap M.size . readTVarIO . queues =<< asks queueStore
           _msgCount <- foldM (\(!n) q -> (n +) <$> readTVarIO (size q)) 0 =<< readTVarIO =<< asks msgStore
-          atomically $ setServerStats s d {_qCount, _msgCount, _msgExpired = _msgExpired d + expiredWhileRestoring}
+          liftIO $ setServerStats s d {_qCount, _msgCount, _msgExpired = _msgExpired d + expiredWhileRestoring}
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
           when (_qCount /= statsQCount) $ logWarn $ "Queue count differs: stats: " <> tshow statsQCount <> ", store: " <> tshow _qCount
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index ce89fd633..49b6f61ed 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -12,6 +12,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
+import Data.IORef
 import Data.Int (Int64)
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IM
@@ -140,7 +141,8 @@ data Server = Server
     subscribers :: TMap RecipientId Client,
     ntfSubscribedQ :: TQueue (NotifierId, Client, Subscribed),
     notifiers :: TMap NotifierId Client,
-    pendingENDs :: TVar (IntMap (NonEmpty QueueId)),
+    pendingENDs :: IORef (IntMap (NonEmpty RecipientId)),
+    pendingNtfENDs :: IORef (IntMap (NonEmpty NotifierId)),
     savingLock :: Lock
   }
 
@@ -183,9 +185,10 @@ newServer = do
   subscribers <- TM.emptyIO
   ntfSubscribedQ <- newTQueueIO
   notifiers <- TM.emptyIO
-  pendingENDs <- newTVarIO IM.empty
+  pendingENDs <- newIORef IM.empty
+  pendingNtfENDs <- newIORef IM.empty
   savingLock <- atomically createLock
-  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, pendingENDs, savingLock}
+  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, pendingENDs, pendingNtfENDs, savingLock}
 
 newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
 newClient clientId qSize thVersion sessionId createdAt = do
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index 8afb1668a..60f55100e 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -11,65 +11,67 @@ module Simplex.Messaging.Server.Stats where
 import Control.Applicative (optional, (<|>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
+import Data.IORef
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Time.Calendar.Month (pattern MonthDay)
 import Data.Time.Calendar.OrdinalDate (mondayStartWeek)
 import Data.Time.Clock (UTCTime (..))
+import GHC.IORef (atomicSwapIORef)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (RecipientId)
-import UnliftIO.STM
+import Simplex.Messaging.Util (atomicModifyIORef'_, unlessM)
 
 data ServerStats = ServerStats
-  { fromTime :: TVar UTCTime,
-    qCreated :: TVar Int,
-    qSecured :: TVar Int,
-    qDeletedAll :: TVar Int,
-    qDeletedAllB :: TVar Int,
-    qDeletedNew :: TVar Int,
-    qDeletedSecured :: TVar Int,
-    qSub :: TVar Int, -- only includes subscriptions when there were pending messages
-    -- qSubNoMsg :: TVar Int, -- this stat creates too many STM transactions
-    qSubAllB :: TVar Int, -- count of all subscription batches (with and without pending messages)
-    qSubAuth :: TVar Int,
-    qSubDuplicate :: TVar Int,
-    qSubProhibited :: TVar Int,
-    qSubEnd :: TVar Int,
-    qSubEndB :: TVar Int,
-    ntfCreated :: TVar Int,
-    ntfDeleted :: TVar Int,
-    ntfDeletedB :: TVar Int,
-    ntfSub :: TVar Int,
-    ntfSubB :: TVar Int,
-    ntfSubAuth :: TVar Int,
-    ntfSubDuplicate :: TVar Int,
-    msgSent :: TVar Int,
-    msgSentAuth :: TVar Int,
-    msgSentQuota :: TVar Int,
-    msgSentLarge :: TVar Int,
-    msgRecv :: TVar Int,
-    msgRecvGet :: TVar Int,
-    msgGet :: TVar Int,
-    msgGetNoMsg :: TVar Int,
-    msgGetAuth :: TVar Int,
-    msgGetDuplicate :: TVar Int,
-    msgGetProhibited :: TVar Int,
-    msgExpired :: TVar Int,
+  { fromTime :: IORef UTCTime,
+    qCreated :: IORef Int,
+    qSecured :: IORef Int,
+    qDeletedAll :: IORef Int,
+    qDeletedAllB :: IORef Int,
+    qDeletedNew :: IORef Int,
+    qDeletedSecured :: IORef Int,
+    qSub :: IORef Int, -- only includes subscriptions when there were pending messages
+    -- qSubNoMsg :: IORef Int, -- this stat creates too many STM transactions
+    qSubAllB :: IORef Int, -- count of all subscription batches (with and without pending messages)
+    qSubAuth :: IORef Int,
+    qSubDuplicate :: IORef Int,
+    qSubProhibited :: IORef Int,
+    qSubEnd :: IORef Int,
+    qSubEndB :: IORef Int,
+    ntfCreated :: IORef Int,
+    ntfDeleted :: IORef Int,
+    ntfDeletedB :: IORef Int,
+    ntfSub :: IORef Int,
+    ntfSubB :: IORef Int,
+    ntfSubAuth :: IORef Int,
+    ntfSubDuplicate :: IORef Int,
+    msgSent :: IORef Int,
+    msgSentAuth :: IORef Int,
+    msgSentQuota :: IORef Int,
+    msgSentLarge :: IORef Int,
+    msgRecv :: IORef Int,
+    msgRecvGet :: IORef Int,
+    msgGet :: IORef Int,
+    msgGetNoMsg :: IORef Int,
+    msgGetAuth :: IORef Int,
+    msgGetDuplicate :: IORef Int,
+    msgGetProhibited :: IORef Int,
+    msgExpired :: IORef Int,
     activeQueues :: PeriodStats RecipientId,
     -- subscribedQueues :: PeriodStats RecipientId, -- this stat uses too much memory
-    msgSentNtf :: TVar Int, -- sent messages with NTF flag
-    msgRecvNtf :: TVar Int, -- received messages with NTF flag
+    msgSentNtf :: IORef Int, -- sent messages with NTF flag
+    msgRecvNtf :: IORef Int, -- received messages with NTF flag
     activeQueuesNtf :: PeriodStats RecipientId,
-    msgNtfs :: TVar Int, -- messages notications delivered to NTF server (<= msgSentNtf)
-    msgNtfNoSub :: TVar Int, -- no subscriber to notifications (e.g., NTF server not connected)
-    msgNtfLost :: TVar Int, -- notification is lost because NTF delivery queue is full
+    msgNtfs :: IORef Int, -- messages notications delivered to NTF server (<= msgSentNtf)
+    msgNtfNoSub :: IORef Int, -- no subscriber to notifications (e.g., NTF server not connected)
+    msgNtfLost :: IORef Int, -- notification is lost because NTF delivery queue is full
     pRelays :: ProxyStats,
     pRelaysOwn :: ProxyStats,
     pMsgFwds :: ProxyStats,
     pMsgFwdsOwn :: ProxyStats,
-    pMsgFwdsRecv :: TVar Int,
-    qCount :: TVar Int,
-    msgCount :: TVar Int
+    pMsgFwdsRecv :: IORef Int,
+    qCount :: IORef Int,
+    msgCount :: IORef Int
   }
 
 data ServerStatsData = ServerStatsData
@@ -125,53 +127,53 @@ data ServerStatsData = ServerStatsData
 
 newServerStats :: UTCTime -> IO ServerStats
 newServerStats ts = do
-  fromTime <- newTVarIO ts
-  qCreated <- newTVarIO 0
-  qSecured <- newTVarIO 0
-  qDeletedAll <- newTVarIO 0
-  qDeletedAllB <- newTVarIO 0
-  qDeletedNew <- newTVarIO 0
-  qDeletedSecured <- newTVarIO 0
-  qSub <- newTVarIO 0
-  qSubAllB <- newTVarIO 0
-  qSubAuth <- newTVarIO 0
-  qSubDuplicate <- newTVarIO 0
-  qSubProhibited <- newTVarIO 0
-  qSubEnd <- newTVarIO 0
-  qSubEndB <- newTVarIO 0
-  ntfCreated <- newTVarIO 0
-  ntfDeleted <- newTVarIO 0
-  ntfDeletedB <- newTVarIO 0
-  ntfSub <- newTVarIO 0
-  ntfSubB <- newTVarIO 0
-  ntfSubAuth <- newTVarIO 0
-  ntfSubDuplicate <- newTVarIO 0
-  msgSent <- newTVarIO 0
-  msgSentAuth <- newTVarIO 0
-  msgSentQuota <- newTVarIO 0
-  msgSentLarge <- newTVarIO 0
-  msgRecv <- newTVarIO 0
-  msgRecvGet <- newTVarIO 0
-  msgGet <- newTVarIO 0
-  msgGetNoMsg <- newTVarIO 0
-  msgGetAuth <- newTVarIO 0
-  msgGetDuplicate <- newTVarIO 0
-  msgGetProhibited <- newTVarIO 0
-  msgExpired <- newTVarIO 0
+  fromTime <- newIORef ts
+  qCreated <- newIORef 0
+  qSecured <- newIORef 0
+  qDeletedAll <- newIORef 0
+  qDeletedAllB <- newIORef 0
+  qDeletedNew <- newIORef 0
+  qDeletedSecured <- newIORef 0
+  qSub <- newIORef 0
+  qSubAllB <- newIORef 0
+  qSubAuth <- newIORef 0
+  qSubDuplicate <- newIORef 0
+  qSubProhibited <- newIORef 0
+  qSubEnd <- newIORef 0
+  qSubEndB <- newIORef 0
+  ntfCreated <- newIORef 0
+  ntfDeleted <- newIORef 0
+  ntfDeletedB <- newIORef 0
+  ntfSub <- newIORef 0
+  ntfSubB <- newIORef 0
+  ntfSubAuth <- newIORef 0
+  ntfSubDuplicate <- newIORef 0
+  msgSent <- newIORef 0
+  msgSentAuth <- newIORef 0
+  msgSentQuota <- newIORef 0
+  msgSentLarge <- newIORef 0
+  msgRecv <- newIORef 0
+  msgRecvGet <- newIORef 0
+  msgGet <- newIORef 0
+  msgGetNoMsg <- newIORef 0
+  msgGetAuth <- newIORef 0
+  msgGetDuplicate <- newIORef 0
+  msgGetProhibited <- newIORef 0
+  msgExpired <- newIORef 0
   activeQueues <- newPeriodStats
-  msgSentNtf <- newTVarIO 0
-  msgRecvNtf <- newTVarIO 0
+  msgSentNtf <- newIORef 0
+  msgRecvNtf <- newIORef 0
   activeQueuesNtf <- newPeriodStats
-  msgNtfs <- newTVarIO 0
-  msgNtfNoSub <- newTVarIO 0
-  msgNtfLost <- newTVarIO 0
+  msgNtfs <- newIORef 0
+  msgNtfNoSub <- newIORef 0
+  msgNtfLost <- newIORef 0
   pRelays <- newProxyStats
   pRelaysOwn <- newProxyStats
   pMsgFwds <- newProxyStats
   pMsgFwdsOwn <- newProxyStats
-  pMsgFwdsRecv <- newTVarIO 0
-  qCount <- newTVarIO 0
-  msgCount <- newTVarIO 0
+  pMsgFwdsRecv <- newIORef 0
+  qCount <- newIORef 0
+  msgCount <- newIORef 0
   pure
     ServerStats
       { fromTime,
@@ -225,53 +227,53 @@ newServerStats ts = do
 
 getServerStatsData :: ServerStats -> IO ServerStatsData
 getServerStatsData s = do
-  _fromTime <- readTVarIO $ fromTime s
-  _qCreated <- readTVarIO $ qCreated s
-  _qSecured <- readTVarIO $ qSecured s
-  _qDeletedAll <- readTVarIO $ qDeletedAll s
-  _qDeletedAllB <- readTVarIO $ qDeletedAllB s
-  _qDeletedNew <- readTVarIO $ qDeletedNew s
-  _qDeletedSecured <- readTVarIO $ qDeletedSecured s
-  _qSub <- readTVarIO $ qSub s
-  _qSubAllB <- readTVarIO $ qSubAllB s
-  _qSubAuth <- readTVarIO $ qSubAuth s
-  _qSubDuplicate <- readTVarIO $ qSubDuplicate s
-  _qSubProhibited <- readTVarIO $ qSubProhibited s
-  _qSubEnd <- readTVarIO $ qSubEnd s
-  _qSubEndB <- readTVarIO $ qSubEndB s
-  _ntfCreated <- readTVarIO $ ntfCreated s
-  _ntfDeleted <- readTVarIO $ ntfDeleted s
-  _ntfDeletedB <- readTVarIO $ ntfDeletedB s
-  _ntfSub <- readTVarIO $ ntfSub s
-  _ntfSubB <- readTVarIO $ ntfSubB s
-  _ntfSubAuth <- readTVarIO $ ntfSubAuth s
-  _ntfSubDuplicate <- readTVarIO $ ntfSubDuplicate s
-  _msgSent <- readTVarIO $ msgSent s
-  _msgSentAuth <- readTVarIO $ msgSentAuth s
-  _msgSentQuota <- readTVarIO $ msgSentQuota s
-  _msgSentLarge <- readTVarIO $ msgSentLarge s
-  _msgRecv <- readTVarIO $ msgRecv s
-  _msgRecvGet <- readTVarIO $ msgRecvGet s
-  _msgGet <- readTVarIO $ msgGet s
-  _msgGetNoMsg <- readTVarIO $ msgGetNoMsg s
-  _msgGetAuth <- readTVarIO $ msgGetAuth s
-  _msgGetDuplicate <- readTVarIO $ msgGetDuplicate s
-  _msgGetProhibited <- readTVarIO $ msgGetProhibited s
-  _msgExpired <- readTVarIO $ msgExpired s
+  _fromTime <- readIORef $ fromTime s
+  _qCreated <- readIORef $ qCreated s
+  _qSecured <- readIORef $ qSecured s
+  _qDeletedAll <- readIORef $ qDeletedAll s
+  _qDeletedAllB <- readIORef $ qDeletedAllB s
+  _qDeletedNew <- readIORef $ qDeletedNew s
+  _qDeletedSecured <- readIORef $ qDeletedSecured s
+  _qSub <- readIORef $ qSub s
+  _qSubAllB <- readIORef $ qSubAllB s
+  _qSubAuth <- readIORef $ qSubAuth s
+  _qSubDuplicate <- readIORef $ qSubDuplicate s
+  _qSubProhibited <- readIORef $ qSubProhibited s
+  _qSubEnd <- readIORef $ qSubEnd s
+  _qSubEndB <- readIORef $ qSubEndB s
+  _ntfCreated <- readIORef $ ntfCreated s
+  _ntfDeleted <- readIORef $ ntfDeleted s
+  _ntfDeletedB <- readIORef $ ntfDeletedB s
+  _ntfSub <- readIORef $ ntfSub s
+  _ntfSubB <- readIORef $ ntfSubB s
+  _ntfSubAuth <- readIORef $ ntfSubAuth s
+  _ntfSubDuplicate <- readIORef $ ntfSubDuplicate s
+  _msgSent <- readIORef $ msgSent s
+  _msgSentAuth <- readIORef $ msgSentAuth s
+  _msgSentQuota <- readIORef $ msgSentQuota s
+  _msgSentLarge <- readIORef $ msgSentLarge s
+  _msgRecv <- readIORef $ msgRecv s
+  _msgRecvGet <- readIORef $ msgRecvGet s
+  _msgGet <- readIORef $ msgGet s
+  _msgGetNoMsg <- readIORef $ msgGetNoMsg s
+  _msgGetAuth <- readIORef $ msgGetAuth s
+  _msgGetDuplicate <- readIORef $ msgGetDuplicate s
+  _msgGetProhibited <- readIORef $ msgGetProhibited s
+  _msgExpired <- readIORef $ msgExpired s
   _activeQueues <- getPeriodStatsData $ activeQueues s
-  _msgSentNtf <- readTVarIO $ msgSentNtf s
-  _msgRecvNtf <- readTVarIO $ msgRecvNtf s
+  _msgSentNtf <- readIORef $ msgSentNtf s
+  _msgRecvNtf <- readIORef $ msgRecvNtf s
   _activeQueuesNtf <- getPeriodStatsData $ activeQueuesNtf s
-  _msgNtfs <- readTVarIO $ msgNtfs s
-  _msgNtfNoSub <- readTVarIO $ msgNtfNoSub s
-  _msgNtfLost <- readTVarIO $ msgNtfLost s
+  _msgNtfs <- readIORef $ msgNtfs s
+  _msgNtfNoSub <- readIORef $ msgNtfNoSub s
+  _msgNtfLost <- readIORef $ msgNtfLost s
   _pRelays <- getProxyStatsData $ pRelays s
   _pRelaysOwn <- getProxyStatsData $ pRelaysOwn s
   _pMsgFwds <- getProxyStatsData $ pMsgFwds s
   _pMsgFwdsOwn <- getProxyStatsData $ pMsgFwdsOwn s
-  _pMsgFwdsRecv <- readTVarIO $ pMsgFwdsRecv s
-  _qCount <- readTVarIO $ qCount s
-  _msgCount <- readTVarIO $ msgCount s
+  _pMsgFwdsRecv <- readIORef $ pMsgFwdsRecv s
+  _qCount <- readIORef $ qCount s
+  _msgCount <- readIORef $ msgCount s
   pure
     ServerStatsData
       { _fromTime,
@@ -323,55 +325,56 @@ getServerStatsData s = do
         _msgCount
       }
 
-setServerStats :: ServerStats -> ServerStatsData -> STM ()
+-- this function is not thread safe, it is used on server start only
+setServerStats :: ServerStats -> ServerStatsData -> IO ()
 setServerStats s d = do
-  writeTVar (fromTime s) $! _fromTime d
-  writeTVar (qCreated s) $! _qCreated d
-  writeTVar (qSecured s) $! _qSecured d
-  writeTVar (qDeletedAll s) $! _qDeletedAll d
-  writeTVar (qDeletedAllB s) $! _qDeletedAllB d
-  writeTVar (qDeletedNew s) $! _qDeletedNew d
-  writeTVar (qDeletedSecured s) $! _qDeletedSecured d
-  writeTVar (qSub s) $! _qSub d
-  writeTVar (qSubAllB s) $! _qSubAllB d
-  writeTVar (qSubAuth s) $! _qSubAuth d
-  writeTVar (qSubDuplicate s) $! _qSubDuplicate d
-  writeTVar (qSubProhibited s) $! _qSubProhibited d
-  writeTVar (qSubEnd s) $! _qSubEnd d
-  writeTVar (qSubEndB s) $! _qSubEndB d
-  writeTVar (ntfCreated s) $! _ntfCreated d
-  writeTVar (ntfDeleted s) $! _ntfDeleted d
-  writeTVar (ntfDeletedB s) $! _ntfDeletedB d
-  writeTVar (ntfSub s) $! _ntfSub d
-  writeTVar (ntfSubB s) $! _ntfSubB d
-  writeTVar (ntfSubAuth s) $! _ntfSubAuth d
-  writeTVar (ntfSubDuplicate s) $! _ntfSubDuplicate d
-  writeTVar (msgSent s) $! _msgSent d
-  writeTVar (msgSentAuth s) $! _msgSentAuth d
-  writeTVar (msgSentQuota s) $! _msgSentQuota d
-  writeTVar (msgSentLarge s) $! _msgSentLarge d
-  writeTVar (msgRecv s) $! _msgRecv d
-  writeTVar (msgRecvGet s) $! _msgRecvGet d
-  writeTVar (msgGet s) $! _msgGet d
-  writeTVar (msgGetNoMsg s) $! _msgGetNoMsg d
-  writeTVar (msgGetAuth s) $! _msgGetAuth d
-  writeTVar (msgGetDuplicate s) $! _msgGetDuplicate d
-  writeTVar (msgGetProhibited s) $! _msgGetProhibited d
-  writeTVar (msgExpired s) $! _msgExpired d
+  writeIORef (fromTime s) $! _fromTime d
+  writeIORef (qCreated s) $! _qCreated d
+  writeIORef (qSecured s) $! _qSecured d
+  writeIORef (qDeletedAll s) $! _qDeletedAll d
+  writeIORef (qDeletedAllB s) $! _qDeletedAllB d
+  writeIORef (qDeletedNew s) $! _qDeletedNew d
+  writeIORef (qDeletedSecured s) $! _qDeletedSecured d
+  writeIORef (qSub s) $! _qSub d
+  writeIORef (qSubAllB s) $! _qSubAllB d
+  writeIORef (qSubAuth s) $! _qSubAuth d
+  writeIORef (qSubDuplicate s) $! _qSubDuplicate d
+  writeIORef (qSubProhibited s) $! _qSubProhibited d
+  writeIORef (qSubEnd s) $! _qSubEnd d
+  writeIORef (qSubEndB s) $! _qSubEndB d
+  writeIORef (ntfCreated s) $! _ntfCreated d
+  writeIORef (ntfDeleted s) $! _ntfDeleted d
+  writeIORef (ntfDeletedB s) $! _ntfDeletedB d
+  writeIORef (ntfSub s) $! _ntfSub d
+  writeIORef (ntfSubB s) $! _ntfSubB d
+  writeIORef (ntfSubAuth s) $! _ntfSubAuth d
+  writeIORef (ntfSubDuplicate s) $! _ntfSubDuplicate d
+  writeIORef (msgSent s) $! _msgSent d
+  writeIORef (msgSentAuth s) $! _msgSentAuth d
+  writeIORef (msgSentQuota s) $! _msgSentQuota d
+  writeIORef (msgSentLarge s) $! _msgSentLarge d
+  writeIORef (msgRecv s) $! _msgRecv d
+  writeIORef (msgRecvGet s) $! _msgRecvGet d
+  writeIORef (msgGet s) $! _msgGet d
+  writeIORef (msgGetNoMsg s) $! _msgGetNoMsg d
+  writeIORef (msgGetAuth s) $! _msgGetAuth d
+  writeIORef (msgGetDuplicate s) $! _msgGetDuplicate d
+  writeIORef (msgGetProhibited s) $! _msgGetProhibited d
+  writeIORef (msgExpired s) $! _msgExpired d
   setPeriodStats (activeQueues s) (_activeQueues d)
-  writeTVar (msgSentNtf s) $! _msgSentNtf d
-  writeTVar (msgRecvNtf s) $! _msgRecvNtf d
+  writeIORef (msgSentNtf s) $! _msgSentNtf d
+  writeIORef (msgRecvNtf s) $! _msgRecvNtf d
   setPeriodStats (activeQueuesNtf s) (_activeQueuesNtf d)
-  writeTVar (msgNtfs s) $! _msgNtfs d
-  writeTVar (msgNtfNoSub s) $! _msgNtfNoSub d
-  writeTVar (msgNtfLost s) $! _msgNtfLost d
+  writeIORef (msgNtfs s) $! _msgNtfs d
+  writeIORef (msgNtfNoSub s) $! _msgNtfNoSub d
+  writeIORef (msgNtfLost s) $! _msgNtfLost d
   setProxyStats (pRelays s) $! _pRelays d
   setProxyStats (pRelaysOwn s) $! _pRelaysOwn d
   setProxyStats (pMsgFwds s) $! _pMsgFwds d
   setProxyStats (pMsgFwdsOwn s) $! _pMsgFwdsOwn d
-  writeTVar (pMsgFwdsRecv s) $! _pMsgFwdsRecv d
-  writeTVar (qCount s) $! _qCount d
-  writeTVar (msgCount s) $! _msgCount d
+  writeIORef (pMsgFwdsRecv s) $! _pMsgFwdsRecv d
+  writeIORef (qCount s) $! _qCount d
+  writeIORef (msgCount s) $! _msgCount d
 
 instance StrEncoding ServerStatsData where
   strEncode d =
@@ -550,16 +553,16 @@ instance StrEncoding ServerStatsData where
           _ -> pure newProxyStatsData
 
 data PeriodStats a = PeriodStats
-  { day :: TVar (Set a),
-    week :: TVar (Set a),
-    month :: TVar (Set a)
+  { day :: IORef (Set a),
+    week :: IORef (Set a),
+    month :: IORef (Set a)
   }
 
 newPeriodStats :: IO (PeriodStats a)
 newPeriodStats = do
-  day <- newTVarIO S.empty
-  week <- newTVarIO S.empty
-  month <- newTVarIO S.empty
+  day <- newIORef S.empty
+  week <- newIORef S.empty
+  month <- newIORef S.empty
   pure PeriodStats {day, week, month}
 
 data PeriodStatsData a = PeriodStatsData
@@ -574,16 +577,17 @@ newPeriodStatsData = PeriodStatsData {_day = S.empty, _week = S.empty, _month =
 
 getPeriodStatsData :: PeriodStats a -> IO (PeriodStatsData a)
 getPeriodStatsData s = do
-  _day <- readTVarIO $ day s
-  _week <- readTVarIO $ week s
-  _month <- readTVarIO $ month s
+  _day <- readIORef $ day s
+  _week <- readIORef $ week s
+  _month <- readIORef $ month s
   pure PeriodStatsData {_day, _week, _month}
 
-setPeriodStats :: PeriodStats a -> PeriodStatsData a -> STM ()
+-- this function is not thread safe, it is used on server start only
+setPeriodStats :: PeriodStats a -> PeriodStatsData a -> IO ()
 setPeriodStats s d = do
-  writeTVar (day s) $! _day d
-  writeTVar (week s) $! _week d
-  writeTVar (month s) $! _month d
+  writeIORef (day s) $! _day d
+  writeIORef (week s) $! _week d
+  writeIORef (month s) $! _month d
 
 instance (Ord a, StrEncoding a) => StrEncoding (PeriodStatsData a) where
   strEncode PeriodStatsData {_day, _week, _month} =
@@ -600,7 +604,7 @@ data PeriodStatCounts = PeriodStatCounts
     monthCount :: String
   }
 
-periodStatCounts :: forall a. PeriodStats a -> UTCTime -> STM PeriodStatCounts
+periodStatCounts :: forall a. PeriodStats a -> UTCTime -> IO PeriodStatCounts
 periodStatCounts ps ts = do
   let d = utctDay ts
       (_, wDay) = mondayStartWeek d
@@ -610,33 +614,33 @@ periodStatCounts ps ts = do
   monthCount <- periodCount mDay $ month ps
   pure PeriodStatCounts {dayCount, weekCount, monthCount}
   where
-    periodCount :: Int -> TVar (Set a) -> STM String
-    periodCount 1 pVar = show . S.size <$> swapTVar pVar S.empty
+    periodCount :: Int -> IORef (Set a) -> IO String
+    periodCount 1 ref = show . S.size <$> atomicSwapIORef ref S.empty
     periodCount _ _ = pure ""
 
-updatePeriodStats :: Ord a => PeriodStats a -> a -> STM ()
-updatePeriodStats stats pId = do
-  updatePeriod day
-  updatePeriod week
-  updatePeriod month
+updatePeriodStats :: Ord a => PeriodStats a -> a -> IO ()
+updatePeriodStats ps pId = do
+  updatePeriod $ day ps
+  updatePeriod $ week ps
+  updatePeriod $ month ps
   where
-    updatePeriod pSel = modifyTVar' (pSel stats) (S.insert pId)
+    updatePeriod ref = unlessM (S.member pId <$> readIORef ref) $ atomicModifyIORef'_ ref $ S.insert pId
 
 data ProxyStats = ProxyStats
-  { pRequests :: TVar Int,
-    pSuccesses :: TVar Int, -- includes destination server error responses that will be forwarded to the client
-    pErrorsConnect :: TVar Int,
-    pErrorsCompat :: TVar Int,
-    pErrorsOther :: TVar Int
+  { pRequests :: IORef Int,
+    pSuccesses :: IORef Int, -- includes destination server error responses that will be forwarded to the client
+    pErrorsConnect :: IORef Int,
+    pErrorsCompat :: IORef Int,
+    pErrorsOther :: IORef Int
   }
 
 newProxyStats :: IO ProxyStats
 newProxyStats = do
-  pRequests <- newTVarIO 0
-  pSuccesses <- newTVarIO 0
-  pErrorsConnect <- newTVarIO 0
-  pErrorsCompat <- newTVarIO 0
-  pErrorsOther <- newTVarIO 0
+  pRequests <- newIORef 0
+  pSuccesses <- newIORef 0
+  pErrorsConnect <- newIORef 0
+  pErrorsCompat <- newIORef 0
+  pErrorsOther <- newIORef 0
   pure ProxyStats {pRequests, pSuccesses, pErrorsConnect, pErrorsCompat, pErrorsOther}
 
 data ProxyStatsData = ProxyStatsData
@@ -653,29 +657,30 @@ newProxyStatsData = ProxyStatsData {_pRequests = 0, _pSuccesses = 0, _pErrorsCon
 
 getProxyStatsData :: ProxyStats -> IO ProxyStatsData
 getProxyStatsData s = do
-  _pRequests <- readTVarIO $ pRequests s
-  _pSuccesses <- readTVarIO $ pSuccesses s
-  _pErrorsConnect <- readTVarIO $ pErrorsConnect s
-  _pErrorsCompat <- readTVarIO $ pErrorsCompat s
-  _pErrorsOther <- readTVarIO $ pErrorsOther s
+  _pRequests <- readIORef $ pRequests s
+  _pSuccesses <- readIORef $ pSuccesses s
+  _pErrorsConnect <- readIORef $ pErrorsConnect s
+  _pErrorsCompat <- readIORef $ pErrorsCompat s
+  _pErrorsOther <- readIORef $ pErrorsOther s
   pure ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther}
 
-getResetProxyStatsData :: ProxyStats -> STM ProxyStatsData
+getResetProxyStatsData :: ProxyStats -> IO ProxyStatsData
 getResetProxyStatsData s = do
-  _pRequests <- swapTVar (pRequests s) 0
-  _pSuccesses <- swapTVar (pSuccesses s) 0
-  _pErrorsConnect <- swapTVar (pErrorsConnect s) 0
-  _pErrorsCompat <- swapTVar (pErrorsCompat s) 0
-  _pErrorsOther <- swapTVar (pErrorsOther s) 0
+  _pRequests <- atomicSwapIORef (pRequests s) 0
+  _pSuccesses <- atomicSwapIORef (pSuccesses s) 0
+  _pErrorsConnect <- atomicSwapIORef (pErrorsConnect s) 0
+  _pErrorsCompat <- atomicSwapIORef (pErrorsCompat s) 0
+  _pErrorsOther <- atomicSwapIORef (pErrorsOther s) 0
   pure ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther}
 
-setProxyStats :: ProxyStats -> ProxyStatsData -> STM ()
+-- this function is not thread safe, it is used on server start only
+setProxyStats :: ProxyStats -> ProxyStatsData -> IO ()
 setProxyStats s d = do
-  writeTVar (pRequests s) $! _pRequests d
-  writeTVar (pSuccesses s) $! _pSuccesses d
-  writeTVar (pErrorsConnect s) $! _pErrorsConnect d
-  writeTVar (pErrorsCompat s) $! _pErrorsCompat d
-  writeTVar (pErrorsOther s) $! _pErrorsOther d
+  writeIORef (pRequests s) $! _pRequests d
+  writeIORef (pSuccesses s) $! _pSuccesses d
+  writeIORef (pErrorsConnect s) $! _pErrorsConnect d
+  writeIORef (pErrorsCompat s) $! _pErrorsCompat d
+  writeIORef (pErrorsOther s) $! _pErrorsOther d
 
 instance StrEncoding ProxyStatsData where
   strEncode ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther} =
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index e46681ea7..9ab881e83 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -15,6 +15,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
+import Data.IORef
 import Data.List (groupBy, sortOn)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
@@ -23,7 +24,7 @@ import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
 import Data.Time (NominalDiffTime)
 import GHC.Conc (labelThread, myThreadId, threadDelay)
-import UnliftIO
+import UnliftIO hiding (atomicModifyIORef')
 import qualified UnliftIO.Exception as UE
 
 raceAny_ :: MonadUnliftIO m => [m a] -> m ()
@@ -174,6 +175,9 @@ diffToMilliseconds diff = truncate $ diff * 1000
 labelMyThread :: MonadIO m => String -> m ()
 labelMyThread label = liftIO $ myThreadId >>= (`labelThread` label)
 
+atomicModifyIORef'_ :: IORef a -> (a -> a) -> IO ()
+atomicModifyIORef'_ r f = atomicModifyIORef' r $ \v -> (f v, ())
+
 encodeJSON :: ToJSON a => a -> Text
 encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
 

From 655e7ad7d5f062983f2623d55167a4545dbf3369 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 30 Aug 2024 11:53:22 +0100
Subject: [PATCH 083/195] smp server: get message queue faster, avoiding STM
 contention if queue exists, split transaction for notification delivery
 (#1289)

* put DRG state to IORef, split STM transaction of sending notification (#1288)

* put DRG state to IORef, split STM transaction of sending notification

* remove comment

* remove comment

* add comment

* revert version

* smp server: get message queue faster, avoiding STM contention if queue exists

* IORef for counter

* Revert "put DRG state to IORef, split STM transaction of sending notification (#1288)"

This reverts commit 517933d1894c3ce3fbefb60572558a970f09afb6.

* version

* remove IORef

* split notification delivery transations

* revert version
---
 package.yaml                                 |  2 +-
 simplexmq.cabal                              |  2 +-
 src/Simplex/Messaging/Server.hs              | 87 ++++++++++----------
 src/Simplex/Messaging/Server/MsgStore/STM.hs | 15 +++-
 tests/ServerTests.hs                         |  2 +-
 5 files changed, 59 insertions(+), 49 deletions(-)

diff --git a/package.yaml b/package.yaml
index 1b30d0f2c..4e1390cb0 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.2.0
+version: 6.0.2
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 0e84119ac..59e674987 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.2.0
+version:        6.0.2
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index fb840fbb1..29b4e2138 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -44,7 +44,6 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Control.Monad.Trans.Except
-import Crypto.Random
 import Control.Monad.STM (retry)
 import Data.Bifunctor (first)
 import Data.ByteString.Base64 (encode)
@@ -247,7 +246,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
         old <- liftIO $ expireBeforeEpoch expCfg
         rIds <- M.keysSet <$> readTVarIO ms
         forM_ rIds $ \rId -> do
-          q <- atomically (getMsgQueue ms rId quota)
+          q <- liftIO $ getMsgQueue ms rId quota
           deleted <- atomically $ deleteExpiredMsgs q old
           liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
 
@@ -1255,15 +1254,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                         Just (msg, wasEmpty) -> time "SEND ok" $ do
                           when wasEmpty $ tryDeliverMessage msg
                           when (notification msgFlags) $ do
-                            forM_ (notifier qr) $ \ntf -> do
-                              asks random >>= atomically . trySendNotification ntf msg >>= \case
-                                Nothing -> do
-                                  incStat $ msgNtfNoSub stats
-                                  logWarn "No notification subscription"
-                                Just False -> do
-                                  incStat $ msgNtfLost stats
-                                  logWarn "Dropped message notification"
-                                Just True -> incStat $ msgNtfs stats
+                            mapM_ (`trySendNotification` msg) (notifier qr)
                             incStat $ msgSentNtf stats
                             liftIO $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
                           incStat $ msgSent stats
@@ -1335,23 +1326,35 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                               deliver q s
                               writeTVar st NoSub
 
-            trySendNotification :: NtfCreds -> Message -> TVar ChaChaDRG -> STM (Maybe Bool)
-            trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg ntfNonceDrg =
-              mapM (writeNtf notifierId msg rcvNtfDhSecret ntfNonceDrg) =<< TM.lookup notifierId notifiers
+            trySendNotification :: NtfCreds -> Message -> M ()
+            trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg = do
+              stats <- asks serverStats
+              liftIO (TM.lookupIO notifierId notifiers) >>= \case
+                Nothing -> do
+                  incStat $ msgNtfNoSub stats
+                  logWarn "No notification subscription"
+                Just ntfClnt -> do
+                  let updateStats True = incStat $ msgNtfs stats
+                      updateStats _ = do
+                        incStat $ msgNtfLost stats
+                        logWarn "Dropped message notification"
+                  writeNtf notifierId msg rcvNtfDhSecret ntfClnt >>= mapM_ updateStats
 
-            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> TVar ChaChaDRG -> Client -> STM Bool
-            writeNtf nId msg rcvNtfDhSecret ntfNonceDrg Client {sndQ = q} =
-              ifM (isFullTBQueue q) (pure False) (sendNtf $> True)
-              where
-                sendNtf = case msg of
-                  Message {msgId, msgTs} -> do
-                    (nmsgNonce, encNMsgMeta) <- mkMessageNotification msgId msgTs rcvNtfDhSecret ntfNonceDrg
-                    writeTBQueue q [(CorrId "", nId, NMSG nmsgNonce encNMsgMeta)]
-                  _ -> pure ()
+            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> Client -> M (Maybe Bool)
+            writeNtf nId msg rcvNtfDhSecret Client {sndQ = q} = case msg of
+              Message {msgId, msgTs} -> Just <$> do
+                (nmsgNonce, encNMsgMeta) <- mkMessageNotification msgId msgTs rcvNtfDhSecret
+                -- must be in one STM transaction to avoid the queue becoming full between the check and writing
+                atomically $
+                  ifM
+                    (isFullTBQueue q)
+                    (pure $ False)
+                    (True <$ writeTBQueue q [(CorrId "", nId, NMSG nmsgNonce encNMsgMeta)])
+              _ -> pure Nothing
 
-            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> TVar ChaChaDRG -> STM (C.CbNonce, EncNMsgMeta)
-            mkMessageNotification msgId msgTs rcvNtfDhSecret ntfNonceDrg = do
-              cbNonce <- C.randomCbNonce ntfNonceDrg
+            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> M (C.CbNonce, EncNMsgMeta)
+            mkMessageNotification msgId msgTs rcvNtfDhSecret = do
+              cbNonce <- atomically . C.randomCbNonce =<< asks random
               let msgMeta = NMsgMeta {msgId, msgTs}
                   encNMsgMeta = C.cbEncrypt rcvNtfDhSecret cbNonce (smpEncode msgMeta) 128
               pure . (cbNonce,) $ fromRight "" encNMsgMeta
@@ -1441,7 +1444,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
         getStoreMsgQueue name rId = time (name <> " getMsgQueue") $ do
           ms <- asks msgStore
           quota <- asks $ msgQueueQuota . config
-          atomically $ getMsgQueue ms rId quota
+          liftIO $ getMsgQueue ms rId quota
 
         delQueueAndMsgs :: QueueStore -> M (Transmission BrokerMsg)
         delQueueAndMsgs st = do
@@ -1459,24 +1462,23 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
 
         getQueueInfo :: QueueRec -> M (Transmission BrokerMsg)
         getQueueInfo QueueRec {senderKey, notifier} = do
-          q@MsgQueue {size} <- getStoreMsgQueue "getQueueInfo" entId
-          info <- atomically $ do
-            qiSub <- TM.lookup entId subscriptions >>= mapM mkQSub
-            qiSize <- readTVar size
-            qiMsg <- toMsgInfo <$$> tryPeekMsg q
-            pure QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
+          q <- getStoreMsgQueue "getQueueInfo" entId
+          qiSub <- liftIO $ TM.lookupIO entId subscriptions >>= mapM mkQSub
+          qiSize <- liftIO $ getQueueSize q
+          qiMsg <- atomically $ toMsgInfo <$$> tryPeekMsg q
+          let info = QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
           pure (corrId, entId, INFO info)
           where
             mkQSub Sub {subThread, delivered} = do
               qSubThread <- case subThread of
                 ServerSub t -> do
-                  st <- readTVar t
+                  st <- readTVarIO t
                   pure $ case st of
                     NoSub -> QNoSub
                     SubPending -> QSubPending
                     SubThread _ -> QSubThread
                 ProhibitSub -> pure QProhibitSub
-              qDelivered <- decodeLatin1 . encode <$$> tryReadTMVar delivered
+              qDelivered <- atomically $ decodeLatin1 . encode <$$> tryReadTMVar delivered
               pure QSub {qSubThread, qDelivered}
 
         ok :: Transmission BrokerMsg
@@ -1564,13 +1566,12 @@ restoreServerMessages =
           where
             s = LB.toStrict s'
             addToMsgQueue rId msg = do
-              (isExpired, logFull) <- atomically $ do
-                q <- getMsgQueue ms rId quota
-                case msg of
-                  Message {msgTs}
-                    | maybe True (systemSeconds msgTs >=) old_ -> (False,) . isNothing <$> writeMsg q msg
-                    | otherwise -> pure (True, False)
-                  MessageQuota {} -> writeMsg q msg $> (False, False)
+              q <- liftIO $ getMsgQueue ms rId quota
+              (isExpired, logFull) <- atomically $ case msg of
+                Message {msgTs}
+                  | maybe True (systemSeconds msgTs >=) old_ -> (False,) . isNothing <$> writeMsg q msg
+                  | otherwise -> pure (True, False)
+                MessageQuota {} -> writeMsg q msg $> (False, False)
               when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
               pure $ if isExpired then expired + 1 else expired
             msgErr :: Show e => String -> e -> String
@@ -1595,7 +1596,7 @@ restoreServerStats expiredWhileRestoring = asks (serverStatsBackupFile . config)
         Right d@ServerStatsData {_qCount = statsQCount} -> do
           s <- asks serverStats
           _qCount <- fmap M.size . readTVarIO . queues =<< asks queueStore
-          _msgCount <- foldM (\(!n) q -> (n +) <$> readTVarIO (size q)) 0 =<< readTVarIO =<< asks msgStore
+          _msgCount <- liftIO . foldM (\(!n) q -> (n +) <$> getQueueSize q) 0 =<< readTVarIO =<< asks msgStore
           liftIO $ setServerStats s d {_qCount, _msgCount, _msgExpired = _msgExpired d + expiredWhileRestoring}
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index e0a5c8b45..04447292a 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -9,7 +9,7 @@
 
 module Simplex.Messaging.Server.MsgStore.STM
   ( STMMsgStore,
-    MsgQueue (..),
+    MsgQueue (msgQueue),
     newMsgStore,
     getMsgQueue,
     delMsgQueue,
@@ -20,6 +20,7 @@ module Simplex.Messaging.Server.MsgStore.STM
     tryDelMsg,
     tryDelPeekMsg,
     deleteExpiredMsgs,
+    getQueueSize,
   )
 where
 
@@ -44,9 +45,14 @@ type STMMsgStore = TMap RecipientId MsgQueue
 newMsgStore :: IO STMMsgStore
 newMsgStore = TM.emptyIO
 
-getMsgQueue :: STMMsgStore -> RecipientId -> Int -> STM MsgQueue
-getMsgQueue st rId quota = maybe newQ pure =<< TM.lookup rId st
+-- The reason for double lookup is that majority of messaging queues exist,
+-- because multiple messages are sent to the same queue,
+-- so the first lookup without STM transaction will return the queue faster.
+-- In case the queue does not exist, it needs to be looked-up again inside transaction.
+getMsgQueue :: STMMsgStore -> RecipientId -> Int -> IO MsgQueue
+getMsgQueue st rId quota = TM.lookupIO rId st >>= maybe (atomically maybeNewQ) pure
   where
+    maybeNewQ = TM.lookup rId st >>= maybe newQ pure
     newQ = do
       msgQueue <- newTQueue
       canWrite <- newTVar True
@@ -117,3 +123,6 @@ tryDeleteMsg MsgQueue {msgQueue = q, size} =
   tryReadTQueue q >>= \case
     Just _ -> modifyTVar' size (subtract 1)
     _ -> pure ()
+
+getQueueSize :: MsgQueue -> IO Int
+getQueueSize MsgQueue {size} = readTVarIO size
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 30521c8a8..a788af821 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -771,7 +771,7 @@ testTiming (ATransport t) =
         (C.AuthAlg C.SX25519, C.AuthAlg C.SX25519, 200) -- correct key type
       ]
     timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
-    similarTime t1 t2 = abs (t2 / t1 - 1) < 0.2 -- normally the difference between "no queue" and "wrong key" is less than 5%
+    similarTime t1 t2 = abs (t2 / t1 - 1) < 0.25 -- normally the difference between "no queue" and "wrong key" is less than 5%
     testSameTiming :: forall c. Transport c => THandleSMP c 'TClient -> THandleSMP c 'TClient -> (C.AuthAlg, C.AuthAlg, Int) -> Expectation
     testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, n) = do
       g <- C.newRandom

From ce6777b68d693810ee9d2a63bb2213a7c4596d1a Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 30 Aug 2024 12:50:02 +0100
Subject: [PATCH 084/195] newtype for server entity IDs, fix TRcvQueues (#1290)

* put DRG state to IORef, split STM transaction of sending notification (#1288)

* put DRG state to IORef, split STM transaction of sending notification

* remove comment

* remove comment

* add comment

* revert version

* newtype for server entity IDs, fix TRcvQueues

* Revert "put DRG state to IORef, split STM transaction of sending notification (#1288)"

This reverts commit 517933d1894c3ce3fbefb60572558a970f09afb6.

* logServer
---
 src/Simplex/FileTransfer/Agent.hs             |   4 +-
 src/Simplex/FileTransfer/Client.hs            |   5 +-
 src/Simplex/FileTransfer/Description.hs       |  13 +--
 src/Simplex/FileTransfer/Protocol.hs          |   7 +-
 src/Simplex/FileTransfer/Server.hs            |  13 +--
 src/Simplex/FileTransfer/Server/Control.hs    |   4 +-
 src/Simplex/FileTransfer/Types.hs             |   4 +-
 src/Simplex/Messaging/Agent.hs                |  28 ++---
 src/Simplex/Messaging/Agent/Client.hs         | 108 ++++++++++--------
 src/Simplex/Messaging/Agent/Protocol.hs       |   6 +-
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  11 ++
 src/Simplex/Messaging/Agent/TRcvQueues.hs     |   6 +-
 src/Simplex/Messaging/Client.hs               |  15 +--
 src/Simplex/Messaging/Encoding.hs             |   2 +
 src/Simplex/Messaging/Encoding/String.hs      |   6 +
 src/Simplex/Messaging/Notifications/Client.hs |   7 +-
 .../Messaging/Notifications/Protocol.hs       |   6 +-
 src/Simplex/Messaging/Notifications/Server.hs |   9 +-
 src/Simplex/Messaging/Protocol.hs             |  36 ++++--
 src/Simplex/Messaging/Server.hs               |  20 ++--
 src/Simplex/Messaging/Server/Control.hs       |   5 +-
 src/Simplex/Messaging/Transport.hs            |   1 -
 src/Simplex/Messaging/Util.hs                 |   2 +
 tests/AgentTests/ConnectionRequestTests.hs    |   4 +-
 tests/AgentTests/SQLiteTests.hs               |  26 ++---
 tests/CoreTests/BatchingTests.hs              |  10 +-
 tests/CoreTests/TRcvQueuesTests.hs            |  61 +++++-----
 tests/FileDescriptionTests.hs                 |   3 +-
 tests/NtfClient.hs                            |   2 +-
 tests/NtfServerTests.hs                       |   8 +-
 tests/SMPClient.hs                            |   2 +-
 tests/SMPProxyTests.hs                        |   6 +-
 tests/ServerTests.hs                          |  52 ++++-----
 tests/XFTPServerTests.hs                      |  15 +--
 34 files changed, 280 insertions(+), 227 deletions(-)

diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index d6ee75ae9..115ca6946 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -74,7 +74,7 @@ import qualified Simplex.Messaging.Crypto.File as CF
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String (strDecode, strEncode)
-import Simplex.Messaging.Protocol (EntityId, ProtocolServer, ProtocolType (..), XFTPServer)
+import Simplex.Messaging.Protocol (ProtocolServer, ProtocolType (..), XFTPServer)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (catchAll_, liftError, tshow, unlessM, whenM)
 import System.FilePath (takeFileName, (</>))
@@ -346,7 +346,7 @@ xftpDeleteRcvFiles' c rcvFileEntityIds = do
     batchFiles :: (DB.Connection -> DBRcvFileId -> IO a) -> [RcvFile] -> AM' [Either AgentErrorType a]
     batchFiles f rcvFiles = withStoreBatch' c $ \db -> map (\RcvFile {rcvFileId} -> f db rcvFileId) rcvFiles
 
-notify :: forall m e. (MonadIO m, AEntityI e) => AgentClient -> EntityId -> AEvent e -> m ()
+notify :: forall m e. (MonadIO m, AEntityI e) => AgentClient -> AEntityId -> AEvent e -> m ()
 notify c entId cmd = atomically $ writeTBQueue (subQ c) ("", entId, AEvt (sAEntity @e) cmd)
 
 xftpSendFile' :: AgentClient -> UserId -> CryptoFile -> Int -> AM SndFileId
diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs
index 1404fd434..33e927265 100644
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -50,6 +50,7 @@ import Simplex.Messaging.Protocol
     ProtocolServer (..),
     RecipientId,
     SenderId,
+    pattern NoEntity,
   )
 import Simplex.Messaging.Transport (ALPN, HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), supportedParameters)
 import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn)
@@ -222,7 +223,7 @@ createXFTPChunk ::
   Maybe BasicAuth ->
   ExceptT XFTPClientError IO (SenderId, NonEmpty RecipientId)
 createXFTPChunk c spKey file rcps auth_ =
-  sendXFTPCommand c spKey "" (FNEW file rcps auth_) Nothing >>= \case
+  sendXFTPCommand c spKey NoEntity (FNEW file rcps auth_) Nothing >>= \case
     (FRSndIds sId rIds, body) -> noFile body (sId, rIds)
     (r, _) -> throwE $ unexpectedResponse r
 
@@ -278,7 +279,7 @@ pingXFTP :: XFTPClient -> ExceptT XFTPClientError IO ()
 pingXFTP c@XFTPClient {thParams} = do
   t <-
     liftEither . first PCETransportError $
-      xftpEncodeTransmission thParams ("", "", FileCmd SFRecipient PING)
+      xftpEncodeTransmission thParams ("", NoEntity, FileCmd SFRecipient PING)
   (r, _) <- sendXFTPTransmission c t Nothing
   case r of
     FRPong -> pure ()
diff --git a/src/Simplex/FileTransfer/Description.hs b/src/Simplex/FileTransfer/Description.hs
index 8c27d80e7..8cb98fd32 100644
--- a/src/Simplex/FileTransfer/Description.hs
+++ b/src/Simplex/FileTransfer/Description.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -139,12 +141,9 @@ data FileChunkReplica = FileChunkReplica
   }
   deriving (Eq, Show)
 
-newtype ChunkReplicaId = ChunkReplicaId {unChunkReplicaId :: ByteString}
+newtype ChunkReplicaId = ChunkReplicaId {unChunkReplicaId :: XFTPFileId}
   deriving (Eq, Show)
-
-instance StrEncoding ChunkReplicaId where
-  strEncode (ChunkReplicaId fid) = strEncode fid
-  strP = ChunkReplicaId <$> strP
+  deriving newtype (StrEncoding)
 
 instance FromJSON ChunkReplicaId where
   parseJSON = strParseJSON "ChunkReplicaId"
@@ -153,10 +152,6 @@ instance ToJSON ChunkReplicaId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
-instance FromField ChunkReplicaId where fromField f = ChunkReplicaId <$> fromField f
-
-instance ToField ChunkReplicaId where toField (ChunkReplicaId s) = toField s
-
 data YAMLFileDescription = YAMLFileDescription
   { party :: FileParty,
     size :: String,
diff --git a/src/Simplex/FileTransfer/Protocol.hs b/src/Simplex/FileTransfer/Protocol.hs
index c55b327f8..5899f9c3e 100644
--- a/src/Simplex/FileTransfer/Protocol.hs
+++ b/src/Simplex/FileTransfer/Protocol.hs
@@ -41,6 +41,7 @@ import Simplex.Messaging.Protocol
     ProtocolType (..),
     RcvPublicAuthKey,
     RcvPublicDhKey,
+    EntityId (..),
     RecipientId,
     SenderId,
     SentRawTransmission,
@@ -170,7 +171,7 @@ data FileInfo = FileInfo
   }
   deriving (Show)
 
-type XFTPFileId = ByteString
+type XFTPFileId = EntityId
 
 instance FilePartyI p => ProtocolEncoding XFTPVersion XFTPErrorType (FileCommand p) where
   type Tag (FileCommand p) = FileCommandTag p
@@ -191,7 +192,7 @@ instance FilePartyI p => ProtocolEncoding XFTPVersion XFTPErrorType (FileCommand
   fromProtocolError = fromProtocolError @XFTPVersion @XFTPErrorType @FileResponse
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (auth, _, fileId, _) cmd = case cmd of
+  checkCredentials (auth, _, EntityId fileId, _) cmd = case cmd of
     -- FNEW must not have signature and chunk ID
     FNEW {}
       | isNothing auth -> Left $ CMD NO_AUTH
@@ -301,7 +302,7 @@ instance ProtocolEncoding XFTPVersion XFTPErrorType FileResponse where
     PEBlock -> BLOCK
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (_, _, entId, _) cmd = case cmd of
+  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
     FRSndIds {} -> noEntity
     -- ERR response does not always have entity ID
     FRErr _ -> Right cmd
diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index 00b320f68..a5a0d5d56 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -53,7 +54,7 @@ import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (CorrId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth)
+import Simplex.Messaging.Protocol (CorrId (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity)
 import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Stats
@@ -310,7 +311,7 @@ data ServerFile = ServerFile
 
 processRequest :: XFTPTransportRequest -> M ()
 processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHead}, sendResponse}
-  | B.length bodyHead /= xftpBlockSize = sendXFTPResponse ("", "", FRErr BLOCK) Nothing
+  | B.length bodyHead /= xftpBlockSize = sendXFTPResponse ("", NoEntity, FRErr BLOCK) Nothing
   | otherwise = do
       case xftpDecodeTransmission thParams bodyHead of
         Right (sig_, signed, (corrId, fId, cmdOrErr)) ->
@@ -323,7 +324,7 @@ processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHea
             Left e -> send (FRErr e) Nothing
           where
             send resp = sendXFTPResponse (corrId, fId, resp)
-        Left e -> sendXFTPResponse ("", "", FRErr e) Nothing
+        Left e -> sendXFTPResponse ("", NoEntity, FRErr e) Nothing
   where
     sendXFTPResponse (corrId, fId, resp) serverFile_ = do
       let t_ = xftpEncodeTransmission thParams (corrId, fId, resp)
@@ -464,7 +465,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
               \used -> let used' = used + fromIntegral size in if used' <= quota then (True, used') else (False, used)
           receive = do
             path <- asks $ filesPath . config
-            let fPath = path </> B.unpack (B64.encode senderId)
+            let fPath = path </> B.unpack (B64.encode $ unEntityId senderId)
             receiveChunk (XFTPRcvChunkSpec fPath size digest) >>= \case
               Right () -> do
                 stats <- asks serverStats
@@ -560,9 +561,7 @@ randomId :: Int -> M ByteString
 randomId n = atomically . C.randomBytes n =<< asks random
 
 getFileId :: M XFTPFileId
-getFileId = do
-  size <- asks (fileIdSize . config)
-  atomically . C.randomBytes size =<< asks random
+getFileId = fmap EntityId . randomId =<< asks (fileIdSize . config)
 
 withFileLog :: (StoreLog 'WriteMode -> IO a) -> M ()
 withFileLog action = liftIO . mapM_ action =<< asks storeLog
diff --git a/src/Simplex/FileTransfer/Server/Control.hs b/src/Simplex/FileTransfer/Server/Control.hs
index a8786170e..75e54e55a 100644
--- a/src/Simplex/FileTransfer/Server/Control.hs
+++ b/src/Simplex/FileTransfer/Server/Control.hs
@@ -4,7 +4,7 @@
 module Simplex.FileTransfer.Server.Control where
 
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString (ByteString)
+import Simplex.FileTransfer.Protocol (XFTPFileId)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth)
 
@@ -13,7 +13,7 @@ data CPClientRole = CPRNone | CPRUser | CPRAdmin
 data ControlProtocol
   = CPAuth BasicAuth
   | CPStatsRTS
-  | CPDelete ByteString
+  | CPDelete XFTPFileId
   | CPHelp
   | CPQuit
   | CPSkip
diff --git a/src/Simplex/FileTransfer/Types.hs b/src/Simplex/FileTransfer/Types.hs
index 15dc672da..8569bdd12 100644
--- a/src/Simplex/FileTransfer/Types.hs
+++ b/src/Simplex/FileTransfer/Types.hs
@@ -25,9 +25,9 @@ import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol (XFTPServer)
 import System.FilePath ((</>))
 
-type RcvFileId = ByteString
+type RcvFileId = ByteString -- Agent entity ID
 
-type SndFileId = ByteString
+type SndFileId = ByteString -- Agent entity ID
 
 authTagSize :: Int64
 authTagSize = fromIntegral C.authTagSize
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 755734fde..31a5e4c23 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -177,7 +177,7 @@ import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfReg
 import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..))
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
-import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), EntityId, ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, sndAuthKeySMPClientVersion)
+import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, sndAuthKeySMPClientVersion)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
@@ -891,7 +891,7 @@ joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo
   lift (compatibleContactUri cReqUri) >>= \case
     Just (qInfo, vrsn) -> do
       (connId', cReq) <- newConnSrv c userId connId hasNewConn enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv
-      void $ sendInvitation c userId qInfo vrsn cReq cInfo
+      void $ sendInvitation c userId connId' qInfo vrsn cReq cInfo
       pure (connId', False)
     Nothing -> throwE $ AGENT A_VERSION
 
@@ -2208,7 +2208,7 @@ cleanupManager c@AgentClient {subQ} = do
     deleteExpiredReplicasForDeletion = do
       rcvFilesTTL <- asks $ rcvFilesTTL . config
       withStore' c (`deleteDeletedSndChunkReplicasExpired` rcvFilesTTL)
-    notify :: forall e. AEntityI e => EntityId -> AEvent e -> AM ()
+    notify :: forall e. AEntityI e => AEntityId -> AEvent e -> AM ()
     notify entId cmd = atomically $ writeTBQueue subQ ("", entId, AEvt (sAEntity @e) cmd)
 
 data ACKd = ACKd | ACKPending
@@ -2345,7 +2345,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                               HELLO -> helloMsg srvMsgId msgMeta conn'' >> ackDel msgId
                               -- note that there is no ACK sent for A_MSG, it is sent with agent's user ACK command
                               A_MSG body -> do
-                                logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret srvMsgId
+                                logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret' srvMsgId
                                 notify $ MSG msgMeta msgFlags body
                                 pure ACKPending
                               A_RCVD rcpts -> qDuplex conn'' "RCVD" $ messagesRcvd rcpts msgMeta
@@ -2355,7 +2355,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                               QUSE qs -> qDuplexAckDel conn'' "QUSE" $ qUseMsg srvMsgId qs
                               -- no action needed for QTEST
                               -- any message in the new queue will mark it active and trigger deletion of the old queue
-                              QTEST _ -> logServer "<--" c srv rId ("MSG <QTEST>:" <> logSecret srvMsgId) >> ackDel msgId
+                              QTEST _ -> logServer "<--" c srv rId ("MSG <QTEST>:" <> logSecret' srvMsgId) >> ackDel msgId
                               EREADY _ -> qDuplexAckDel conn'' "EREADY" $ ereadyMsg rcPrev
                             where
                               qDuplexAckDel :: Connection c -> String -> (Connection 'CDuplex -> AM ()) -> AM ACKd
@@ -2378,7 +2378,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                                 | otherwise ->
                                     liftEither (parse smpP (AGENT A_MESSAGE) agentMsgBody) >>= \case
                                       AgentMessage _ (A_MSG body) -> do
-                                        logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret srvMsgId
+                                        logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret' srvMsgId
                                         notify $ MSG msgMeta msgFlags body
                                         pure ACKPending
                                       _ -> ack
@@ -2500,7 +2500,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
 
           smpConfirmation :: SMP.MsgId -> Connection c -> Maybe C.APublicAuthKey -> C.PublicKeyX25519 -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> ByteString -> VersionSMPC -> VersionSMPA -> AM ()
           smpConfirmation srvMsgId conn' senderKey e2ePubKey e2eEncryption encConnInfo smpClientVersion agentVersion = do
-            logServer "<--" c srv rId $ "MSG <CONF>:" <> logSecret srvMsgId
+            logServer "<--" c srv rId $ "MSG <CONF>:" <> logSecret' srvMsgId
             AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
             let ConnData {pqSupport} = toConnData conn'
             unless
@@ -2569,7 +2569,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
 
           helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM ()
           helloMsg srvMsgId MsgMeta {pqEncryption} conn' = do
-            logServer "<--" c srv rId $ "MSG <HELLO>:" <> logSecret srvMsgId
+            logServer "<--" c srv rId $ "MSG <HELLO>:" <> logSecret' srvMsgId
             case status of
               Active -> prohibited "hello: active"
               _ ->
@@ -2593,7 +2593,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
           continueSending srvMsgId addr (DuplexConnection _ _ sqs) =
             case findQ addr sqs of
               Just sq -> do
-                logServer "<--" c srv rId $ "MSG <QCONT>:" <> logSecret srvMsgId
+                logServer "<--" c srv rId $ "MSG <QCONT>:" <> logSecret' srvMsgId
                 atomically $
                   TM.lookup (qAddress sq) (smpDeliveryWorkers c)
                     >>= mapM_ (\(_, retryLock) -> tryPutTMVar retryLock ())
@@ -2602,7 +2602,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
 
           messagesRcvd :: NonEmpty AMessageReceipt -> MsgMeta -> Connection 'CDuplex -> AM ACKd
           messagesRcvd rcpts msgMeta@MsgMeta {broker = (srvMsgId, _)} _ = do
-            logServer "<--" c srv rId $ "MSG <RCPT>:" <> logSecret srvMsgId
+            logServer "<--" c srv rId $ "MSG <RCPT>:" <> logSecret' srvMsgId
             rs <- forM rcpts $ \rcpt -> clientReceipt rcpt `catchAgentError` \e -> notify (ERR e) $> Nothing
             case L.nonEmpty . catMaybes $ L.toList rs of
               Just rs' -> notify (RCVD msgMeta rs') $> ACKPending
@@ -2642,7 +2642,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                         sq2 <- withStore c $ \db -> do
                           liftIO $ mapM_ (deleteConnSndQueue db connId) delSqs
                           addConnSndQueue db connId (sq_ :: NewSndQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
-                        logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret srvMsgId <> " " <> logSecret (senderId queueAddress)
+                        logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret' srvMsgId <> " " <> logSecret (senderId queueAddress)
                         let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
                         void . enqueueMessages c cData' sqs SMP.noMsgFlags $ QKEY [(sqInfo', sndPublicKey)]
                         sq1 <- withStore' c $ \db -> setSndSwitchStatus db sq $ Just SSSendingQKEY
@@ -2663,7 +2663,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
               Just rq'@RcvQueue {rcvId, e2ePrivKey = dhPrivKey, smpClientVersion = cVer, status = status'}
                 | status' == New || status' == Confirmed -> do
                     checkRQSwchStatus rq RSSendingQADD
-                    logServer "<--" c srv rId $ "MSG <QKEY>:" <> logSecret srvMsgId <> " " <> logSecret senderId
+                    logServer "<--" c srv rId $ "MSG <QKEY>:" <> logSecret' srvMsgId <> " " <> logSecret senderId
                     let dhSecret = C.dh' dhPublicKey dhPrivKey
                     withStore' c $ \db -> setRcvQueueConfirmedE2E db rq' dhSecret $ min cVer cVer'
                     enqueueCommand c "" connId (Just smpServer) $ AInternalCommand $ ICQSecure rcvId senderKey
@@ -2684,7 +2684,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                 case find ((replaceQId ==) . dbQId) sqs of
                   Just sq1 -> do
                     checkSQSwchStatus sq1 SSSendingQKEY
-                    logServer "<--" c srv rId $ "MSG <QUSE>:" <> logSecret srvMsgId <> " " <> logSecret (snd addr)
+                    logServer "<--" c srv rId $ "MSG <QUSE>:" <> logSecret' srvMsgId <> " " <> logSecret (snd addr)
                     withStore' c $ \db -> setSndQueueStatus db sq' Secured
                     let sq'' = (sq' :: SndQueue) {status = Secured}
                     -- sending QTEST to the new queue only, the old one will be removed if sent successfully
@@ -2708,7 +2708,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
 
           smpInvitation :: SMP.MsgId -> Connection c -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM ()
           smpInvitation srvMsgId conn' connReq@(CRInvitationUri crData _) cInfo = do
-            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret srvMsgId
+            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' srvMsgId
             case conn' of
               ContactConnection {} -> do
                 -- show connection request even if invitaion via contact address is not compatible.
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 8f339cab7..9bd469ec5 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -12,6 +12,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}
@@ -82,6 +83,7 @@ module Simplex.Messaging.Agent.Client
     deleteQueues,
     logServer,
     logSecret,
+    logSecret',
     removeSubscription,
     hasActiveSubscription,
     hasPendingSubscription,
@@ -228,7 +230,7 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parse, sumT
 import Simplex.Messaging.Protocol
   ( AProtocolType (..),
     BrokerMsg,
-    EntityId,
+    EntityId (..),
     ErrorType,
     MsgFlags (..),
     MsgId,
@@ -241,7 +243,6 @@ import Simplex.Messaging.Protocol
     ProtocolServer (..),
     ProtocolType (..),
     ProtocolTypeI (..),
-    QueueId,
     QueueIdsKeys (..),
     RcvMessage (..),
     RcvNtfPublicDhKey,
@@ -255,6 +256,7 @@ import Simplex.Messaging.Protocol
     VersionSMPC,
     XFTPServer,
     XFTPServerWithAuth,
+    pattern NoEntity,
     sameSrvAddr',
   )
 import qualified Simplex.Messaging.Protocol as SMP
@@ -996,7 +998,7 @@ withClient_ c tSess@(_, srv, _) action = do
   where
     logServerError :: AgentErrorType -> AM a
     logServerError e = do
-      logServer "<--" c srv "" $ bshow e
+      logServer "<--" c srv NoEntity $ bshow e
       throwE e
 
 withProxySession :: AgentClient -> Maybe SMPServerWithAuth -> SMPTransportSession -> SMP.SenderId -> ByteString -> ((SMPConnectedClient, ProxiedRelay) -> AM a) -> AM a
@@ -1013,32 +1015,32 @@ withProxySession c proxySrv_ destSess@(_, destSrv, _) entId cmdStr action = do
     proxySrv = showServer . protocolClientServer' . protocolClient
     logServerError :: SMPConnectedClient -> AgentErrorType -> AM a
     logServerError cl e = do
-      logServer ("<-- " <> proxySrv cl <> " <") c destSrv "" $ bshow e
+      logServer ("<-- " <> proxySrv cl <> " <") c destSrv NoEntity $ bshow e
       throwE e
 
-withLogClient_ :: ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> EntityId -> ByteString -> (Client msg -> AM a) -> AM a
+withLogClient_ :: ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> ByteString -> ByteString -> (Client msg -> AM a) -> AM a
 withLogClient_ c tSess@(_, srv, _) entId cmdStr action = do
-  logServer "-->" c srv entId cmdStr
+  logServer' "-->" c srv entId cmdStr
   res <- withClient_ c tSess action
-  logServer "<--" c srv entId "OK"
+  logServer' "<--" c srv entId "OK"
   return res
 
 withClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
 withClient c tSess action = withClient_ c tSess $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer $ protocolClient client) $ action client
 {-# INLINE withClient #-}
 
-withLogClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> EntityId -> ByteString -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
+withLogClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> ByteString -> ByteString -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
 withLogClient c tSess entId cmdStr action = withLogClient_ c tSess entId cmdStr $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer $ protocolClient client) $ action client
 {-# INLINE withLogClient #-}
 
 withSMPClient :: SMPQueueRec q => AgentClient -> q -> ByteString -> (SMPClient -> ExceptT SMPClientError IO a) -> AM a
 withSMPClient c q cmdStr action = do
   tSess <- mkSMPTransportSession c q
-  withLogClient c tSess (queueId q) cmdStr $ action . connectedClient
+  withLogClient c tSess (unEntityId $ queueId q) cmdStr $ action . connectedClient
 
-sendOrProxySMPMessage :: AgentClient -> UserId -> SMPServer -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer)
-sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg =
-  sendOrProxySMPCommand c userId destSrv cmdStr senderId sendViaProxy sendDirectly
+sendOrProxySMPMessage :: AgentClient -> UserId -> SMPServer -> ConnId -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer)
+sendOrProxySMPMessage c userId destSrv connId cmdStr spKey_ senderId msgFlags msg =
+  sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendViaProxy sendDirectly
   where
     sendViaProxy smp proxySess = do
       atomically $ incSMPServerStat c userId destSrv sentViaProxyAttempts
@@ -1052,14 +1054,15 @@ sendOrProxySMPCommand ::
   AgentClient ->
   UserId ->
   SMPServer ->
+  ConnId ->
   ByteString ->
   SMP.SenderId ->
   (SMPClient -> ProxiedRelay -> ExceptT SMPClientError IO (Either ProxyClientError ())) ->
   (SMPClient -> ExceptT SMPClientError IO ()) ->
   AM (Maybe SMPServer)
-sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
-  sess <- mkTransportSession c userId destSrv senderId
-  ifM shouldUseProxy (sendViaProxy Nothing sess) (sendDirectly sess $> Nothing)
+sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
+  tSess <- mkTransportSession c userId destSrv connId
+  ifM shouldUseProxy (sendViaProxy Nothing tSess) (sendDirectly tSess $> Nothing)
   where
     shouldUseProxy = do
       cfg <- getNetworkConfig c
@@ -1078,7 +1081,7 @@ sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDi
         SPFProhibit -> False
     unknownServer = liftIO $ maybe True (notElem destSrv . knownSrvs) <$> TM.lookupIO userId (smpServers c)
     sendViaProxy :: Maybe SMPServerWithAuth -> SMPTransportSession -> AM (Maybe SMPServer)
-    sendViaProxy proxySrv_ destSess@(_, _, qId) = do
+    sendViaProxy proxySrv_ destSess@(_, _, connId_) = do
       r <- tryAgentError . withProxySession c proxySrv_ destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess@ProxiedRelay {prBasicAuth}) -> do
         r' <- liftClient SMP (clientServer smp) $ sendCmdViaProxy smp proxySess
         let proxySrv = protocolClientServer' smp
@@ -1105,7 +1108,7 @@ sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDi
               -- checks that the current proxied relay session is the same one that was used to send the message and removes it
               deleteRelaySession =
                 ( TM.lookup destSess (smpProxiedRelays c)
-                    $>>= \(ProtoServerWithAuth srv _) -> tryReadSessVar (userId, srv, qId) (smpClients c)
+                    $>>= \(ProtoServerWithAuth srv _) -> tryReadSessVar (userId, srv, connId_) (smpClients c)
                 )
                   >>= \case
                     Just (Right (SMPConnectedClient smp' prs))
@@ -1125,7 +1128,7 @@ sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDi
           | serverHostError e -> ifM directAllowed (sendDirectly destSess $> Nothing) (throwE e)
           | otherwise -> throwE e
     sendDirectly tSess =
-      withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
+      withLogClient_ c tSess (unEntityId senderId) ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
         r <- tryAgentError $ liftClient SMP (clientServer smp) $ sendCmdDirectly smp
         case r of
           Right () -> atomically $ incSMPServerStat c userId destSrv sentDirect
@@ -1138,18 +1141,18 @@ ipAddressProtected NetworkConfig {socksProxy, hostMode} (ProtocolServer _ hosts
     isOnionHost = \case THOnionHost _ -> True; _ -> False
 
 withNtfClient :: AgentClient -> NtfServer -> EntityId -> ByteString -> (NtfClient -> ExceptT NtfClientError IO a) -> AM a
-withNtfClient c srv = withLogClient c (0, srv, Nothing)
+withNtfClient c srv (EntityId entId) = withLogClient c (0, srv, Nothing) entId
 
 withXFTPClient ::
   ProtocolServerClient v err msg =>
   AgentClient ->
-  (UserId, ProtoServer msg, EntityId) ->
+  (UserId, ProtoServer msg, ByteString) ->
   ByteString ->
   (Client msg -> ExceptT (ProtocolClientError err) IO b) ->
   AM b
-withXFTPClient c (userId, srv, entityId) cmdStr action = do
-  tSess <- mkTransportSession c userId srv entityId
-  withLogClient c tSess entityId cmdStr action
+withXFTPClient c (userId, srv, sessEntId) cmdStr action = do
+  tSess <- mkTransportSession c userId srv sessEntId
+  withLogClient c tSess sessEntId cmdStr action
 
 liftClient :: (Show err, Encoding err) => (HostName -> err -> AgentErrorType) -> HostName -> ExceptT (ProtocolClientError err) IO a -> AM a
 liftClient protocolError_ = liftError . protocolClientError protocolError_
@@ -1291,12 +1294,12 @@ getXFTPWorkPath = do
   workDir <- readTVarIO =<< asks (xftpWorkDir . xftpAgent)
   maybe getTemporaryDirectory pure workDir
 
-mkTransportSession :: MonadIO m => AgentClient -> UserId -> ProtoServer msg -> EntityId -> m (TransportSession msg)
-mkTransportSession c userId srv entityId = mkTSession userId srv entityId <$> getSessionMode c
+mkTransportSession :: MonadIO m => AgentClient -> UserId -> ProtoServer msg -> ByteString -> m (TransportSession msg)
+mkTransportSession c userId srv sessEntId = mkTSession userId srv sessEntId <$> getSessionMode c
 {-# INLINE mkTransportSession #-}
 
-mkTSession :: UserId -> ProtoServer msg -> EntityId -> TransportSessionMode -> TransportSession msg
-mkTSession userId srv entityId mode = (userId, srv, if mode == TSMEntity then Just entityId else Nothing)
+mkTSession :: UserId -> ProtoServer msg -> ByteString -> TransportSessionMode -> TransportSession msg
+mkTSession userId srv sessEntId mode = (userId, srv, if mode == TSMEntity then Just sessEntId else Nothing)
 {-# INLINE mkTSession #-}
 
 mkSMPTransportSession :: (SMPQueueRec q, MonadIO m) => AgentClient -> q -> m SMPTransportSession
@@ -1318,12 +1321,12 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode sender
   rKeys@(_, rcvPrivateKey) <- atomically $ C.generateAuthKeyPair a g
   (dhKey, privDhKey) <- atomically $ C.generateKeyPair g
   (e2eDhKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
-  logServer "-->" c srv "" "NEW"
+  logServer "-->" c srv NoEntity "NEW"
   tSess <- mkTransportSession c userId srv connId
   (sessId, QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}) <-
     withClient c tSess $ \(SMPConnectedClient smp _) ->
       (sessionId $ thParams smp,) <$> createSMPQueue smp rKeys dhKey auth subMode senderCanSecure
-  liftIO . logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
+  liftIO . logServer "<--" c srv NoEntity $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
   let rq =
         RcvQueue
           { userId,
@@ -1457,7 +1460,7 @@ sendTSessionBatches statCmd toRQ action c qs =
       tryAgentError' (getSMPServerClient c tSess) >>= \case
         Left e -> pure $ L.map ((,Left e) . toRQ) qs'
         Right (SMPConnectedClient smp _) -> liftIO $ do
-          logServer "-->" c srv (bshow (length qs') <> " queues") statCmd
+          logServer' "-->" c srv (bshow (length qs') <> " queues") statCmd
           L.map agentError <$> action smp qs'
           where
             agentError = second . first $ protocolClientError SMP $ clientServer smp
@@ -1511,32 +1514,39 @@ getSubscriptions :: AgentClient -> IO (Set ConnId)
 getSubscriptions = readTVarIO . subscrConns
 {-# INLINE getSubscriptions #-}
 
-logServer :: MonadIO m => ByteString -> AgentClient -> ProtocolServer s -> QueueId -> ByteString -> m ()
-logServer dir AgentClient {clientId} srv qId cmdStr =
-  logInfo . decodeUtf8 $ B.unwords ["A", "(" <> bshow clientId <> ")", dir, showServer srv, ":", logSecret qId, cmdStr]
+logServer :: MonadIO m => ByteString -> AgentClient -> ProtocolServer s -> EntityId -> ByteString -> m ()
+logServer dir c srv = logServer' dir c srv . unEntityId
 {-# INLINE logServer #-}
 
+logServer' :: MonadIO m => ByteString -> AgentClient -> ProtocolServer s -> ByteString -> ByteString -> m ()
+logServer' dir AgentClient {clientId} srv qStr cmdStr =
+  logInfo . decodeUtf8 $ B.unwords ["A", "(" <> bshow clientId <> ")", dir, showServer srv, ":", logSecret' qStr, cmdStr]
+
 showServer :: ProtocolServer s -> ByteString
 showServer ProtocolServer {host, port} =
   strEncode host <> B.pack (if null port then "" else ':' : port)
 {-# INLINE showServer #-}
 
-logSecret :: ByteString -> ByteString
-logSecret bs = B64.encode $ B.take 3 bs
+logSecret :: EntityId -> ByteString
+logSecret = logSecret' . unEntityId
 {-# INLINE logSecret #-}
 
+logSecret' :: ByteString -> ByteString
+logSecret' = B64.encode . B.take 3
+{-# INLINE logSecret' #-}
+
 sendConfirmation :: AgentClient -> SndQueue -> ByteString -> AM (Maybe SMPServer)
-sendConfirmation c sq@SndQueue {userId, server, sndId, sndSecure, sndPublicKey, sndPrivateKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = do
+sendConfirmation c sq@SndQueue {userId, server, connId, sndId, sndSecure, sndPublicKey, sndPrivateKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = do
   let (privHdr, spKey) = if sndSecure then (SMP.PHEmpty, Just sndPrivateKey) else (SMP.PHConfirmation sndPublicKey, Nothing)
       clientMsg = SMP.ClientMessage privHdr agentConfirmation
   msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
-  sendOrProxySMPMessage c userId server "<CONF>" spKey sndId (MsgFlags {notification = True}) msg
+  sendOrProxySMPMessage c userId server connId "<CONF>" spKey sndId (MsgFlags {notification = True}) msg
 sendConfirmation _ _ _ = throwE $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
 
-sendInvitation :: AgentClient -> UserId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM (Maybe SMPServer)
-sendInvitation c userId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) connReq connInfo = do
+sendInvitation :: AgentClient -> UserId -> ConnId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM (Maybe SMPServer)
+sendInvitation c userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) connReq connInfo = do
   msg <- mkInvitation
-  sendOrProxySMPMessage c userId smpServer "<INV>" Nothing senderId (MsgFlags {notification = True}) msg
+  sendOrProxySMPMessage c userId smpServer connId "<INV>" Nothing senderId (MsgFlags {notification = True}) msg
   where
     mkInvitation :: AM ByteString
     -- this is only encrypted with per-queue E2E, not with double ratchet
@@ -1572,8 +1582,8 @@ secureQueue c rq@RcvQueue {rcvId, rcvPrivateKey} senderKey =
     secureSMPQueue smp rcvPrivateKey rcvId senderKey
 
 secureSndQueue :: AgentClient -> SndQueue -> AM ()
-secureSndQueue c SndQueue {userId, server, sndId, sndPrivateKey, sndPublicKey} =
-  void $ sendOrProxySMPCommand c userId server "SKEY <key>" sndId secureViaProxy secureDirectly
+secureSndQueue c SndQueue {userId, connId, server, sndId, sndPrivateKey, sndPublicKey} =
+  void $ sendOrProxySMPCommand c userId server connId "SKEY <key>" sndId secureViaProxy secureDirectly
   where
     -- TODO track statistics
     secureViaProxy smp proxySess = proxySecureSndSMPQueue smp proxySess sndPrivateKey sndId sndPublicKey
@@ -1603,7 +1613,7 @@ disableQueuesNtfs = sendTSessionBatches "NDEL" id $ sendBatch disableSMPQueuesNt
 
 sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = do
-  withSMPClient c rq ("ACK:" <> logSecret msgId) $ \smp ->
+  withSMPClient c rq ("ACK:" <> logSecret' msgId) $ \smp ->
     ackSMPMessage smp rcvPrivateKey rcvId msgId
   atomically $ releaseGetLock c rq
 
@@ -1637,10 +1647,10 @@ deleteQueues c = sendTSessionBatches "DEL" id deleteQueues_ c
       pure rs
 
 sendAgentMessage :: AgentClient -> SndQueue -> MsgFlags -> ByteString -> AM (Maybe SMPServer)
-sendAgentMessage c sq@SndQueue {userId, server, sndId, sndPrivateKey} msgFlags agentMsg = do
+sendAgentMessage c sq@SndQueue {userId, server, connId, sndId, sndPrivateKey} msgFlags agentMsg = do
   let clientMsg = SMP.ClientMessage SMP.PHEmpty agentMsg
   msg <- agentCbEncrypt sq Nothing $ smpEncode clientMsg
-  sendOrProxySMPMessage c userId server "<MSG>" (Just sndPrivateKey) sndId msgFlags msg
+  sendOrProxySMPMessage c userId server connId "<MSG>" (Just sndPrivateKey) sndId msgFlags msg
 
 data ServerQueueInfo = ServerQueueInfo
   { server :: SMPServer,
@@ -1659,7 +1669,7 @@ getQueueInfo c rq@RcvQueue {server, rcvId, rcvPrivateKey, sndId, status, clientN
     let ntfId = enc . (\ClientNtfCreds {notifierId} -> notifierId) <$> clientNtfCreds
     pure ServerQueueInfo {server, rcvId = enc rcvId, sndId = enc sndId, ntfId, status = serializeQueueStatus status, info}
   where
-    enc = decodeLatin1 . B64.encode
+    enc = decodeLatin1 . B64.encode . unEntityId
 
 agentNtfRegisterToken :: AgentClient -> NtfToken -> NtfPublicAuthKey -> C.PublicKeyX25519 -> AM (NtfTokenId, C.PublicKeyX25519)
 agentNtfRegisterToken c NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =
@@ -1707,10 +1717,10 @@ agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize},
   rKeys <- xftpRcvKeys n
   (sndKey, replicaKey) <- atomically . C.generateAuthKeyPair C.SEd25519 =<< asks random
   let fileInfo = FileInfo {sndKey, size = chunkSize, digest = chunkDigest}
-  logServer "-->" c srv "" "FNEW"
+  logServer "-->" c srv NoEntity "FNEW"
   tSess <- mkTransportSession c userId srv chunkDigest
   (sndId, rIds) <- withClient c tSess $ \xftp -> X.createXFTPChunk xftp replicaKey fileInfo (L.map fst rKeys) auth
-  logServer "<--" c srv "" $ B.unwords ["SIDS", logSecret sndId]
+  logServer "<--" c srv NoEntity $ B.unwords ["SIDS", logSecret sndId]
   pure NewSndChunkReplica {server = srv, replicaId = ChunkReplicaId sndId, replicaKey, rcvIdsKeys = L.toList $ xftpRcvIdsKeys rIds rKeys}
 
 agentXFTPUploadChunk :: AgentClient -> UserId -> FileDigest -> SndFileChunkReplica -> XFTPChunkSpec -> AM ()
@@ -1734,7 +1744,7 @@ xftpRcvKeys n = do
     Just rKeys' -> pure rKeys'
     _ -> throwE $ INTERNAL "non-positive number of recipients"
 
-xftpRcvIdsKeys :: NonEmpty ByteString -> NonEmpty C.AAuthKeyPair -> NonEmpty (ChunkReplicaId, C.APrivateAuthKey)
+xftpRcvIdsKeys :: NonEmpty EntityId -> NonEmpty C.AAuthKeyPair -> NonEmpty (ChunkReplicaId, C.APrivateAuthKey)
 xftpRcvIdsKeys rIds rKeys = L.map ChunkReplicaId rIds `L.zip` L.map snd rKeys
 
 agentCbEncrypt :: SndQueue -> Maybe C.PublicKeyX25519 -> ByteString -> AM ByteString
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index ea1d51a7d..12c29e6a0 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -51,6 +51,7 @@ module Simplex.Messaging.Agent.Protocol
     -- * SMP agent protocol types
     ConnInfo,
     SndQueueSecured,
+    AEntityId,
     ACommand (..),
     AEvent (..),
     AEvt (..),
@@ -190,7 +191,6 @@ import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol
   ( AProtocolType,
     BrokerErrorType (..),
-    EntityId,
     ErrorType,
     MsgBody,
     MsgFlags,
@@ -287,10 +287,12 @@ e2eEncAgentMsgLength v = \case
   _ -> 15856
 
 -- | SMP agent event
-type ATransmission = (ACorrId, EntityId, AEvt)
+type ATransmission = (ACorrId, AEntityId, AEvt)
 
 type UserId = Int64
 
+type AEntityId = ByteString
+
 type ACorrId = ByteString
 
 data AEntity = AEConn | AERcvFile | AESndFile | AENone
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 97b32eca8..3209f3674 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -1,10 +1,12 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -15,6 +17,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeOperators #-}
@@ -1814,6 +1817,14 @@ instance ToField (Version v) where toField (Version v) = toField v
 
 instance FromField (Version v) where fromField f = Version <$> fromField f
 
+deriving newtype instance ToField EntityId
+
+deriving newtype instance FromField EntityId
+
+deriving newtype instance ToField ChunkReplicaId
+
+deriving newtype instance FromField ChunkReplicaId
+
 listToEither :: e -> [a] -> Either e a
 listToEither _ (x : _) = Right x
 listToEither e _ = Left e
diff --git a/src/Simplex/Messaging/Agent/TRcvQueues.hs b/src/Simplex/Messaging/Agent/TRcvQueues.hs
index 38a60d6e0..52d67be70 100644
--- a/src/Simplex/Messaging/Agent/TRcvQueues.hs
+++ b/src/Simplex/Messaging/Agent/TRcvQueues.hs
@@ -31,7 +31,7 @@ import Simplex.Messaging.Transport
 
 class Queue q where
   connId' :: q -> ConnId
-  qKey :: q -> (UserId, SMPServer, ConnId)
+  qKey :: q -> (UserId, SMPServer, RecipientId)
 
 -- the fields in this record have the same data with swapped keys for lookup efficiency,
 -- and all methods must maintain this invariant.
@@ -97,7 +97,7 @@ getDelSessQueues tSess sessId' (TRcvQueues qs cs) = do
     delQ acc@(removed, qs') (sessId, rq)
       | rq `isSession` tSess && sessId == sessId' = (rq : removed, M.delete (qKey rq) qs')
       | otherwise = acc
-    delConn :: ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, ConnId))) -> RcvQueue -> ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, ConnId)))
+    delConn :: ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, RecipientId))) -> RcvQueue -> ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, RecipientId)))
     delConn (removed, cs') rq = M.alterF f cId cs'
       where
         cId = connId rq
@@ -113,7 +113,7 @@ isSession rq (uId, srv, connId_) =
 
 instance Queue RcvQueue where
   connId' = connId
-  qKey rq = (userId rq, server rq, connId rq)
+  qKey rq = (userId rq, server rq, rcvId rq)
 
 instance Queue (SessionId, RcvQueue) where
   connId' = connId . snd
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index b4567c62e..c0ce663ec 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -441,7 +441,8 @@ transportSession' = transportSession . client_
 type UserId = Int64
 
 -- | Transport session key - includes entity ID if `sessionMode = TSMEntity`.
-type TransportSession msg = (UserId, ProtoServer msg, Maybe EntityId)
+-- Please note that for SMP connection ID is used as entity ID, not queue ID.
+type TransportSession msg = (UserId, ProtoServer msg, Maybe ByteString)
 
 -- | Connects to 'ProtocolServer' using passed client configuration
 -- and queue for messages and notifications.
@@ -544,7 +545,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
           if remaining > 1_000_000 -- delay pings only for significant time
             then loop remaining
             else do
-              whenM (readTVarIO sendPings) $ void . runExceptT $ sendProtocolCommand c Nothing "" (protocolPing @v @err @msg)
+              whenM (readTVarIO sendPings) $ void . runExceptT $ sendProtocolCommand c Nothing NoEntity (protocolPing @v @err @msg)
               -- sendProtocolCommand/getResponse updates counter for each command
               cnt <- readTVarIO timeoutErrorCount
               -- drop client when maxCnt of commands have timed out in sequence, but only after some time has passed after last received response
@@ -670,7 +671,7 @@ createSMPQueue ::
   Bool ->
   ExceptT SMPClientError IO QueueIdsKeys
 createSMPQueue c (rKey, rpKey) dhKey auth subMode sndSecure =
-  sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey auth subMode sndSecure) >>= \case
+  sendSMPCommand c (Just rpKey) NoEntity (NEW rKey dhKey auth subMode sndSecure) >>= \case
     IDS qik -> pure qik
     r -> throwE $ unexpectedResponse r
 
@@ -829,7 +830,7 @@ deleteSMPQueues = okSMPCommands DEL
 connectSMPProxiedRelay :: SMPClient -> SMPServer -> Maybe BasicAuth -> ExceptT SMPClientError IO ProxiedRelay
 connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, tcpTimeout}} relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyAuth
   | thVersion (thParams c) >= sendingProxySMPVersion =
-      sendProtocolCommand_ c Nothing tOut Nothing "" (Cmd SProxiedClient (PRXY relayServ proxyAuth)) >>= \case
+      sendProtocolCommand_ c Nothing tOut Nothing NoEntity (Cmd SProxiedClient (PRXY relayServ proxyAuth)) >>= \case
         PKEY sId vr (chain, key) ->
           case supportedClientSMPRelayVRange `compatibleVersion` vr of
             Nothing -> throwE $ transportErr TEVersion
@@ -931,7 +932,7 @@ proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
   et <- liftEitherWith PCECryptoError $ EncTransmission <$> C.cbEncrypt cmdSecret nonce b paddedProxiedTLength
   -- proxy interaction errors are wrapped
   let tOut = Just $ 2 * tcpTimeout
-  tryE (sendProtocolCommand_ c (Just nonce) tOut Nothing sessionId (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
+  tryE (sendProtocolCommand_ c (Just nonce) tOut Nothing (EntityId sessionId) (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
     Right r -> case r of
       PRES (EncResponse er) -> do
         -- server interaction errors are thrown directly
@@ -967,7 +968,7 @@ forwardSMPTransmission c@ProtocolClient {thParams, client_ = PClient {clientCorr
   let fwdT = FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission}
       eft = EncFwdTransmission $ C.cbEncryptNoPad sessSecret nonce (smpEncode fwdT)
   -- send
-  sendProtocolCommand_ c (Just nonce) Nothing Nothing "" (Cmd SSender (RFWD eft)) >>= \case
+  sendProtocolCommand_ c (Just nonce) Nothing Nothing NoEntity (Cmd SSender (RFWD eft)) >>= \case
     RRES (EncFwdResponse efr) -> do
       -- unwrap
       r' <- liftEitherWith PCECryptoError $ C.cbDecryptNoPad sessSecret (C.reverseNonce nonce) efr
@@ -1015,7 +1016,7 @@ sendProtocolCommands c@ProtocolClient {thParams = THandleParams {batch, blockSiz
       | diff == 0 = pure $ L.fromList rs
       | diff > 0 = do
           putStrLn "send error: fewer responses than expected"
-          pure $ L.fromList $ rs <> replicate diff (Response "" $ Left $ PCETransportError TEBadBlock)
+          pure $ L.fromList $ rs <> replicate diff (Response NoEntity $ Left $ PCETransportError TEBadBlock)
       | otherwise = do
           putStrLn "send error: more responses than expected"
           pure $ L.fromList $ take (L.length cs) rs
diff --git a/src/Simplex/Messaging/Encoding.hs b/src/Simplex/Messaging/Encoding.hs
index 9f4c47583..15718e297 100644
--- a/src/Simplex/Messaging/Encoding.hs
+++ b/src/Simplex/Messaging/Encoding.hs
@@ -42,10 +42,12 @@ class Encoding a where
   -- | decoding of type (default implementation uses parser)
   smpDecode :: ByteString -> Either String a
   smpDecode = parseAll smpP
+  {-# INLINE smpDecode #-}
 
   -- | protocol parser of type (default implementation parses protocol ByteString encoding)
   smpP :: Parser a
   smpP = smpDecode <$?> smpP
+  {-# INLINE smpP #-}
 
 instance Encoding Char where
   smpEncode = B.singleton
diff --git a/src/Simplex/Messaging/Encoding/String.hs b/src/Simplex/Messaging/Encoding/String.hs
index 6b9fb5624..8995b9679 100644
--- a/src/Simplex/Messaging/Encoding/String.hs
+++ b/src/Simplex/Messaging/Encoding/String.hs
@@ -53,14 +53,20 @@ class StrEncoding a where
   -- Please note - if you only specify strDecode, it will use base64urlP as default parser before decoding the string
   strDecode :: ByteString -> Either String a
   strDecode = parseAll strP
+  {-# INLINE strDecode #-}
+
   strP :: Parser a
   strP = strDecode <$?> base64urlP
+  {-# INLINE strP #-}
 
 -- base64url encoding/decoding of ByteStrings - the parser only allows non-empty strings
 instance StrEncoding ByteString where
   strEncode = U.encode
+  {-# INLINE strEncode #-}
   strDecode = U.decode
+  {-# INLINE strDecode #-}
   strP = base64urlP
+  {-# INLINE strP #-}
 
 base64urlP :: Parser ByteString
 base64urlP = do
diff --git a/src/Simplex/Messaging/Notifications/Client.hs b/src/Simplex/Messaging/Notifications/Client.hs
index 32d92faf3..72f0c15a8 100644
--- a/src/Simplex/Messaging/Notifications/Client.hs
+++ b/src/Simplex/Messaging/Notifications/Client.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 module Simplex.Messaging.Notifications.Client where
 
@@ -11,7 +12,7 @@ import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Transport (NTFVersion, supportedClientNTFVRange, supportedNTFHandshakes)
-import Simplex.Messaging.Protocol (ErrorType)
+import Simplex.Messaging.Protocol (ErrorType, pattern NoEntity)
 
 type NtfClient = ProtocolClient NTFVersion ErrorType NtfResponse
 
@@ -22,7 +23,7 @@ defaultNTFClientConfig = defaultClientConfig (Just supportedNTFHandshakes) suppo
 
 ntfRegisterToken :: NtfClient -> C.APrivateAuthKey -> NewNtfEntity 'Token -> ExceptT NtfClientError IO (NtfTokenId, C.PublicKeyX25519)
 ntfRegisterToken c pKey newTkn =
-  sendNtfCommand c (Just pKey) "" (TNEW newTkn) >>= \case
+  sendNtfCommand c (Just pKey) NoEntity (TNEW newTkn) >>= \case
     NRTknId tknId dhKey -> pure (tknId, dhKey)
     r -> throwE $ unexpectedResponse r
 
@@ -46,7 +47,7 @@ ntfEnableCron c pKey tknId int = okNtfCommand (TCRN int) c pKey tknId
 
 ntfCreateSubscription :: NtfClient -> C.APrivateAuthKey -> NewNtfEntity 'Subscription -> ExceptT NtfClientError IO NtfSubscriptionId
 ntfCreateSubscription c pKey newSub =
-  sendNtfCommand c (Just pKey) "" (SNEW newSub) >>= \case
+  sendNtfCommand c (Just pKey) NoEntity (SNEW newSub) >>= \case
     NRSubId subId -> pure subId
     r -> throwE $ unexpectedResponse r
 
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 58a5e5193..736f164ba 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -208,7 +208,7 @@ instance NtfEntityI e => ProtocolEncoding NTFVersion ErrorType (NtfCommand e) wh
   fromProtocolError = fromProtocolError @NTFVersion @ErrorType @NtfResponse
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (auth, _, entityId, _) cmd = case cmd of
+  checkCredentials (auth, _, EntityId entityId, _) cmd = case cmd of
     -- TNEW and SNEW must have signature but NOT token/subscription IDs
     TNEW {} -> sigNoEntity
     SNEW {} -> sigNoEntity
@@ -322,7 +322,7 @@ instance ProtocolEncoding NTFVersion ErrorType NtfResponse where
     PEBlock -> BLOCK
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (_, _, entId, _) cmd = case cmd of
+  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
     -- IDTKN response must not have queue ID
     NRTknId {} -> noEntity
     -- IDSUB response must not have queue ID
@@ -426,7 +426,7 @@ instance FromJSON DeviceToken where
     t <- encodeUtf8 <$> o .: "token"
     pure $ DeviceToken pp t
 
-type NtfEntityId = ByteString
+type NtfEntityId = EntityId
 
 type NtfSubscriptionId = NtfEntityId
 
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 21f551199..763c45de6 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -44,7 +45,7 @@ import Simplex.Messaging.Notifications.Server.Stats
 import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Notifications.Server.StoreLog
 import Simplex.Messaging.Notifications.Transport
-import Simplex.Messaging.Protocol (ErrorType (..), ProtocolServer (host), SMPServer, SignedTransmission, Transmission, encodeTransmission, tGet, tPut)
+import Simplex.Messaging.Protocol (EntityId (..), ErrorType (..), ProtocolServer (host), SMPServer, SignedTransmission, Transmission, pattern NoEntity, encodeTransmission, tGet, tPut)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
 import Simplex.Messaging.Server.Stats
@@ -448,7 +449,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
         atomically $ writeTBQueue pushQ (tkn, PNVerification regCode)
         withNtfLog (`logCreateToken` tkn)
         incNtfStatT token tknCreated
-        pure (corrId, "", NRTknId tknId srvDhPubKey)
+        pure (corrId, NoEntity, NRTknId tknId srvDhPubKey)
       NtfReqCmd SToken (NtfTkn tkn@NtfTknData {token, ntfTknId, tknStatus, tknRegCode, tknDhSecret, tknDhKeys = (srvDhPubKey, srvDhPrivKey), tknCronInterval}) (corrId, tknId, cmd) -> do
         status <- readTVarIO tknStatus
         (corrId,tknId,) <$> case cmd of
@@ -539,7 +540,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
             _ -> pure $ NRErr AUTH
         withNtfLog (`logCreateSubscription` sub)
         incNtfStat subCreated
-        pure (corrId, "", resp)
+        pure (corrId, NoEntity, resp)
       NtfReqCmd SSubscription (NtfSub NtfSubData {smpQueue = SMPQueueNtf {smpServer, notifierId}, notifierKey = registeredNKey, subStatus}) (corrId, subId, cmd) -> do
         status <- readTVarIO subStatus
         (corrId,subId,) <$> case cmd of
@@ -564,7 +565,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
           PING -> pure NRPong
       NtfReqPing corrId entId -> pure (corrId, entId, NRPong)
     getId :: M NtfEntityId
-    getId = randomBytes =<< asks (subIdBytes . config)
+    getId = fmap EntityId . randomBytes =<< asks (subIdBytes . config)
     getRegCode :: M NtfRegCode
     getRegCode = NtfRegCode <$> (randomBytes =<< asks (regCodeBytes . config))
     randomBytes :: Int -> M ByteString
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index 63e3e4d98..9dc6a7ea9 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -2,11 +2,13 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
@@ -99,7 +101,8 @@ module Simplex.Messaging.Protocol
     BasicAuth (..),
     SrvLoc (..),
     CorrId (..),
-    EntityId,
+    EntityId (..),
+    pattern NoEntity,
     QueueId,
     RecipientId,
     SenderId,
@@ -329,8 +332,8 @@ data RawTransmission = RawTransmission
   { authenticator :: ByteString, -- signature or encrypted transmission hash
     authorized :: ByteString, -- authorized transmission
     sessId :: SessionId,
-    corrId :: ByteString,
-    entityId :: ByteString,
+    corrId :: CorrId,
+    entityId :: EntityId,
     command :: ByteString
   }
   deriving (Show)
@@ -357,7 +360,7 @@ instance IsString (Maybe TransmissionAuth) where
   fromString = parseString $ B64.decode >=> C.decodeSignature >=> pure . fmap TASignature
 
 -- | unparsed sent SMP transmission with signature, without session ID.
-type SignedRawTransmission = (Maybe TransmissionAuth, SessionId, ByteString, ByteString)
+type SignedRawTransmission = (Maybe TransmissionAuth, CorrId, EntityId, ByteString)
 
 -- | unparsed sent SMP transmission with signature.
 type SentRawTransmission = (Maybe TransmissionAuth, ByteString)
@@ -374,7 +377,13 @@ type NotifierId = QueueId
 -- | SMP queue ID on the server.
 type QueueId = EntityId
 
-type EntityId = ByteString
+-- this type is used for server entities only
+newtype EntityId = EntityId {unEntityId :: ByteString}
+  deriving (Eq, Ord, Show)
+  deriving newtype (Encoding, StrEncoding)
+
+pattern NoEntity :: EntityId
+pattern NoEntity = EntityId ""
 
 -- | Parameterized type for SMP protocol commands from all clients.
 data Command (p :: Party) where
@@ -1097,10 +1106,13 @@ serverStrP = do
     portP = show <$> (A.char ':' *> (A.decimal :: Parser Int))
 
 -- | Transmission correlation ID.
-newtype CorrId = CorrId {bs :: ByteString} deriving (Eq, Ord, Show)
+newtype CorrId = CorrId {bs :: ByteString}
+  deriving (Eq, Ord, Show)
+  deriving newtype (Encoding)
 
 instance IsString CorrId where
   fromString = CorrId . fromString
+  {-# INLINE fromString #-}
 
 instance StrEncoding CorrId where
   strEncode (CorrId cId) = strEncode cId
@@ -1323,7 +1335,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
   fromProtocolError = fromProtocolError @SMPVersion @ErrorType @BrokerMsg
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (auth, _, entId, _) cmd = case cmd of
+  checkCredentials (auth, _, EntityId entId, _) cmd = case cmd of
     -- NEW must have signature but NOT queue ID
     NEW {}
       | isNothing auth -> Left $ CMD NO_AUTH
@@ -1448,7 +1460,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     PEBlock -> BLOCK
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (_, _, entId, _) cmd = case cmd of
+  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
     -- IDS response should not have queue ID
     IDS _ -> Right cmd
     -- ERR response does not always have queue ID
@@ -1721,16 +1733,16 @@ tDecodeParseValidate THandleParams {sessionId, thVersion = v, implySessId} = \ca
     | implySessId || sessId == sessionId ->
         let decodedTransmission = (,corrId,entityId,command) <$> decodeTAuthBytes authenticator
          in either (const $ tError corrId) (tParseValidate authorized) decodedTransmission
-    | otherwise -> (Nothing, "", (CorrId corrId, "", Left $ fromProtocolError @v @err @cmd PESession))
+    | otherwise -> (Nothing, "", (corrId, NoEntity, Left $ fromProtocolError @v @err @cmd PESession))
   Left _ -> tError ""
   where
-    tError :: ByteString -> SignedTransmission err cmd
-    tError corrId = (Nothing, "", (CorrId corrId, "", Left $ fromProtocolError @v @err @cmd PEBlock))
+    tError :: CorrId -> SignedTransmission err cmd
+    tError corrId = (Nothing, "", (corrId, NoEntity, Left $ fromProtocolError @v @err @cmd PEBlock))
 
     tParseValidate :: ByteString -> SignedRawTransmission -> SignedTransmission err cmd
     tParseValidate signed t@(sig, corrId, entityId, command) =
       let cmd = parseProtocol @v @err @cmd v command >>= checkCredentials t
-       in (sig, signed, (CorrId corrId, entityId, cmd))
+       in (sig, signed, (corrId, entityId, cmd))
 
 $(J.deriveJSON defaultJSON ''MsgFlags)
 
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 29b4e2138..d796d8e6c 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -898,7 +898,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
     reply :: MonadIO m => NonEmpty (Transmission BrokerMsg) -> m ()
     reply = atomically . writeTBQueue sndQ
     processProxiedCmd :: Transmission (Command 'ProxiedClient) -> M (Maybe (Transmission BrokerMsg))
-    processProxiedCmd (corrId, sessId, command) = (corrId,sessId,) <$$> case command of
+    processProxiedCmd (corrId, EntityId sessId, command) = (corrId,EntityId sessId,) <$$> case command of
       PRXY srv auth -> ifM allowProxy getRelay (pure $ Just $ ERR $ PROXY BASIC_AUTH)
         where
           allowProxy = do
@@ -961,7 +961,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
         forkProxiedCmd cmdAction = do
           bracket_ wait signal . forkClient clnt (B.unpack $ "client $" <> encode sessionId <> " proxy") $ do
             -- commands MUST be processed under a reasonable timeout or the client would halt
-            cmdAction >>= \t -> reply [(corrId, sessId, t)]
+            cmdAction >>= \t -> reply [(corrId, EntityId sessId, t)]
           pure Nothing
           where
             wait = do
@@ -987,8 +987,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             | otherwise -> pure $ ERR AUTH
           Nothing -> pure $ ERR INTERNAL
         SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
-        PING -> pure (corrId, "", PONG)
-        RFWD encBlock -> (corrId, "",) <$> processForwardedCommand encBlock
+        PING -> pure (corrId, NoEntity, PONG)
+        RFWD encBlock -> (corrId, NoEntity,) <$> processForwardedCommand encBlock
       Cmd SNotifier NSUB -> Just <$> subscribeNotifications
       Cmd SRecipient command -> do
         st <- asks queueStore
@@ -1265,7 +1265,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             THandleParams {thVersion} = thParams'
             mkMessage :: C.MaxLenBS MaxMessageLen -> M Message
             mkMessage body = do
-              msgId <- randomId =<< asks (msgIdBytes . config)
+              msgId <- randomId' =<< asks (msgIdBytes . config)
               msgTs <- liftIO getSystemTime
               pure $! Message msgId msgTs msgFlags body
 
@@ -1508,7 +1508,7 @@ withLog action = do
   liftIO . mapM_ action $ storeLog (env :: Env)
 
 timed :: T.Text -> RecipientId -> M a -> M a
-timed name qId a = do
+timed name (EntityId qId) a = do
   t <- liftIO getSystemTime
   r <- a
   t' <- liftIO getSystemTime
@@ -1519,8 +1519,12 @@ timed name qId a = do
     diff t t' = (systemSeconds t' - systemSeconds t) * sec + fromIntegral (systemNanoseconds t' - systemNanoseconds t)
     sec = 1000_000000
 
-randomId :: Int -> M ByteString
-randomId n = atomically . C.randomBytes n =<< asks random
+randomId' :: Int -> M ByteString
+randomId' n = atomically . C.randomBytes n =<< asks random
+
+randomId :: Int -> M EntityId
+randomId = fmap EntityId . randomId'
+{-# INLINE randomId #-}
 
 saveServerMessages :: Bool -> M ()
 saveServerMessages keepMsgs = asks (storeMsgsFile . config) >>= mapM_ saveMessages
diff --git a/src/Simplex/Messaging/Server/Control.hs b/src/Simplex/Messaging/Server/Control.hs
index b4c74e4ac..e1d1b5d12 100644
--- a/src/Simplex/Messaging/Server/Control.hs
+++ b/src/Simplex/Messaging/Server/Control.hs
@@ -4,9 +4,8 @@
 module Simplex.Messaging.Server.Control where
 
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString (ByteString)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (BasicAuth)
+import Simplex.Messaging.Protocol (BasicAuth, SenderId)
 
 data CPClientRole = CPRNone | CPRUser | CPRAdmin
   deriving (Eq)
@@ -22,7 +21,7 @@ data ControlProtocol
   | CPSockets
   | CPSocketThreads
   | CPServerInfo
-  | CPDelete ByteString
+  | CPDelete SenderId
   | CPSave
   | CPHelp
   | CPQuit
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index 3386f82f3..4b581bb6c 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -116,7 +116,6 @@ import Simplex.Messaging.Version.Internal
 import System.IO.Error (isEOFError)
 import UnliftIO.Exception (Exception)
 import qualified UnliftIO.Exception as E
-import UnliftIO.STM
 
 -- * Transport parameters
 
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index 9ab881e83..2c1fcff14 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -168,9 +168,11 @@ threadDelay' = loop
 
 diffToMicroseconds :: NominalDiffTime -> Int64
 diffToMicroseconds diff = truncate $ diff * 1000000
+{-# INLINE diffToMicroseconds #-}
 
 diffToMilliseconds :: NominalDiffTime -> Int64
 diffToMilliseconds diff = truncate $ diff * 1000
+{-# INLINE diffToMilliseconds #-}
 
 labelMyThread :: MonadIO m => String -> m ()
 labelMyThread label = liftIO $ myThreadId >>= (`labelThread` label)
diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs
index 5d0a2c00a..14f19efc3 100644
--- a/tests/AgentTests/ConnectionRequestTests.hs
+++ b/tests/AgentTests/ConnectionRequestTests.hs
@@ -20,7 +20,7 @@ import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (ProtocolServer (..), currentSMPClientVersion, supportedSMPClientVRange, pattern VersionSMPC)
+import Simplex.Messaging.Protocol (EntityId (..), ProtocolServer (..), currentSMPClientVersion, supportedSMPClientVRange, pattern VersionSMPC)
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import Simplex.Messaging.Version
 import Test.Hspec
@@ -35,7 +35,7 @@ queueAddr :: SMPQueueAddress
 queueAddr =
   SMPQueueAddress
     { smpServer = srv,
-      senderId = "\223\142z\251",
+      senderId = EntityId "\223\142z\251",
       dhPublicKey = testDhKey,
       sndSecure = False
     }
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index f876603f5..f376477a6 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -50,7 +50,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
-import Simplex.Messaging.Protocol (SubscriptionMode (..), pattern VersionSMPC)
+import Simplex.Messaging.Protocol (EntityId (..), SubscriptionMode (..), pattern VersionSMPC)
 import qualified Simplex.Messaging.Protocol as SMP
 import System.Random
 import Test.Hspec
@@ -217,12 +217,12 @@ rcvQueue1 =
     { userId = 1,
       connId = "conn1",
       server = smpServer1,
-      rcvId = "1234",
+      rcvId = EntityId "1234",
       rcvPrivateKey = testPrivateAuthKey,
       rcvDhSecret = testDhSecret,
       e2ePrivKey = testPrivDhKey,
       e2eDhSecret = Nothing,
-      sndId = "2345",
+      sndId = EntityId "2345",
       sndSecure = True,
       status = New,
       dbQueueId = DBNewQueue,
@@ -240,7 +240,7 @@ sndQueue1 =
     { userId = 1,
       connId = "conn1",
       server = smpServer1,
-      sndId = "3456",
+      sndId = EntityId "3456",
       sndSecure = True,
       sndPublicKey = testPublicAuthKey,
       sndPrivateKey = testPrivateAuthKey,
@@ -332,7 +332,7 @@ testGetRcvConn :: SpecWith SQLiteStore
 testGetRcvConn =
   it "should get connection using rcv queue id and server" . withStoreTransaction $ \db -> do
     let smpServer = SMPServer "smp.simplex.im" "5223" testKeyHash
-    let recipientId = "1234"
+    let recipientId = EntityId "1234"
     g <- C.newRandom
     Right (_, rq) <- createRcvConn db g cData1 rcvQueue1 SCMInvitation
     getRcvConn db smpServer recipientId
@@ -400,7 +400,7 @@ testUpgradeRcvConnToDuplex =
             { userId = 1,
               connId = "conn1",
               server = SMPServer "smp.simplex.im" "5223" testKeyHash,
-              sndId = "2345",
+              sndId = EntityId "2345",
               sndSecure = True,
               sndPublicKey = testPublicAuthKey,
               sndPrivateKey = testPrivateAuthKey,
@@ -429,12 +429,12 @@ testUpgradeSndConnToDuplex =
             { userId = 1,
               connId = "conn1",
               server = SMPServer "smp.simplex.im" "5223" testKeyHash,
-              rcvId = "3456",
+              rcvId = EntityId "3456",
               rcvPrivateKey = testPrivateAuthKey,
               rcvDhSecret = testDhSecret,
               e2ePrivKey = testPrivDhKey,
               e2eDhSecret = Nothing,
-              sndId = "4567",
+              sndId = EntityId "4567",
               sndSecure = True,
               status = New,
               dbQueueId = DBNewQueue,
@@ -715,7 +715,7 @@ rcvFileDescr1 =
     }
   where
     defaultChunkSize = FileSize $ mb 8
-    replicaId = ChunkReplicaId "abc"
+    replicaId = ChunkReplicaId $ EntityId "abc"
     chunkDigest = FileDigest "ghi"
 
 testFileSbKey :: C.SbKey
@@ -785,9 +785,9 @@ newSndChunkReplica1 :: NewSndChunkReplica
 newSndChunkReplica1 =
   NewSndChunkReplica
     { server = xftpServer1,
-      replicaId = ChunkReplicaId "abc",
+      replicaId = ChunkReplicaId $ EntityId "abc",
       replicaKey = testFileReplicaKey,
-      rcvIdsKeys = [(ChunkReplicaId "abc", testFileReplicaKey)]
+      rcvIdsKeys = [(ChunkReplicaId $ EntityId "abc", testFileReplicaKey)]
     }
 
 testGetNextSndChunkToUpload :: SQLiteStore -> Expectation
@@ -818,9 +818,9 @@ testGetNextDeletedSndChunkReplica st = do
   withTransaction st $ \db -> do
     Right Nothing <- getNextDeletedSndChunkReplica db xftpServer1 86400
 
-    createDeletedSndChunkReplica db 1 (FileChunkReplica xftpServer1 (ChunkReplicaId "abc") testFileReplicaKey) (FileDigest "ghi")
+    createDeletedSndChunkReplica db 1 (FileChunkReplica xftpServer1 (ChunkReplicaId $ EntityId "abc") testFileReplicaKey) (FileDigest "ghi")
     DB.execute_ db "UPDATE deleted_snd_chunk_replicas SET delay = 'bad' WHERE deleted_snd_chunk_replica_id = 1"
-    createDeletedSndChunkReplica db 1 (FileChunkReplica xftpServer1 (ChunkReplicaId "abc") testFileReplicaKey) (FileDigest "ghi")
+    createDeletedSndChunkReplica db 1 (FileChunkReplica xftpServer1 (ChunkReplicaId $ EntityId "abc") testFileReplicaKey) (FileDigest "ghi")
 
     Left e <- getNextDeletedSndChunkReplica db xftpServer1 86400
     show e `shouldContain` "ConversionFailed"
diff --git a/tests/CoreTests/BatchingTests.hs b/tests/CoreTests/BatchingTests.hs
index 023f6de04..a12cbf1ea 100644
--- a/tests/CoreTests/BatchingTests.hs
+++ b/tests/CoreTests/BatchingTests.hs
@@ -301,7 +301,7 @@ randomSUB_ a v sessId = do
   (rKey, rpKey) <- atomically $ C.generateAuthKeyPair a g
   thAuth_ <- testTHandleAuth v g rKey
   let thParams = testTHandleParams v sessId
-      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, rId, Cmd SRecipient SUB)
+      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId rId, Cmd SRecipient SUB)
   pure $ (,tToSend) <$> authTransmission thAuth_ (Just rpKey) nonce tForAuth
 
 randomSUBCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
@@ -315,13 +315,13 @@ randomSUBCmd_ a c = do
   g <- C.newRandom
   rId <- atomically $ C.randomBytes 24 g
   (_, rpKey) <- atomically $ C.generateAuthKeyPair a g
-  mkTransmission c (Just rpKey, rId, Cmd SRecipient SUB)
+  mkTransmission c (Just rpKey, EntityId rId, Cmd SRecipient SUB)
 
 randomENDCmd :: IO (Transmission BrokerMsg)
 randomENDCmd = do
   g <- C.newRandom
   rId <- atomically $ C.randomBytes 24 g
-  pure (CorrId "", rId, END)
+  pure (CorrId "", EntityId rId, END)
 
 randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSEND = randomSEND_ C.SEd25519 subModeSMPVersion
@@ -338,7 +338,7 @@ randomSEND_ a v sessId len = do
   thAuth_ <- testTHandleAuth v g sKey
   msg <- atomically $ C.randomBytes len g
   let thParams = testTHandleParams v sessId
-      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, sId, Cmd SSender $ SEND noMsgFlags msg)
+      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId sId, Cmd SSender $ SEND noMsgFlags msg)
   pure $ (,tToSend) <$> authTransmission thAuth_ (Just spKey) nonce tForAuth
 
 testTHandleParams :: VersionSMP -> ByteString -> THandleParams SMPVersion 'TClient
@@ -377,7 +377,7 @@ randomSENDCmd_ a c len = do
   sId <- atomically $ C.randomBytes 24 g
   (_, rpKey) <- atomically $ C.generateAuthKeyPair a g
   msg <- atomically $ C.randomBytes len g
-  mkTransmission c (Just rpKey, sId, Cmd SSender $ SEND noMsgFlags msg)
+  mkTransmission c (Just rpKey, EntityId sId, Cmd SSender $ SEND noMsgFlags msg)
 
 lenOk :: ByteString -> Bool
 lenOk s = 0 < B.length s && B.length s <= smpBlockSize - 2
diff --git a/tests/CoreTests/TRcvQueuesTests.hs b/tests/CoreTests/TRcvQueuesTests.hs
index 24d54fc8e..5b66bb844 100644
--- a/tests/CoreTests/TRcvQueuesTests.hs
+++ b/tests/CoreTests/TRcvQueuesTests.hs
@@ -3,18 +3,21 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module CoreTests.TRcvQueuesTests where
 
 import AgentTests.EqInstances ()
+import qualified Data.ByteString.Char8 as B
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map as M
 import qualified Data.Set as S
+import Data.String (IsString (..))
 import Simplex.Messaging.Agent.Protocol (ConnId, QueueStatus (..), UserId)
 import Simplex.Messaging.Agent.Store (DBQueueId (..), RcvQueue, StoredRcvQueue (..))
 import qualified Simplex.Messaging.Agent.TRcvQueues as RQ
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (SMPServer, pattern VersionSMPC)
+import Simplex.Messaging.Protocol (EntityId (..), RecipientId, SMPServer, pattern NoEntity, pattern VersionSMPC)
 import Test.Hspec
 import UnliftIO
 
@@ -31,6 +34,8 @@ tRcvQueuesTests = do
   describe "queue transfer" $ do
     it "getDelSessQueues-batchAddQueues preserves total length" removeSubsTest
 
+instance IsString EntityId where fromString = EntityId . B.pack
+
 checkDataInvariant :: RQ.Queue q => RQ.TRcvQueues q -> IO Bool
 checkDataInvariant trq = atomically $ do
   conns <- readTVar $ RQ.getConnections trq
@@ -44,11 +49,11 @@ checkDataInvariant trq = atomically $ do
 hasConnTest :: IO ()
 hasConnTest = do
   trq <- RQ.empty
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1") trq
   checkDataInvariant trq `shouldReturn` True
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2") trq
   checkDataInvariant trq `shouldReturn` True
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3" "r3") trq
   checkDataInvariant trq `shouldReturn` True
   atomically (RQ.hasConn "c1" trq) `shouldReturn` True
   atomically (RQ.hasConn "c2" trq) `shouldReturn` True
@@ -58,7 +63,7 @@ hasConnTest = do
 hasConnTestBatch :: IO ()
 hasConnTestBatch = do
   trq <- RQ.empty
-  let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1", dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@beta" "c3"]
+  let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1", dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2", dummyRQ 0 "smp://1234-w==@beta" "c3" "r3"]
   atomically $ RQ.batchAddQueues trq qs
   checkDataInvariant trq `shouldReturn` True
   atomically (RQ.hasConn "c1" trq) `shouldReturn` True
@@ -69,7 +74,7 @@ hasConnTestBatch = do
 batchIdempotentTest :: IO ()
 batchIdempotentTest = do
   trq <- RQ.empty
-  let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1", dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@beta" "c3"]
+  let qs = [dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1", dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2", dummyRQ 0 "smp://1234-w==@beta" "c3" "r3"]
   atomically $ RQ.batchAddQueues trq qs
   checkDataInvariant trq `shouldReturn` True
   qs' <- readTVarIO $ RQ.getRcvQueues trq
@@ -83,9 +88,9 @@ deleteConnTest :: IO ()
 deleteConnTest = do
   trq <- RQ.empty
   atomically $ do
-    RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
-    RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
-    RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3") trq
+    RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1") trq
+    RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2") trq
+    RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3" "r3") trq
   checkDataInvariant trq `shouldReturn` True
   atomically $ RQ.deleteConn "c1" trq
   checkDataInvariant trq `shouldReturn` True
@@ -96,16 +101,16 @@ deleteConnTest = do
 getSessQueuesTest :: IO ()
 getSessQueuesTest = do
   trq <- RQ.empty
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1") trq
   checkDataInvariant trq `shouldReturn` True
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2") trq
   checkDataInvariant trq `shouldReturn` True
-  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3") trq
+  atomically $ RQ.addQueue (dummyRQ 0 "smp://1234-w==@beta" "c3" "r3") trq
   checkDataInvariant trq `shouldReturn` True
-  atomically $ RQ.addQueue (dummyRQ 1 "smp://1234-w==@beta" "c4") trq
+  atomically $ RQ.addQueue (dummyRQ 1 "smp://1234-w==@beta" "c4" "r4") trq
   checkDataInvariant trq `shouldReturn` True
   let tSess1 = (0, "smp://1234-w==@alpha", Just "c1")
-  RQ.getSessQueues tSess1 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c1"]
+  RQ.getSessQueues tSess1 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1"]
   atomically (RQ.hasSessQueues tSess1 trq) `shouldReturn` True
   let tSess2 = (1, "smp://1234-w==@alpha", Just "c1")
   RQ.getSessQueues tSess2 trq `shouldReturn` []
@@ -114,17 +119,17 @@ getSessQueuesTest = do
   RQ.getSessQueues tSess3 trq `shouldReturn` []
   atomically (RQ.hasSessQueues tSess3 trq) `shouldReturn` False
   let tSess4 = (0, "smp://1234-w==@alpha", Nothing)
-  RQ.getSessQueues tSess4 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"]
+  RQ.getSessQueues tSess4 trq `shouldReturn` [dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2", dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1"]
   atomically (RQ.hasSessQueues tSess4 trq) `shouldReturn`True
 
 getDelSessQueuesTest :: IO ()
 getDelSessQueuesTest = do
   trq <- RQ.empty
   let qs =
-        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
-          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
-          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3"),
-          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4")
+        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1"),
+          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2"),
+          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3" "r3"),
+          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4" "r4")
         ]
   atomically $ RQ.batchAddQueues trq qs
   checkDataInvariant trq `shouldReturn` True
@@ -137,7 +142,7 @@ getDelSessQueuesTest = do
   -- connections intact
   atomically (RQ.hasConn "c1" trq) `shouldReturn` True
   atomically (RQ.hasConn "c2" trq) `shouldReturn` True
-  atomically (RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"], ["c1", "c2"])
+  atomically (RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2", dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1"], ["c1", "c2"])
   checkDataInvariant trq `shouldReturn` True
   -- connections gone
   atomically (RQ.hasConn "c1" trq) `shouldReturn` False
@@ -150,10 +155,10 @@ removeSubsTest :: IO ()
 removeSubsTest = do
   aq <- RQ.empty
   let qs =
-        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
-          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
-          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3"),
-          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4")
+        [ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1" "r1"),
+          ("1", dummyRQ 0 "smp://1234-w==@alpha" "c2" "r2"),
+          ("1", dummyRQ 0 "smp://1234-w==@beta" "c3" "r3"),
+          ("1", dummyRQ 1 "smp://1234-w==@beta" "c4" "r4")
         ]
   atomically $ RQ.batchAddQueues aq qs
 
@@ -180,18 +185,18 @@ totalSize a b = do
   csizeB <- M.size <$> readTVar (RQ.getConnections b)
   pure (qsizeA + qsizeB, csizeA + csizeB)
 
-dummyRQ :: UserId -> SMPServer -> ConnId -> RcvQueue
-dummyRQ userId server connId =
+dummyRQ :: UserId -> SMPServer -> ConnId -> RecipientId -> RcvQueue
+dummyRQ userId server connId rcvId =
   RcvQueue
     { userId,
       connId,
       server,
-      rcvId = "",
+      rcvId,
       rcvPrivateKey = C.APrivateAuthKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe",
       rcvDhSecret = "01234567890123456789012345678901",
       e2ePrivKey = "MC4CAQAwBQYDK2VuBCIEINCzbVFaCiYHoYncxNY8tSIfn0pXcIAhLBfFc0m+gOpk",
       e2eDhSecret = Nothing,
-      sndId = "",
+      sndId = NoEntity,
       sndSecure = True,
       status = New,
       dbQueueId = DBQueueId 0,
diff --git a/tests/FileDescriptionTests.hs b/tests/FileDescriptionTests.hs
index 65b818979..10c719888 100644
--- a/tests/FileDescriptionTests.hs
+++ b/tests/FileDescriptionTests.hs
@@ -13,6 +13,7 @@ import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Protocol (EntityId (..))
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import System.Directory (removeFile)
 import Test.Hspec
@@ -91,7 +92,7 @@ fileDesc =
     }
   where
     defaultChunkSize = FileSize $ mb 8
-    replicaId = ChunkReplicaId "abc"
+    replicaId = ChunkReplicaId $ EntityId "abc"
     replicaKey = C.APrivateAuthKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe"
     chunkDigest = FileDigest "ghi"
 
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index 9bd124e55..c263bc016 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -158,7 +158,7 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
       [Right ()] <- tPut h [Right (sig, t')]
       pure ()
     tGet' h = do
-      [(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
+      [(Nothing, _, (CorrId corrId, EntityId qId, Right cmd))] <- tGet h
       pure (Nothing, corrId, qId, cmd)
 
 ntfTest :: Transport c => TProxy c -> (THandleNTF c 'TClient -> IO ()) -> Expectation
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index e5f096eef..c4b97f18c 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -72,13 +72,13 @@ pattern RespNtf corrId queueId command <- (_, _, (corrId, queueId, Right command
 
 deriving instance Eq NtfResponse
 
-sendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandleNTF c 'TClient -> (Maybe TransmissionAuth, ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
+sendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandleNTF c 'TClient -> (Maybe TransmissionAuth, ByteString, NtfEntityId, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
 sendRecvNtf h@THandle {params} (sgn, corrId, qId, cmd) = do
   let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
   Right () <- tPut1 h (sgn, tToSend)
   tGet1 h
 
-signSendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandleNTF c 'TClient -> C.APrivateAuthKey -> (ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
+signSendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandleNTF c 'TClient -> C.APrivateAuthKey -> (ByteString, NtfEntityId, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
 signSendRecvNtf h@THandle {params} (C.APrivateAuthKey a pk) (corrId, qId, cmd) = do
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
   Right () <- tPut1 h (authorize tForAuth, tToSend)
@@ -110,7 +110,7 @@ testNotificationSubscription (ATransport t) =
           -- create queue
           (sId, rId, rKey, rcvDhSecret) <- createAndSecureQueue rh sPub
           -- register and verify token
-          RespNtf "1" "" (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", "", TNEW $ NewNtfTkn tkn tknPub dhPub)
+          RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
           APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse = send} <-
             atomically $ readTBQueue apnsQ
           send APNSRespOk
@@ -126,7 +126,7 @@ testNotificationSubscription (ATransport t) =
           let srv = SMPServer SMP.testHost SMP.testPort SMP.testKeyHash
               q = SMPQueueNtf srv nId
               rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
-          RespNtf "4" _ (NRSubId _subId) <- signSendRecvNtf nh tknKey ("4", "", SNEW $ NewNtfSub tId q nKey)
+          RespNtf "4" _ (NRSubId _subId) <- signSendRecvNtf nh tknKey ("4", NoEntity, SNEW $ NewNtfSub tId q nKey)
           -- send message
           threadDelay 50000
           Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello")
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 96f64b8f5..472f9b6b4 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -219,7 +219,7 @@ smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
       [Right ()] <- tPut h [Right (sig, t')]
       pure ()
     tGet' h = do
-      [(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
+      [(Nothing, _, (CorrId corrId, EntityId qId, Right cmd))] <- tGet h
       pure (Nothing, corrId, qId, cmd)
 
 smpTest :: (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c 'TClient -> IO ()) -> Expectation
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 8044d23f7..32aa992d3 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -34,7 +34,7 @@ import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
-import Simplex.Messaging.Protocol (EncRcvMsgBody (..), MsgBody, RcvMessage (..), SubscriptionMode (..), maxMessageLength, noMsgFlags)
+import Simplex.Messaging.Protocol (EncRcvMsgBody (..), MsgBody, RcvMessage (..), SubscriptionMode (..), pattern NoEntity, maxMessageLength, noMsgFlags)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Transport
@@ -408,14 +408,14 @@ testNoProxy :: IO ()
 testNoProxy = do
   withSmpServerConfigOn (transport @TLS) cfg testPort2 $ \_ -> do
     testSMPClient_ "127.0.0.1" testPort2 proxyVRangeV8 $ \(th :: THandleSMP TLS 'TClient) -> do
-      (_, _, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", SMP.PRXY testSMPServer Nothing)
+      (_, _, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", NoEntity, SMP.PRXY testSMPServer Nothing)
       reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
 
 testProxyAuth :: IO ()
 testProxyAuth = do
   withSmpServerConfigOn (transport @TLS) proxyCfgAuth testPort $ \_ -> do
     testSMPClient_ "127.0.0.1" testPort proxyVRangeV8 $ \(th :: THandleSMP TLS 'TClient) -> do
-      (_, _s, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", "", SMP.PRXY testSMPServer2 $ Just "wrong")
+      (_, _s, (_corrId, _entityId, reply)) <- sendRecv th (Nothing, "0", NoEntity, SMP.PRXY testSMPServer2 $ Just "wrong")
       reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
   where
     proxyCfgAuth = proxyCfg {newQueueBasicAuth = Just "correct"}
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index a788af821..d3154e228 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -78,13 +78,13 @@ pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh _sndSecure)
 pattern Msg :: MsgId -> MsgBody -> BrokerMsg
 pattern Msg msgId body <- MSG RcvMessage {msgId, msgBody = EncRcvMsgBody body}
 
-sendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> (Maybe TransmissionAuth, ByteString, ByteString, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
+sendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> (Maybe TransmissionAuth, ByteString, EntityId, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
 sendRecv h@THandle {params} (sgn, corrId, qId, cmd) = do
   let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
   Right () <- tPut1 h (sgn, tToSend)
   tGet1 h
 
-signSendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> C.APrivateAuthKey -> (ByteString, ByteString, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
+signSendRecv :: forall c p. (Transport c, PartyI p) => THandleSMP c 'TClient -> C.APrivateAuthKey -> (ByteString, EntityId, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
 signSendRecv h@THandle {params} (C.APrivateAuthKey a pk) (corrId, qId, cmd) = do
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth params (CorrId corrId, qId, cmd)
   Right () <- tPut1 h (authorize tForAuth, tToSend)
@@ -134,9 +134,9 @@ testCreateSecure (ATransport t) =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv r rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv r rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
-      (rId1, "") #== "creates queue"
+      (rId1, NoEntity) #== "creates queue"
 
       Resp "bcda" sId1 ok1 <- sendRecv s ("", "bcda", sId, _SEND "hello")
       (ok1, OK) #== "accepts unsigned SEND"
@@ -199,9 +199,9 @@ testCreateDelete (ATransport t) =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
-      (rId1, "") #== "creates queue"
+      (rId1, NoEntity) #== "creates queue"
 
       (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, KEY sPub)
@@ -271,7 +271,7 @@ stressTest (ATransport t) =
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
       rIds <- forM ([1 .. 50] :: [Int]) . const $ do
-        Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub Nothing SMSubscribe False)
+        Resp "" NoEntity (Ids rId _ _) <- signSendRecv h1 rKey ("", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
         pure rId
       let subscribeQueues h = forM_ rIds $ \rId -> do
             Resp "" rId' OK <- signSendRecv h rKey ("", rId, SUB)
@@ -289,7 +289,7 @@ testAllowNewQueues t =
         g <- C.newRandom
         (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
         (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-        Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
+        Resp "abcd" NoEntity (ERR AUTH) <- signSendRecv h rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
         pure ()
 
 testDuplex :: ATransport -> Spec
@@ -299,7 +299,7 @@ testDuplex (ATransport t) =
       g <- C.newRandom
       (arPub, arKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (aDhPub, aDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub Nothing SMSubscribe False)
+      Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", NoEntity, NEW arPub aDhPub Nothing SMSubscribe False)
       let aDec = decryptMsgV3 $ C.dh' aSrvDh aDhPriv
       -- aSnd ID is passed to Bob out-of-band
 
@@ -315,15 +315,15 @@ testDuplex (ATransport t) =
 
       (brPub, brKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (bDhPub, bDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub Nothing SMSubscribe False)
+      Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", NoEntity, NEW brPub bDhPub Nothing SMSubscribe False)
       let bDec = decryptMsgV3 $ C.dh' bSrvDh bDhPriv
-      Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, _SEND $ "reply_id " <> encode bSnd)
+      Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, _SEND $ "reply_id " <> encode (unEntityId bSnd))
       -- "reply_id ..." is ad-hoc, not a part of SMP protocol
 
       Resp "" _ (Msg mId2 msg2) <- tGet1 alice
       Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, ACK mId2)
       Right ["reply_id", bId] <- pure $ B.words <$> aDec mId2 msg2
-      (bId, encode bSnd) #== "reply queue ID received from Bob"
+      (bId, encode (unEntityId bSnd)) #== "reply queue ID received from Bob"
 
       (asPub, asKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, _SEND $ "key " <> strEncode asPub)
@@ -354,7 +354,7 @@ testSwitchSub (ATransport t) =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
+      Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, _SEND "test1")
       (ok1, OK) #== "sent test message 1"
@@ -491,12 +491,12 @@ testWithStoreLog at@(ATransport t) =
     (sPub1, sKey1) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (sPub2, sKey2) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    recipientId1 <- newTVarIO ""
+    recipientId1 <- newTVarIO NoEntity
     recipientKey1 <- newTVarIO Nothing
     dhShared1 <- newTVarIO Nothing
-    senderId1 <- newTVarIO ""
-    senderId2 <- newTVarIO ""
-    notifierId <- newTVarIO ""
+    senderId1 <- newTVarIO NoEntity
+    senderId2 <- newTVarIO NoEntity
+    notifierId <- newTVarIO NoEntity
 
     withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do
       (sId1, rId1, rKey1, dhShared) <- createAndSecureQueue h sPub1
@@ -580,10 +580,10 @@ testRestoreMessages at@(ATransport t) =
 
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    recipientId <- newTVarIO ""
+    recipientId <- newTVarIO NoEntity
     recipientKey <- newTVarIO Nothing
     dhShared <- newTVarIO Nothing
-    senderId <- newTVarIO ""
+    senderId <- newTVarIO NoEntity
 
     withSmpServerStoreMsgLogOn at testPort . runTest t $ \h -> do
       runClient t $ \h1 -> do
@@ -684,10 +684,10 @@ testRestoreExpireMessages at@(ATransport t) =
   it "should store messages on exit and restore on start" $ do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    recipientId <- newTVarIO ""
+    recipientId <- newTVarIO NoEntity
     recipientKey <- newTVarIO Nothing
     dhShared <- newTVarIO Nothing
-    senderId <- newTVarIO ""
+    senderId <- newTVarIO NoEntity
 
     withSmpServerStoreMsgLogOn at testPort . runTest t $ \h -> do
       runClient t $ \h1 -> do
@@ -742,7 +742,7 @@ createAndSecureQueue h sPub = do
   g <- C.newRandom
   (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
   (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-  Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
+  Resp "abcd" NoEntity (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
   let dhShared = C.dh' srvDh dhPriv
   Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, KEY sPub)
   (rId', rId) #== "same queue ID"
@@ -777,7 +777,7 @@ testTiming (ATransport t) =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
+      Resp "abcd" NoEntity (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, SUB)
 
@@ -793,12 +793,12 @@ testTiming (ATransport t) =
 
       runTimingTest sh badKey sId $ _SEND "hello"
       where
-        runTimingTest :: PartyI p => THandleSMP c 'TClient -> C.APrivateAuthKey -> ByteString -> Command p -> IO ()
+        runTimingTest :: PartyI p => THandleSMP c 'TClient -> C.APrivateAuthKey -> EntityId -> Command p -> IO ()
         runTimingTest h badKey qId cmd = do
           threadDelay 100000
           _ <- timeRepeat n $ do
             -- "warm up" the server
-            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", "1234", cmd)
+            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd)
             return ()
           threadDelay 100000
           timeWrongKey <- timeRepeat n $ do
@@ -806,7 +806,7 @@ testTiming (ATransport t) =
             return ()
           threadDelay 100000
           timeNoQueue <- timeRepeat n $ do
-            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", "1234", cmd)
+            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd)
             return ()
           let ok = similarTime timeNoQueue timeWrongKey
           unless ok . putStrLn . unwords $
diff --git a/tests/XFTPServerTests.hs b/tests/XFTPServerTests.hs
index 19713d8b1..9b74cf888 100644
--- a/tests/XFTPServerTests.hs
+++ b/tests/XFTPServerTests.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module XFTPServerTests where
@@ -20,13 +21,13 @@ import Data.List (isInfixOf)
 import ServerTests (logSize)
 import Simplex.FileTransfer.Client
 import Simplex.FileTransfer.Description (kb)
-import Simplex.FileTransfer.Protocol (FileInfo (..))
+import Simplex.FileTransfer.Protocol (FileInfo (..), XFTPFileId)
 import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
 import Simplex.FileTransfer.Transport (XFTPErrorType (..), XFTPRcvChunkSpec (..))
 import Simplex.Messaging.Client (ProtocolClientError (..))
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
-import Simplex.Messaging.Protocol (BasicAuth, SenderId)
+import Simplex.Messaging.Protocol (BasicAuth, EntityId (..), pattern NoEntity)
 import Simplex.Messaging.Server.Expiration (ExpirationConfig (..))
 import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive, removeFile)
 import System.FilePath ((</>))
@@ -74,8 +75,8 @@ createTestChunk fp = do
   B.writeFile fp bytes
   pure bytes
 
-readChunk :: SenderId -> IO ByteString
-readChunk sId = B.readFile (xftpServerFiles </> B.unpack (B64.encode sId))
+readChunk :: XFTPFileId -> IO ByteString
+readChunk sId = B.readFile (xftpServerFiles </> B.unpack (B64.encode $ unEntityId sId))
 
 testFileChunkDelivery :: Expectation
 testFileChunkDelivery = xftpTest $ \c -> runRight_ $ runTestFileChunkDelivery c c
@@ -267,9 +268,9 @@ testFileLog = do
   (rcvKey1, rpKey1) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
   (rcvKey2, rpKey2) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
   digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath
-  sIdVar <- newTVarIO ""
-  rIdVar1 <- newTVarIO ""
-  rIdVar2 <- newTVarIO ""
+  sIdVar <- newTVarIO NoEntity
+  rIdVar1 <- newTVarIO NoEntity
+  rIdVar2 <- newTVarIO NoEntity
 
   threadDelay 100000
 

From d559a66145cf7b4cd367c09974ed1ce8393940b2 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Fri, 30 Aug 2024 12:55:17 +0100
Subject: [PATCH 085/195] 6.0.3.0

---
 CHANGELOG.md    | 11 +++++++++++
 package.yaml    |  2 +-
 simplexmq.cabal |  2 +-
 3 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 15d93378e..5c78253a9 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,14 @@
+# 6.0.3
+
+Agent:
+- fix possible stuck queue rotation (#1290).
+
+SMP server:
+- batch END responses when subscribed client switches to reduce server and client traffic.
+- reduce STM transactions for better performance.
+- add stats for END events and for SUB/DEL event batches.
+- remove "expensive" stats to save memory.
+
 # 6.0.2
 
 SMP agent:
diff --git a/package.yaml b/package.yaml
index 4e1390cb0..610266e82 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.2
+version: 6.0.3.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 59e674987..5426aa4ca 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.2
+version:        6.0.3
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From d5efe3406a5e22ee2c9140b5cd480deffba7576d Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 2 Sep 2024 15:07:16 +0100
Subject: [PATCH 086/195] agent: fix race when sending a message to the deleted
 connection (#1296)

---
 src/Simplex/Messaging/Agent.hs              |  8 ++++----
 src/Simplex/Messaging/Agent/Store/SQLite.hs | 13 ++++++-------
 tests/AgentTests/SQLiteTests.hs             |  2 +-
 3 files changed, 11 insertions(+), 12 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 31a5e4c23..554c39249 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1343,7 +1343,7 @@ enqueueMessageB c reqs = do
     storeSentMsg db cfg req@(cData@ConnData {connId}, sq :| _, pqEnc_, msgFlags, aMessage) = fmap (first storeError) $ runExceptT $ do
       let AgentConfig {smpAgentVRange, e2eEncryptVRange} = cfg
       internalTs <- liftIO getCurrentTime
-      (internalId, internalSndId, prevMsgHash) <- liftIO $ updateSndIds db connId
+      (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
       let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
           agentMsg = AgentMessage privHeader aMessage
           agentMsgStr = smpEncode agentMsg
@@ -2853,7 +2853,7 @@ secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv
       currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config
       withStore c $ \db -> runExceptT $ do
         let agentMsgBody = smpEncode aMessage
-        (_, internalSndId, _) <- liftIO $ updateSndIds db connId
+        (_, internalSndId, _) <- ExceptT $ updateSndIds db connId
         liftIO $ updateSndMsgHash db connId internalSndId (C.sha256Hash agentMsgBody)
         let pqEnc = CR.pqSupportToEnc pqSupport
         (encConnInfo, _) <- agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just pqEnc) currentE2EVersion
@@ -2886,7 +2886,7 @@ storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq
   currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config
   withStore c $ \db -> runExceptT $ do
     internalTs <- liftIO getCurrentTime
-    (internalId, internalSndId, prevMsgHash) <- liftIO $ updateSndIds db connId
+    (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
     let agentMsgStr = smpEncode agentMsg
         internalHash = C.sha256Hash agentMsgStr
         pqEnc = CR.pqSupportToEnc pqSupport
@@ -2912,7 +2912,7 @@ enqueueRatchetKey c cData@ConnData {connId} sq e2eEncryption = do
     storeRatchetKey :: VersionSMPA -> AM InternalId
     storeRatchetKey agentVersion = withStore c $ \db -> runExceptT $ do
       internalTs <- liftIO getCurrentTime
-      (internalId, internalSndId, prevMsgHash) <- liftIO $ updateSndIds db connId
+      (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
       let agentMsg = AgentRatchetInfo ""
           agentMsgStr = smpEncode agentMsg
           internalHash = C.sha256Hash agentMsgStr
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 3209f3674..07074e08f 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -971,12 +971,12 @@ createRcvMsg db connId rq rcvMsgData@RcvMsgData {msgMeta = MsgMeta {sndMsgId}, i
   insertRcvMsgDetails_ db connId rq rcvMsgData
   updateRcvMsgHash db connId sndMsgId internalRcvId internalHash
 
-updateSndIds :: DB.Connection -> ConnId -> IO (InternalId, InternalSndId, PrevSndMsgHash)
-updateSndIds db connId = do
-  (lastInternalId, lastInternalSndId, prevSndHash) <- retrieveLastIdsAndHashSnd_ db connId
+updateSndIds :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
+updateSndIds db connId = runExceptT $ do
+  (lastInternalId, lastInternalSndId, prevSndHash) <- ExceptT $ retrieveLastIdsAndHashSnd_ db connId
   let internalId = InternalId $ unId lastInternalId + 1
       internalSndId = InternalSndId $ unSndId lastInternalSndId + 1
-  updateLastIdsSnd_ db connId internalId internalSndId
+  liftIO $ updateLastIdsSnd_ db connId internalId internalSndId
   pure (internalId, internalSndId, prevSndHash)
 
 createSndMsg :: DB.Connection -> ConnId -> SndMsgData -> IO ()
@@ -2219,9 +2219,9 @@ updateRcvMsgHash db connId sndMsgId internalRcvId internalHash =
 
 -- * updateSndIds helpers
 
-retrieveLastIdsAndHashSnd_ :: DB.Connection -> ConnId -> IO (InternalId, InternalSndId, PrevSndMsgHash)
+retrieveLastIdsAndHashSnd_ :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
 retrieveLastIdsAndHashSnd_ dbConn connId = do
-  [(lastInternalId, lastInternalSndId, lastSndHash)] <-
+  firstRow id SEConnNotFound $
     DB.queryNamed
       dbConn
       [sql|
@@ -2230,7 +2230,6 @@ retrieveLastIdsAndHashSnd_ dbConn connId = do
         WHERE conn_id = :conn_id;
       |]
       [":conn_id" := connId]
-  return (lastInternalId, lastInternalSndId, lastSndHash)
 
 updateLastIdsSnd_ :: DB.Connection -> ConnId -> InternalId -> InternalSndId -> IO ()
 updateLastIdsSnd_ dbConn connId newInternalId newInternalSndId =
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index f376477a6..4a8d80dd4 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -556,7 +556,7 @@ mkSndMsgData internalId internalSndId internalHash =
 testCreateSndMsg_ :: DB.Connection -> PrevSndMsgHash -> ConnId -> SndQueue -> SndMsgData -> Expectation
 testCreateSndMsg_ db expectedPrevHash connId sq sndMsgData@SndMsgData {..} = do
   updateSndIds db connId
-    `shouldReturn` (internalId, internalSndId, expectedPrevHash)
+    `shouldReturn` Right (internalId, internalSndId, expectedPrevHash)
   createSndMsg db connId sndMsgData
     `shouldReturn` ()
   createSndMsgDelivery db connId sq internalId

From d84a49b85a165bdbcd6ae6cca386eb2d01724542 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 2 Sep 2024 17:06:31 +0100
Subject: [PATCH 087/195] smp server: split and reduce STM transactions (#1294)

---
 src/Simplex/Messaging/Server.hs               | 47 +++++++++----------
 src/Simplex/Messaging/Server/MsgStore/STM.hs  | 45 +++++++++---------
 .../Messaging/Server/QueueStore/STM.hs        | 34 +++++++-------
 src/Simplex/Messaging/Transport/HTTP2.hs      |  1 -
 4 files changed, 62 insertions(+), 65 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index d796d8e6c..e84f26a5a 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -247,7 +247,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
         rIds <- M.keysSet <$> readTVarIO ms
         forM_ rIds $ \rId -> do
           q <- liftIO $ getMsgQueue ms rId quota
-          deleted <- atomically $ deleteExpiredMsgs q old
+          deleted <- liftIO $ deleteExpiredMsgs q old
           liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
 
     serverStatsThread_ :: ServerConfig -> [M ()]
@@ -623,10 +623,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
               CPDelete queueId' -> withUserRole $ unliftIO u $ do
                 st <- asks queueStore
                 ms <- asks msgStore
-                queueId <- atomically (getQueue st SSender queueId') >>= \case
+                queueId <- liftIO (getQueue st SSender queueId') >>= \case
                   Left _ -> pure queueId' -- fallback to using as recipientId directly
                   Right QueueRec {recipientId} -> pure recipientId
-                r <- atomically $
+                r <- liftIO $
                   deleteQueue st queueId $>>= \q ->
                     Right . (q,) <$> delMsgQueueSize ms queueId
                 case r of
@@ -832,7 +832,7 @@ verifyTransmission auth_ tAuth authorized queueId cmd =
     get :: DirectParty p => SParty p -> M (Either ErrorType QueueRec)
     get party = do
       st <- asks queueStore
-      atomically $ getQueue st party queueId
+      liftIO $ getQueue st party queueId
 
 verifyCmdAuthorization :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> C.APublicAuthKey -> Bool
 verifyCmdAuthorization auth_ tAuth authorized key = maybe False (verify key) tAuth
@@ -1039,11 +1039,11 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
               ids@(rId, _) <- getIds
               -- create QueueRec record with these ids and keys
               let qr = qRec ids
-              atomically (addQueue st qr) >>= \case
+              liftIO (addQueue st qr) >>= \case
                 Left DUPLICATE_ -> addQueueRetry (n - 1) qik qRec
                 Left e -> pure $ ERR e
-                Right _ -> do
-                  withLog (`logCreateById` rId)
+                Right () -> do
+                  withLog (`logCreateQueue` qr)
                   stats <- asks serverStats
                   incStat $ qCreated stats
                   incStat $ qCount stats
@@ -1052,12 +1052,6 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                     SMSubscribe -> void $ subscribeQueue qr rId
                   pure $ IDS (qik ids)
 
-            logCreateById :: StoreLog 'WriteMode -> RecipientId -> IO ()
-            logCreateById s rId =
-              atomically (getQueue st SRecipient rId) >>= \case
-                Right q -> logCreateQueue s q
-                _ -> pure ()
-
             getIds :: M (RecipientId, SenderId)
             getIds = do
               n <- asks $ queueIdBytes . config
@@ -1069,7 +1063,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           st <- asks queueStore
           stats <- asks serverStats
           incStat $ qSecured stats
-          atomically $ either ERR (const OK) <$> secureQueue st rId sKey
+          liftIO $ either ERR (const OK) <$> secureQueue st rId sKey
 
         addQueueNotifier_ :: QueueStore -> NtfPublicAuthKey -> RcvNtfPublicDhKey -> M (Transmission BrokerMsg)
         addQueueNotifier_ st notifierKey dhKey = time "NKEY" $ do
@@ -1082,7 +1076,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             addNotifierRetry n rcvPublicDhKey rcvNtfDhSecret = do
               notifierId <- randomId =<< asks (queueIdBytes . config)
               let ntfCreds = NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}
-              atomically (addQueueNotifier st entId ntfCreds) >>= \case
+              liftIO (addQueueNotifier st entId ntfCreds) >>= \case
                 Left DUPLICATE_ -> addNotifierRetry (n - 1) rcvPublicDhKey rcvNtfDhSecret
                 Left e -> pure $ ERR e
                 Right _ -> do
@@ -1093,7 +1087,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
         deleteQueueNotifier_ :: QueueStore -> M (Transmission BrokerMsg)
         deleteQueueNotifier_ st = do
           withLog (`logDeleteNotifier` entId)
-          atomically (deleteQueueNotifier st entId) >>= \case
+          liftIO (deleteQueueNotifier st entId) >>= \case
             Right () -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
               atomically $ writeTQueue ntfSubscribedQ (entId, clnt, False)
@@ -1104,7 +1098,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
         suspendQueue_ :: QueueStore -> M (Transmission BrokerMsg)
         suspendQueue_ st = do
           withLog (`logSuspendQueue` entId)
-          okResp <$> atomically (suspendQueue st entId)
+          okResp <$> liftIO (suspendQueue st entId)
 
         subscribeQueue :: QueueRec -> RecipientId -> M (Transmission BrokerMsg)
         subscribeQueue qr rId = do
@@ -1130,7 +1124,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             deliver :: Bool -> Sub -> M (Transmission BrokerMsg)
             deliver inc sub = do
               q <- getStoreMsgQueue "SUB" rId
-              msg_ <- atomically $ tryPeekMsg q
+              msg_ <- liftIO $ tryPeekMsgIO q
               when (inc && isJust msg_) $
                 incStat . qSub =<< asks serverStats
               deliverMessage "SUB" qr rId sub msg_
@@ -1161,6 +1155,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
               q <- getStoreMsgQueue "GET" entId
               stats <- asks serverStats
               (statCnt, r) <-
+                -- TODO split STM, use tryPeekMsgIO
                 atomically $
                   tryPeekMsg q >>= \case
                     Just msg ->
@@ -1199,11 +1194,11 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                   q <- getStoreMsgQueue "ACK" entId
                   case st of
                     ProhibitSub -> do
-                      deletedMsg_ <- atomically $ tryDelMsg q msgId
+                      deletedMsg_ <- liftIO $ tryDelMsg q msgId
                       mapM_ (updateStats True) deletedMsg_
                       pure ok
                     _ -> do
-                      (deletedMsg_, msg_) <- atomically $ tryDelPeekMsg q msgId
+                      (deletedMsg_, msg_) <- liftIO $ tryDelPeekMsg q msgId
                       mapM_ (updateStats False) deletedMsg_
                       deliverMessage "ACK" qr entId sub msg_
                 _ -> pure $ err NO_MSG
@@ -1246,7 +1241,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                       msg_ <- time "SEND" $ do
                         q <- getStoreMsgQueue "SEND" $ recipientId qr
                         expireMessages q
-                        atomically . writeMsg q =<< mkMessage body
+                        liftIO . writeMsg q =<< mkMessage body
                       case msg_ of
                         Nothing -> do
                           incStat $ msgSentQuota stats
@@ -1273,7 +1268,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             expireMessages q = do
               msgExp <- asks $ messageExpiration . config
               old <- liftIO $ mapM expireBeforeEpoch msgExp
-              deleted <- atomically $ sum <$> mapM (deleteExpiredMsgs q) old
+              deleted <- liftIO $ sum <$> mapM (deleteExpiredMsgs q) old
               when (deleted > 0) $ do
                 stats <- asks serverStats
                 liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
@@ -1290,6 +1285,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             tryDeliverMessage msg = atomically deliverToSub >>= mapM_ forkDeliver
               where
                 rId = recipientId qr
+                -- TODO split to multiple STM transactions, move lookups to IO
+                -- remove tryPeekMsg
                 deliverToSub =
                   TM.lookup rId subscribers
                     $>>= \rc@Client {subscriptions = subs, sndQ = q} -> TM.lookup rId subs
@@ -1450,7 +1447,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
         delQueueAndMsgs st = do
           withLog (`logDeleteQueue` entId)
           ms <- asks msgStore
-          atomically (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case
+          liftIO (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case
             Right q -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
               atomically $ writeTQueue subscribedQ (entId, clnt, False)
@@ -1465,7 +1462,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           q <- getStoreMsgQueue "getQueueInfo" entId
           qiSub <- liftIO $ TM.lookupIO entId subscriptions >>= mapM mkQSub
           qiSize <- liftIO $ getQueueSize q
-          qiMsg <- atomically $ toMsgInfo <$$> tryPeekMsg q
+          qiMsg <- liftIO $ toMsgInfo <$$> tryPeekMsgIO q
           let info = QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
           pure (corrId, entId, INFO info)
           where
@@ -1571,7 +1568,7 @@ restoreServerMessages =
             s = LB.toStrict s'
             addToMsgQueue rId msg = do
               q <- liftIO $ getMsgQueue ms rId quota
-              (isExpired, logFull) <- atomically $ case msg of
+              (isExpired, logFull) <- liftIO $ case msg of
                 Message {msgTs}
                   | maybe True (systemSeconds msgTs >=) old_ -> (False,) . isNothing <$> writeMsg q msg
                   | otherwise -> pure (True, False)
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index 04447292a..de994c17a 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -16,7 +16,7 @@ module Simplex.Messaging.Server.MsgStore.STM
     delMsgQueueSize,
     writeMsg,
     tryPeekMsg,
-    peekMsg,
+    tryPeekMsgIO,
     tryDelMsg,
     tryDelPeekMsg,
     deleteExpiredMsgs,
@@ -61,14 +61,14 @@ getMsgQueue st rId quota = TM.lookupIO rId st >>= maybe (atomically maybeNewQ) p
       TM.insert rId q st
       pure q
 
-delMsgQueue :: STMMsgStore -> RecipientId -> STM ()
-delMsgQueue st rId = TM.delete rId st
+delMsgQueue :: STMMsgStore -> RecipientId -> IO ()
+delMsgQueue st rId = atomically $ TM.delete rId st
 
-delMsgQueueSize :: STMMsgStore -> RecipientId -> STM Int
-delMsgQueueSize st rId = TM.lookupDelete rId st >>= maybe (pure 0) (\MsgQueue {size} -> readTVar size)
+delMsgQueueSize :: STMMsgStore -> RecipientId -> IO Int
+delMsgQueueSize st rId = atomically (TM.lookupDelete rId st) >>= maybe (pure 0) (\MsgQueue {size} -> readTVarIO size)
 
-writeMsg :: MsgQueue -> Message -> STM (Maybe (Message, Bool))
-writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = do
+writeMsg :: MsgQueue -> Message -> IO (Maybe (Message, Bool))
+writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = atomically $ do
   canWrt <- readTVar canWrite
   empty <- isEmptyTQueue q
   if canWrt || empty
@@ -83,43 +83,44 @@ writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = do
   where
     msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
 
+tryPeekMsgIO :: MsgQueue -> IO (Maybe Message)
+tryPeekMsgIO = atomically . tryPeekTQueue . msgQueue
+{-# INLINE tryPeekMsgIO #-}
+
+-- TODO remove once deliverToSub is split
 tryPeekMsg :: MsgQueue -> STM (Maybe Message)
 tryPeekMsg = tryPeekTQueue . msgQueue
 {-# INLINE tryPeekMsg #-}
 
-peekMsg :: MsgQueue -> STM Message
-peekMsg = peekTQueue . msgQueue
-{-# INLINE peekMsg #-}
-
-tryDelMsg :: MsgQueue -> MsgId -> STM (Maybe Message)
-tryDelMsg mq msgId' =
+tryDelMsg :: MsgQueue -> MsgId -> IO (Maybe Message)
+tryDelMsg mq msgId' = atomically $
   tryPeekMsg mq >>= \case
     msg_@(Just msg)
-      | msgId msg == msgId' || B.null msgId' -> tryDeleteMsg mq >> pure msg_
+      | msgId msg == msgId' || B.null msgId' -> tryDeleteMsg_ mq >> pure msg_
       | otherwise -> pure Nothing
     _ -> pure Nothing
 
 -- atomic delete (== read) last and peek next message if available
-tryDelPeekMsg :: MsgQueue -> MsgId -> STM (Maybe Message, Maybe Message)
-tryDelPeekMsg mq msgId' =
+tryDelPeekMsg :: MsgQueue -> MsgId -> IO (Maybe Message, Maybe Message)
+tryDelPeekMsg mq msgId' = atomically $
   tryPeekMsg mq >>= \case
     msg_@(Just msg)
-      | msgId msg == msgId' || B.null msgId' -> (msg_,) <$> (tryDeleteMsg mq >> tryPeekMsg mq)
+      | msgId msg == msgId' || B.null msgId' -> (msg_,) <$> (tryDeleteMsg_ mq >> tryPeekMsg mq)
       | otherwise -> pure (Nothing, msg_)
     _ -> pure (Nothing, Nothing)
 
-deleteExpiredMsgs :: MsgQueue -> Int64 -> STM Int
-deleteExpiredMsgs mq old = loop 0
+deleteExpiredMsgs :: MsgQueue -> Int64 -> IO Int
+deleteExpiredMsgs mq old = atomically $ loop 0
   where
     loop dc =
       tryPeekMsg mq >>= \case
         Just Message {msgTs}
           | systemSeconds msgTs < old ->
-              tryDeleteMsg mq >> loop (dc + 1)
+              tryDeleteMsg_ mq >> loop (dc + 1)
         _ -> pure dc
 
-tryDeleteMsg :: MsgQueue -> STM ()
-tryDeleteMsg MsgQueue {msgQueue = q, size} =
+tryDeleteMsg_ :: MsgQueue -> STM ()
+tryDeleteMsg_ MsgQueue {msgQueue = q, size} =
   tryReadTQueue q >>= \case
     Just _ -> modifyTVar' size (subtract 1)
     _ -> pure ()
diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index 50907cf9a..3a1385269 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -45,8 +45,8 @@ newQueueStore = do
   notifiers <- TM.emptyIO
   pure QueueStore {queues, senders, notifiers}
 
-addQueue :: QueueStore -> QueueRec -> STM (Either ErrorType ())
-addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId = sId} = do
+addQueue :: QueueStore -> QueueRec -> IO (Either ErrorType ())
+addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId = sId} = atomically $ do
   ifM hasId (pure $ Left DUPLICATE_) $ do
     qVar <- newTVar q
     TM.insert rId qVar queues
@@ -55,26 +55,26 @@ addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId =
   where
     hasId = (||) <$> TM.member rId queues <*> TM.member sId senders
 
-getQueue :: DirectParty p => QueueStore -> SParty p -> QueueId -> STM (Either ErrorType QueueRec)
+getQueue :: DirectParty p => QueueStore -> SParty p -> QueueId -> IO (Either ErrorType QueueRec)
 getQueue QueueStore {queues, senders, notifiers} party qId =
-  toResult <$> (mapM readTVar =<< getVar)
+  toResult <$> (mapM readTVarIO =<< getVar)
   where
     getVar = case party of
-      SRecipient -> TM.lookup qId queues
-      SSender -> TM.lookup qId senders $>>= (`TM.lookup` queues)
-      SNotifier -> TM.lookup qId notifiers $>>= (`TM.lookup` queues)
+      SRecipient -> TM.lookupIO qId queues
+      SSender -> TM.lookupIO qId senders $>>= (`TM.lookupIO` queues)
+      SNotifier -> TM.lookupIO qId notifiers $>>= (`TM.lookupIO` queues)
 
-secureQueue :: QueueStore -> RecipientId -> SndPublicAuthKey -> STM (Either ErrorType QueueRec)
+secureQueue :: QueueStore -> RecipientId -> SndPublicAuthKey -> IO (Either ErrorType QueueRec)
 secureQueue QueueStore {queues} rId sKey =
-  withQueue rId queues $ \qVar ->
+  atomically $ withQueue rId queues $ \qVar ->
     readTVar qVar >>= \q -> case senderKey q of
       Just k -> pure $ if sKey == k then Just q else Nothing
       _ ->
         let !q' = q {senderKey = Just sKey}
          in writeTVar qVar q' $> Just q'
 
-addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> STM (Either ErrorType QueueRec)
-addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = do
+addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType QueueRec)
+addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = atomically $ do
   ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $
     withQueue rId queues $ \qVar -> do
       q <- readTVar qVar
@@ -83,20 +83,20 @@ addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierI
       TM.insert nId rId notifiers
       pure $ Just q
 
-deleteQueueNotifier :: QueueStore -> RecipientId -> STM (Either ErrorType ())
+deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType ())
 deleteQueueNotifier QueueStore {queues, notifiers} rId =
-  withQueue rId queues $ \qVar -> do
+  atomically $ withQueue rId queues $ \qVar -> do
     q <- readTVar qVar
     forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers
     writeTVar qVar $! q {notifier = Nothing}
     pure $ Just ()
 
-suspendQueue :: QueueStore -> RecipientId -> STM (Either ErrorType ())
+suspendQueue :: QueueStore -> RecipientId -> IO (Either ErrorType ())
 suspendQueue QueueStore {queues} rId =
-  withQueue rId queues $ \qVar -> modifyTVar' qVar (\q -> q {status = QueueOff}) $> Just ()
+  atomically $ withQueue rId queues $ \qVar -> modifyTVar' qVar (\q -> q {status = QueueOff}) $> Just ()
 
-deleteQueue :: QueueStore -> RecipientId -> STM (Either ErrorType QueueRec)
-deleteQueue QueueStore {queues, senders, notifiers} rId = do
+deleteQueue :: QueueStore -> RecipientId -> IO (Either ErrorType QueueRec)
+deleteQueue QueueStore {queues, senders, notifiers} rId = atomically $ do
   TM.lookupDelete rId queues >>= \case
     Just qVar ->
       readTVar qVar >>= \q -> do
diff --git a/src/Simplex/Messaging/Transport/HTTP2.hs b/src/Simplex/Messaging/Transport/HTTP2.hs
index 3b741e6ce..10522c5bc 100644
--- a/src/Simplex/Messaging/Transport/HTTP2.hs
+++ b/src/Simplex/Messaging/Transport/HTTP2.hs
@@ -2,7 +2,6 @@
 
 module Simplex.Messaging.Transport.HTTP2 where
 
-import Control.Concurrent.STM
 import qualified Control.Exception as E
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B

From 137ebc1cadae3c461e0ba3ea889e478d5fcb2ca5 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 2 Sep 2024 23:12:08 +0100
Subject: [PATCH 088/195] servers: reduce memory used for period stats (#1298)

---
 package.yaml                                  |  1 +
 simplexmq.cabal                               |  6 ++
 src/Simplex/FileTransfer/Server/Stats.hs      |  5 +-
 src/Simplex/Messaging/Encoding/String.hs      | 16 ++--
 .../Messaging/Notifications/Server/Stats.hs   | 10 +--
 src/Simplex/Messaging/Server.hs               |  3 +-
 src/Simplex/Messaging/Server/Stats.hs         | 75 ++++++++++---------
 tests/ServerTests.hs                          |  9 ++-
 8 files changed, 71 insertions(+), 54 deletions(-)

diff --git a/package.yaml b/package.yaml
index 610266e82..26936b4af 100644
--- a/package.yaml
+++ b/package.yaml
@@ -47,6 +47,7 @@ dependencies:
   - direct-sqlcipher == 2.3.*
   - directory == 1.3.*
   - filepath == 1.4.*
+  - hashable == 1.4.*
   - hourglass == 0.2.*
   - http-types == 0.12.*
   - http2 >= 4.2.2 && < 4.3
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 5426aa4ca..90b507f3c 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -236,6 +236,7 @@ library
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -310,6 +311,7 @@ executable ntf-server
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -389,6 +391,7 @@ executable smp-server
     , directory ==1.3.*
     , file-embed
     , filepath ==1.4.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -467,6 +470,7 @@ executable xftp
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -542,6 +546,7 @@ executable xftp-server
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -653,6 +658,7 @@ test-suite simplexmq-test
     , directory ==1.3.*
     , filepath ==1.4.*
     , generic-random ==1.5.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , hspec ==2.11.*
     , hspec-core ==2.11.*
diff --git a/src/Simplex/FileTransfer/Server/Stats.hs b/src/Simplex/FileTransfer/Server/Stats.hs
index 8737e6f78..a7951a65a 100644
--- a/src/Simplex/FileTransfer/Server/Stats.hs
+++ b/src/Simplex/FileTransfer/Server/Stats.hs
@@ -11,7 +11,6 @@ import Data.IORef
 import Data.Int (Int64)
 import Data.Time.Clock (UTCTime)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (SenderId)
 import Simplex.Messaging.Server.Stats (PeriodStats, PeriodStatsData, getPeriodStatsData, newPeriodStats, setPeriodStats)
 
 data FileServerStats = FileServerStats
@@ -21,7 +20,7 @@ data FileServerStats = FileServerStats
     filesUploaded :: IORef Int,
     filesExpired :: IORef Int,
     filesDeleted :: IORef Int,
-    filesDownloaded :: PeriodStats SenderId,
+    filesDownloaded :: PeriodStats,
     fileDownloads :: IORef Int,
     fileDownloadAcks :: IORef Int,
     filesCount :: IORef Int,
@@ -35,7 +34,7 @@ data FileServerStatsData = FileServerStatsData
     _filesUploaded :: Int,
     _filesExpired :: Int,
     _filesDeleted :: Int,
-    _filesDownloaded :: PeriodStatsData SenderId,
+    _filesDownloaded :: PeriodStatsData,
     _fileDownloads :: Int,
     _fileDownloadAcks :: Int,
     _filesCount :: Int,
diff --git a/src/Simplex/Messaging/Encoding/String.hs b/src/Simplex/Messaging/Encoding/String.hs
index 8995b9679..97e7d087b 100644
--- a/src/Simplex/Messaging/Encoding/String.hs
+++ b/src/Simplex/Messaging/Encoding/String.hs
@@ -28,6 +28,8 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (isAlphaNum)
 import Data.Int (Int64)
+import Data.IntSet (IntSet)
+import qualified Data.IntSet as IS
 import qualified Data.List.NonEmpty as L
 import Data.Set (Set)
 import qualified Data.Set as S
@@ -39,7 +41,7 @@ import Data.Time.Format.ISO8601
 import Data.Word (Word16, Word32)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Util ((<$?>))
+import Simplex.Messaging.Util (bshow, (<$?>))
 
 class TextEncoding a where
   textEncode :: a -> Text
@@ -125,15 +127,15 @@ instance StrEncoding Bool where
   {-# INLINE strP #-}
 
 instance StrEncoding Int where
-  strEncode = B.pack . show
+  strEncode = bshow
   {-# INLINE strEncode #-}
-  strP = A.decimal
+  strP = A.signed A.decimal
   {-# INLINE strP #-}
 
 instance StrEncoding Int64 where
-  strEncode = B.pack . show
+  strEncode = bshow
   {-# INLINE strEncode #-}
-  strP = A.decimal
+  strP = A.signed A.decimal
   {-# INLINE strP #-}
 
 instance StrEncoding SystemTime where
@@ -160,6 +162,10 @@ instance (StrEncoding a, Ord a) => StrEncoding (Set a) where
   strEncode = strEncodeList . S.toList
   strP = S.fromList <$> listItem `A.sepBy'` A.char ','
 
+instance StrEncoding IntSet where
+  strEncode = strEncodeList . IS.toList
+  strP = IS.fromList <$> listItem `A.sepBy'` A.char ','
+
 listItem :: StrEncoding a => Parser a
 listItem = parseAll strP <$?> A.takeTill (\c -> c == ',' || c == ' ' || c == '\n')
 
diff --git a/src/Simplex/Messaging/Notifications/Server/Stats.hs b/src/Simplex/Messaging/Notifications/Server/Stats.hs
index 2c469e335..d05257664 100644
--- a/src/Simplex/Messaging/Notifications/Server/Stats.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Stats.hs
@@ -10,8 +10,6 @@ import qualified Data.ByteString.Char8 as B
 import Data.IORef
 import Data.Time.Clock (UTCTime)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Notifications.Protocol (NtfTokenId)
-import Simplex.Messaging.Protocol (NotifierId)
 import Simplex.Messaging.Server.Stats
 
 data NtfServerStats = NtfServerStats
@@ -23,8 +21,8 @@ data NtfServerStats = NtfServerStats
     subDeleted :: IORef Int,
     ntfReceived :: IORef Int,
     ntfDelivered :: IORef Int,
-    activeTokens :: PeriodStats NtfTokenId,
-    activeSubs :: PeriodStats NotifierId
+    activeTokens :: PeriodStats,
+    activeSubs :: PeriodStats
   }
 
 data NtfServerStatsData = NtfServerStatsData
@@ -36,8 +34,8 @@ data NtfServerStatsData = NtfServerStatsData
     _subDeleted :: Int,
     _ntfReceived :: Int,
     _ntfDelivered :: Int,
-    _activeTokens :: PeriodStatsData NtfTokenId,
-    _activeSubs :: PeriodStatsData NotifierId
+    _activeTokens :: PeriodStatsData,
+    _activeSubs :: PeriodStatsData
   }
 
 newNtfServerStats :: UTCTime -> IO NtfServerStats
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index e84f26a5a..d5ba6695f 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -62,7 +62,6 @@ import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
-import qualified Data.Set as S
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
@@ -472,7 +471,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                 putStat "qDeletedAllB" qDeletedAllB
                 putStat "qDeletedNew" qDeletedNew
                 putStat "qDeletedSecured" qDeletedSecured
-                getStat (day . activeQueues) >>= \v -> hPutStrLn h $ "daily active queues: " <> show (S.size v)
+                getStat (day . activeQueues) >>= \v -> hPutStrLn h $ "daily active queues: " <> show (IS.size v)
                 -- removed to reduce memory usage
                 -- getStat (day . subscribedQueues) >>= \v -> hPutStrLn h $ "daily subscribed queues: " <> show (S.size v)
                 putStat "qSub" qSub
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index 60f55100e..097ddb607 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -10,8 +10,12 @@ module Simplex.Messaging.Server.Stats where
 
 import Control.Applicative (optional, (<|>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Hashable (hash)
 import Data.IORef
+import Data.IntSet (IntSet)
+import qualified Data.IntSet as IS
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Time.Calendar.Month (pattern MonthDay)
@@ -19,7 +23,7 @@ import Data.Time.Calendar.OrdinalDate (mondayStartWeek)
 import Data.Time.Clock (UTCTime (..))
 import GHC.IORef (atomicSwapIORef)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (RecipientId)
+import Simplex.Messaging.Protocol (EntityId (..))
 import Simplex.Messaging.Util (atomicModifyIORef'_, unlessM)
 
 data ServerStats = ServerStats
@@ -57,11 +61,11 @@ data ServerStats = ServerStats
     msgGetDuplicate :: IORef Int,
     msgGetProhibited :: IORef Int,
     msgExpired :: IORef Int,
-    activeQueues :: PeriodStats RecipientId,
-    -- subscribedQueues :: PeriodStats RecipientId, -- this stat uses too much memory
+    activeQueues :: PeriodStats,
+    -- subscribedQueues :: PeriodStats, -- this stat uses too much memory
     msgSentNtf :: IORef Int, -- sent messages with NTF flag
     msgRecvNtf :: IORef Int, -- received messages with NTF flag
-    activeQueuesNtf :: PeriodStats RecipientId,
+    activeQueuesNtf :: PeriodStats,
     msgNtfs :: IORef Int, -- messages notications delivered to NTF server (<= msgSentNtf)
     msgNtfNoSub :: IORef Int, -- no subscriber to notifications (e.g., NTF server not connected)
     msgNtfLost :: IORef Int, -- notification is lost because NTF delivery queue is full
@@ -108,10 +112,10 @@ data ServerStatsData = ServerStatsData
     _msgGetDuplicate :: Int,
     _msgGetProhibited :: Int,
     _msgExpired :: Int,
-    _activeQueues :: PeriodStatsData RecipientId,
+    _activeQueues :: PeriodStatsData,
     _msgSentNtf :: Int,
     _msgRecvNtf :: Int,
-    _activeQueuesNtf :: PeriodStatsData RecipientId,
+    _activeQueuesNtf :: PeriodStatsData,
     _msgNtfs :: Int,
     _msgNtfNoSub :: Int,
     _msgNtfLost :: Int,
@@ -483,7 +487,7 @@ instance StrEncoding ServerStatsData where
           pure PeriodStatsData {_day, _week, _month}
     _subscribedQueues <-
       optional ("subscribedQueues:" <* A.endOfLine) >>= \case
-        Just _ -> newPeriodStatsData <$ (strP @(PeriodStatsData RecipientId) <* optional A.endOfLine)
+        Just _ -> newPeriodStatsData <$ (strP @PeriodStatsData <* optional A.endOfLine)
         _ -> pure newPeriodStatsData
     _activeQueuesNtf <-
       optional ("activeQueuesNtf:" <* A.endOfLine) >>= \case
@@ -552,30 +556,30 @@ instance StrEncoding ServerStatsData where
           Just _ -> strP <* optional A.endOfLine
           _ -> pure newProxyStatsData
 
-data PeriodStats a = PeriodStats
-  { day :: IORef (Set a),
-    week :: IORef (Set a),
-    month :: IORef (Set a)
+data PeriodStats = PeriodStats
+  { day :: IORef IntSet,
+    week :: IORef IntSet,
+    month :: IORef IntSet
   }
 
-newPeriodStats :: IO (PeriodStats a)
+newPeriodStats :: IO PeriodStats
 newPeriodStats = do
-  day <- newIORef S.empty
-  week <- newIORef S.empty
-  month <- newIORef S.empty
+  day <- newIORef IS.empty
+  week <- newIORef IS.empty
+  month <- newIORef IS.empty
   pure PeriodStats {day, week, month}
 
-data PeriodStatsData a = PeriodStatsData
-  { _day :: Set a,
-    _week :: Set a,
-    _month :: Set a
+data PeriodStatsData = PeriodStatsData
+  { _day :: IntSet,
+    _week :: IntSet,
+    _month :: IntSet
   }
   deriving (Show)
 
-newPeriodStatsData :: PeriodStatsData a
-newPeriodStatsData = PeriodStatsData {_day = S.empty, _week = S.empty, _month = S.empty}
+newPeriodStatsData :: PeriodStatsData
+newPeriodStatsData = PeriodStatsData {_day = IS.empty, _week = IS.empty, _month = IS.empty}
 
-getPeriodStatsData :: PeriodStats a -> IO (PeriodStatsData a)
+getPeriodStatsData :: PeriodStats -> IO PeriodStatsData
 getPeriodStatsData s = do
   _day <- readIORef $ day s
   _week <- readIORef $ week s
@@ -583,20 +587,22 @@ getPeriodStatsData s = do
   pure PeriodStatsData {_day, _week, _month}
 
 -- this function is not thread safe, it is used on server start only
-setPeriodStats :: PeriodStats a -> PeriodStatsData a -> IO ()
+setPeriodStats :: PeriodStats -> PeriodStatsData -> IO ()
 setPeriodStats s d = do
   writeIORef (day s) $! _day d
   writeIORef (week s) $! _week d
   writeIORef (month s) $! _month d
 
-instance (Ord a, StrEncoding a) => StrEncoding (PeriodStatsData a) where
+instance StrEncoding PeriodStatsData where
   strEncode PeriodStatsData {_day, _week, _month} =
-    "day=" <> strEncode _day <> "\nweek=" <> strEncode _week <> "\nmonth=" <> strEncode _month
+    "dayHashes=" <> strEncode _day <> "\nweekHashes=" <> strEncode _week <> "\nmonthHashes=" <> strEncode _month
   strP = do
-    _day <- "day=" *> strP <* A.endOfLine
-    _week <- "week=" *> strP <* A.endOfLine
-    _month <- "month=" *> strP
+    _day <- ("day=" *> bsSetP <|> "dayHashes=" *> strP) <* A.endOfLine
+    _week <- ("week=" *> bsSetP <|> "weekHashes=" *> strP) <* A.endOfLine
+    _month <- "month=" *> bsSetP <|> "monthHashes=" *> strP
     pure PeriodStatsData {_day, _week, _month}
+    where
+      bsSetP = S.foldl' (\s -> (`IS.insert` s) . hash) IS.empty <$> strP @(Set ByteString)
 
 data PeriodStatCounts = PeriodStatCounts
   { dayCount :: String,
@@ -604,7 +610,7 @@ data PeriodStatCounts = PeriodStatCounts
     monthCount :: String
   }
 
-periodStatCounts :: forall a. PeriodStats a -> UTCTime -> IO PeriodStatCounts
+periodStatCounts :: PeriodStats -> UTCTime -> IO PeriodStatCounts
 periodStatCounts ps ts = do
   let d = utctDay ts
       (_, wDay) = mondayStartWeek d
@@ -614,17 +620,18 @@ periodStatCounts ps ts = do
   monthCount <- periodCount mDay $ month ps
   pure PeriodStatCounts {dayCount, weekCount, monthCount}
   where
-    periodCount :: Int -> IORef (Set a) -> IO String
-    periodCount 1 ref = show . S.size <$> atomicSwapIORef ref S.empty
+    periodCount :: Int -> IORef IntSet -> IO String
+    periodCount 1 ref = show . IS.size <$> atomicSwapIORef ref IS.empty
     periodCount _ _ = pure ""
 
-updatePeriodStats :: Ord a => PeriodStats a -> a -> IO ()
-updatePeriodStats ps pId = do
+updatePeriodStats :: PeriodStats -> EntityId -> IO ()
+updatePeriodStats ps (EntityId pId) = do
   updatePeriod $ day ps
   updatePeriod $ week ps
   updatePeriod $ month ps
   where
-    updatePeriod ref = unlessM (S.member pId <$> readIORef ref) $ atomicModifyIORef'_ ref $ S.insert pId
+    ph = hash pId
+    updatePeriod ref = unlessM (IS.member ph <$> readIORef ref) $ atomicModifyIORef'_ ref $ IS.insert ph
 
 data ProxyStats = ProxyStats
   { pRequests :: IORef Int,
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index d3154e228..63508a033 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -25,7 +25,8 @@ import Data.Bifunctor (first)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.Set as S
+import Data.Hashable (hash)
+import qualified Data.IntSet as IS
 import Data.Type.Equality
 import GHC.Stack (withFrozenCallStack)
 import SMPClient
@@ -675,9 +676,9 @@ checkStats s qs sent received = do
   _msgSentNtf s `shouldBe` 0
   _msgRecvNtf s `shouldBe` 0
   let PeriodStatsData {_day, _week, _month} = _activeQueues s
-  S.toList _day `shouldBe` qs
-  S.toList _week `shouldBe` qs
-  S.toList _month `shouldBe` qs
+  IS.toList _day `shouldBe` map (hash . unEntityId) qs
+  IS.toList _week `shouldBe` map (hash . unEntityId) qs
+  IS.toList _month `shouldBe` map (hash . unEntityId) qs
 
 testRestoreExpireMessages :: ATransport -> Spec
 testRestoreExpireMessages at@(ATransport t) =

From e86338d5555fd3c9daf21a904a18b66a63c632fa Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 5 Sep 2024 13:25:41 +0100
Subject: [PATCH 089/195] smp server: fewer map updates on re-subscriptions
 (#1297)

* smp server: fewer map updates on re-subscriptions

* temp version

* replace Client with ClientId in queues

* version

* version

* comments

* reduce threads when sending ENDs

* revert version
---
 simplexmq.cabal                         |   2 +-
 src/Simplex/Messaging/Server.hs         | 178 +++++++++++++-----------
 src/Simplex/Messaging/Server/Env/STM.hs |  17 ++-
 src/Simplex/Messaging/Util.hs           |   2 +-
 4 files changed, 108 insertions(+), 91 deletions(-)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 90b507f3c..98cf23d06 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.3
+version:        6.0.3.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index d5ba6695f..0570a18ff 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -163,9 +163,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       forall s.
       Server ->
       String ->
-      (Server -> TQueue (QueueId, Client, Subscribed)) ->
-      (Server -> TMap QueueId Client) ->
-      (Server -> IORef (IM.IntMap (NonEmpty RecipientId))) ->
+      (Server -> TQueue (QueueId, ClientId, Subscribed)) ->
+      (Server -> TMap QueueId (TVar Client)) ->
+      (Server -> TVar (IM.IntMap (NonEmpty RecipientId))) ->
       (Client -> TMap QueueId s) ->
       (s -> IO ()) ->
       M ()
@@ -177,22 +177,31 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           $>>= endPreviousSubscriptions
           >>= mapM_ unsub
       where
-        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, Client, Bool) -> STM (Maybe (QueueId, Client))
-        updateSubscribers cls (qId, clnt, subscribed) = do
-          current <- IM.member (clientId clnt) <$> readTVar cls
-          let updateSub
-                | not subscribed = TM.lookupDelete
-                | not current = TM.lookup -- do not insert client if it is already disconnected, but send END to any other client
-                | otherwise = (`TM.lookupInsert` clnt) -- insert subscribed and current client
-              clientToBeNotified c'
-                | sameClientId clnt c' = pure Nothing
-                | otherwise = do
-                    yes <- readTVar $ connected c'
-                    pure $ if yes then Just (qId, c') else Nothing
-          updateSub qId (subs s) $>>= clientToBeNotified
+        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, ClientId, Bool) -> STM (Maybe (QueueId, Client))
+        updateSubscribers cls (qId, clntId, subscribed) =
+          -- Client lookup by ID is in the same STM transaction.
+          -- In case client disconnects during the transaction,
+          -- it will be re-evaluated, and the client won't be stored as subscribed.
+          (readTVar cls >>= updateSub (subs s) . IM.lookup clntId)
+            $>>= clientToBeNotified
+          where
+            updateSub ss = \case
+              Just (Just clnt)
+                | subscribed ->
+                    TM.lookup qId ss >>= -- insert subscribed and current client
+                      maybe
+                        (newTVar clnt >>= \cv -> TM.insert qId cv ss $> Nothing)
+                        (\cv -> Just <$> swapTVar cv clnt)
+                | otherwise -> TM.lookupDelete qId ss >>= mapM readTVar
+              -- This case catches Just Nothing - it cannot happen here.
+              -- Nothing is there only before client thread is started.
+              _ -> TM.lookup qId ss >>= mapM readTVar -- do not insert client if it is already disconnected, but send END to any other client
+            clientToBeNotified c'
+              | clntId == clientId c' = pure Nothing
+              | otherwise = (\yes -> if yes then Just (qId, c') else Nothing) <$> readTVar (connected c')
         endPreviousSubscriptions :: (QueueId, Client) -> IO (Maybe s)
         endPreviousSubscriptions (qId, c) = do
-          atomicModifyIORef'_ (ends s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
+          atomically $ modifyTVar' (ends s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
           atomically $ TM.lookupDelete qId (clientSubs c)
 
     sendPendingENDsThread :: Server -> M ()
@@ -205,17 +214,24 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
         sendPending cls $ pendingNtfENDs s
       where
         sendPending cls ref = do
-          ends <- liftIO $ atomicSwapIORef ref IM.empty
+          ends <- atomically $ swapTVar ref IM.empty
           unless (null ends) $ forM_ (IM.assocs ends) $ \(cId, qIds) ->
-            queueENDs qIds . IM.lookup cId =<< readTVarIO cls
-        queueENDs qIds = \case
-          Just (Just c) -> forkClient c ("sendPendingENDsThread.queueENDs") $ do
-            stats <- asks serverStats
-            atomically $ writeTBQueue (sndQ c) $ L.map (CorrId "",,END) qIds
-            let len = L.length qIds
-            liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
-            liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
-          _ -> pure ()
+            mapM_ (queueENDs qIds) . join . IM.lookup cId =<< readTVarIO cls
+        queueENDs qIds c@Client {connected, sndQ = q} =
+          whenM (readTVarIO connected) $ do
+            sent <- atomically $ ifM (isFullTBQueue q) (pure False) (writeTBQueue q ts $> True)
+            if sent
+              then updateEndStats
+              else -- if queue is full it can block
+                forkClient c ("sendPendingENDsThread.queueENDs") $
+                  atomically (writeTBQueue q ts) >> updateEndStats
+          where
+            ts = L.map (CorrId "",,END) qIds
+            updateEndStats = do
+              stats <- asks serverStats
+              let len = L.length qIds
+              liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
+              liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
 
     receiveFromProxyAgent :: ProxyAgent -> M ()
     receiveFromProxyAgent ProxyAgent {smpAgent = SMPClientAgent {agentQ}} =
@@ -559,27 +575,15 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                   putActiveClientsInfo "SMP" subscribers
                   putActiveClientsInfo "Ntf" notifiers
                   where
-                    putActiveClientsInfo :: String -> TMap QueueId Client -> IO ()
+                    putActiveClientsInfo :: String -> TMap QueueId (TVar Client) -> IO ()
                     putActiveClientsInfo protoName clients = do
                       activeSubs <- readTVarIO clients
                       hPutStrLn h $ protoName <> " subscriptions: " <> show (M.size activeSubs)
-                      clCnt <- if r == CPRAdmin then putClientQueues activeSubs else pure $ countSubClients activeSubs
+                      clCnt <- IS.size <$> countSubClients activeSubs
                       hPutStrLn h $ protoName <> " subscribed clients: " <> show clCnt
                       where
-                        putClientQueues :: M.Map QueueId Client -> IO Int
-                        putClientQueues subs = do
-                          let cls = differentClients subs
-                          clQs <- clientTBQueueLengths cls
-                          hPutStrLn h $ protoName <> " subscribed clients queues (rcvQ, sndQ, msgQ): " <> show clQs
-                          pure $ length cls
-                        differentClients :: M.Map QueueId Client -> [Client]
-                        differentClients = fst . M.foldl' addClient ([], IS.empty)
-                          where
-                            addClient acc@(cls, clSet) cl@Client {clientId}
-                              | IS.member clientId clSet = acc
-                              | otherwise = (cl : cls, IS.insert clientId clSet)
-                        countSubClients :: M.Map QueueId Client -> Int
-                        countSubClients = IS.size . M.foldr' (IS.insert . clientId) IS.empty
+                        countSubClients :: M.Map QueueId (TVar Client) -> IO IS.IntSet
+                        countSubClients = foldM (\ !s c -> (`IS.insert` s) . clientId <$> readTVarIO c) IS.empty
                     countClientSubs :: (Client -> TMap QueueId a) -> Maybe (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap (Maybe Client) -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
                     countClientSubs subSel countSubs_ = foldM addSubs (0, (0, 0, 0, 0), 0, (0, 0, 0))
                       where
@@ -596,8 +600,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                               clCnt' = if cnt == 0 then clCnt else clCnt + 1
                           qs' <- if cnt == 0 then pure qs else addQueueLengths qs cl
                           pure (subCnt + cnt, cnts', clCnt', qs')
-                    clientTBQueueLengths :: Foldable t => t Client -> IO (Natural, Natural, Natural)
-                    clientTBQueueLengths = foldM addQueueLengths (0, 0, 0)
                     clientTBQueueLengths' :: Foldable t => t (Maybe Client) -> IO (Natural, Natural, Natural)
                     clientTBQueueLengths' = foldM (\acc -> maybe (pure acc) (addQueueLengths acc)) (0, 0, 0)
                     addQueueLengths (!rl, !sl, !ml) cl = do
@@ -680,24 +682,27 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
 clientDisconnected :: Client -> M ()
 clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, connected, sessionId, endThreads} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " disc"
-  (subs, ntfSubs) <- atomically $ do
-    writeTVar connected False
-    (,) <$> swapTVar subscriptions M.empty <*> swapTVar ntfSubscriptions M.empty
+  -- these can be in separate transactions,
+  -- because the client already disconnected and they won't change
+  atomically $ writeTVar connected False
+  subs <- atomically $ swapTVar subscriptions M.empty
+  ntfSubs <- atomically $ swapTVar ntfSubscriptions M.empty
   liftIO $ mapM_ cancelSub subs
   Server {subscribers, notifiers} <- asks server
-  updateSubscribers subs subscribers
-  updateSubscribers ntfSubs notifiers
+  liftIO $ updateSubscribers subs subscribers
+  liftIO $ updateSubscribers ntfSubs notifiers
   asks clients >>= atomically . (`modifyTVar'` IM.delete clientId)
   tIds <- atomically $ swapTVar endThreads IM.empty
   liftIO $ mapM_ (mapM_ killThread <=< deRefWeak) tIds
   where
-    updateSubscribers subs srvSubs = do
-      atomically $ modifyTVar' srvSubs $ \cs ->
-        M.foldrWithKey (\sub _ -> M.update deleteCurrentClient sub) cs subs
-    deleteCurrentClient :: Client -> Maybe Client
-    deleteCurrentClient c'
-      | sameClientId c c' = Nothing
-      | otherwise = Just c'
+    updateSubscribers :: M.Map QueueId a -> TMap QueueId (TVar Client) -> IO ()
+    updateSubscribers subs srvSubs =
+      forM_ (M.keys subs) $ \qId ->
+        -- lookup of the subscribed client TVar can be in separate transaction,
+        -- as long as the client is read in the same transaction -
+        -- it prevents removing the next subscribed client.
+        TM.lookupIO qId srvSubs >>=
+          mapM_ (\c' -> atomically $ whenM (sameClientId c <$> readTVar c') $ TM.delete qId srvSubs)
 
 sameClientId :: Client -> Client -> Bool
 sameClientId Client {clientId} Client {clientId = cId'} = clientId == cId'
@@ -887,7 +892,7 @@ forkClient Client {endThreads, endThreadSeq} label action = do
   mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId
 
 client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
-client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers, notifiers} = do
+client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers, notifiers} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
   forever $
     atomically (readTBQueue rcvQ)
@@ -1089,7 +1094,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           liftIO (deleteQueueNotifier st entId) >>= \case
             Right () -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              atomically $ writeTQueue ntfSubscribedQ (entId, clnt, False)
+              atomically $ writeTQueue ntfSubscribedQ (entId, clientId, False)
               incStat . ntfDeleted =<< asks serverStats
               pure ok
             Left e -> pure $ err e
@@ -1116,7 +1121,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           where
             newSub :: M Sub
             newSub = time "SUB newSub" . atomically $ do
-              writeTQueue subscribedQ (rId, clnt, True)
+              writeTQueue subscribedQ (rId, clientId, True)
               sub <- newSubscription NoSub
               TM.insert rId sub subscriptions
               pure sub
@@ -1128,6 +1133,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 incStat . qSub =<< asks serverStats
               deliverMessage "SUB" qr rId sub msg_
 
+        -- clients that use GET are not added to server subscribers
         getMessage :: QueueRec -> M (Transmission BrokerMsg)
         getMessage qr = time "GET" $ do
           atomically (TM.lookup entId subscriptions) >>= \case
@@ -1180,7 +1186,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           pure ok
           where
             newSub = do
-              writeTQueue ntfSubscribedQ (entId, clnt, True)
+              writeTQueue ntfSubscribedQ (entId, clientId, True)
               TM.insert entId () ntfSubscriptions
 
         acknowledgeMsg :: QueueRec -> MsgId -> M (Transmission BrokerMsg)
@@ -1246,7 +1252,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                           incStat $ msgSentQuota stats
                           pure $ err QUOTA
                         Just (msg, wasEmpty) -> time "SEND ok" $ do
-                          when wasEmpty $ tryDeliverMessage msg
+                          when wasEmpty $ liftIO $ tryDeliverMessage msg
                           when (notification msgFlags) $ do
                             mapM_ (`trySendNotification` msg) (notifier qr)
                             incStat $ msgSentNtf stats
@@ -1280,14 +1286,21 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             -- If the queue is not full, then the thread is created where these checks are made:
             -- - it is the same subscribed client (in case it was reconnected it would receive message via SUB command)
             -- - nothing was delivered to this subscription (to avoid race conditions with the recipient).
-            tryDeliverMessage :: Message -> M ()
-            tryDeliverMessage msg = atomically deliverToSub >>= mapM_ forkDeliver
+            tryDeliverMessage :: Message -> IO ()
+            tryDeliverMessage msg =
+              -- the subscription is checked outside of STM to avoid transaction cost
+              -- in case no client is subscribed.
+              whenM (TM.memberIO rId subscribers) $
+                atomically deliverToSub >>= mapM_ forkDeliver
               where
                 rId = recipientId qr
-                -- TODO split to multiple STM transactions, move lookups to IO
                 -- remove tryPeekMsg
                 deliverToSub =
-                  TM.lookup rId subscribers
+                  -- lookup has ot be in the same transaction,
+                  -- so that if subscription ends, it re-evalutates
+                  -- and delivery is cancelled -
+                  -- the new client will receive message in response to SUB.
+                  (TM.lookup rId subscribers >>= mapM readTVar)
                     $>>= \rc@Client {subscriptions = subs, sndQ = q} -> TM.lookup rId subs
                     $>>= \s@Sub {subThread, delivered} -> case subThread of
                       ProhibitSub -> pure Nothing
@@ -1314,13 +1327,17 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                   where
                     deliverThread = do
                       labelMyThread $ B.unpack ("client $" <> encode sessionId) <> " deliver/SEND"
-                      time "deliver" . atomically $
-                        whenM (maybe False (sameClientId rc) <$> TM.lookup rId subscribers) $ do
-                          tryTakeTMVar delivered >>= \case
-                            Just _ -> pure () -- if a message was already delivered, should not deliver more
-                            Nothing -> do
-                              deliver q s
-                              writeTVar st NoSub
+                      -- lookup can be outside of STM transaction,
+                      -- as long as the check that it is the same client is inside.
+                      TM.lookupIO rId subscribers >>= mapM_ deliverIfSame
+                    deliverIfSame rc' = time "deliver" . atomically $
+                      whenM (sameClientId rc <$> readTVar rc') $
+                        tryTakeTMVar delivered >>= \case
+                          Just _ -> pure () -- if a message was already delivered, should not deliver more
+                          Nothing -> do
+                            -- a separate thread is needed because it blocks when client sndQ is full.
+                            deliver q s
+                            writeTVar st NoSub
 
             trySendNotification :: NtfCreds -> Message -> M ()
             trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg = do
@@ -1336,12 +1353,13 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                         logWarn "Dropped message notification"
                   writeNtf notifierId msg rcvNtfDhSecret ntfClnt >>= mapM_ updateStats
 
-            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> Client -> M (Maybe Bool)
-            writeNtf nId msg rcvNtfDhSecret Client {sndQ = q} = case msg of
+            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> TVar Client -> M (Maybe Bool)
+            writeNtf nId msg rcvNtfDhSecret ntfClnt = case msg of
               Message {msgId, msgTs} -> Just <$> do
                 (nmsgNonce, encNMsgMeta) <- mkMessageNotification msgId msgTs rcvNtfDhSecret
                 -- must be in one STM transaction to avoid the queue becoming full between the check and writing
-                atomically $
+                atomically $ do
+                  Client {sndQ = q} <- readTVar ntfClnt
                   ifM
                     (isFullTBQueue q)
                     (pure $ False)
@@ -1420,7 +1438,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           where
             resp = (corrId, rId, OK)
 
-        time :: T.Text -> M a -> M a
+        time :: MonadIO m => T.Text -> m a -> m a
         time name = timed name entId
 
         encryptMsg :: QueueRec -> Message -> RcvMessage
@@ -1449,9 +1467,9 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           liftIO (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case
             Right q -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              atomically $ writeTQueue subscribedQ (entId, clnt, False)
+              atomically $ writeTQueue subscribedQ (entId, clientId, False)
               forM_ (notifierId <$> notifier q) $ \nId ->
-                atomically $ writeTQueue ntfSubscribedQ (nId, clnt, False)
+                atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
               updateDeletedStats q
               pure ok
             Left e -> pure $ err e
@@ -1503,7 +1521,7 @@ withLog action = do
   env <- ask
   liftIO . mapM_ action $ storeLog (env :: Env)
 
-timed :: T.Text -> RecipientId -> M a -> M a
+timed :: MonadIO m => T.Text -> RecipientId -> m a -> m a
 timed name (EntityId qId) a = do
   t <- liftIO getSystemTime
   r <- a
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 49b6f61ed..dac00f228 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -12,7 +12,6 @@ import Control.Logger.Simple
 import Control.Monad
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
-import Data.IORef
 import Data.Int (Int64)
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IM
@@ -137,12 +136,12 @@ data Env = Env
 type Subscribed = Bool
 
 data Server = Server
-  { subscribedQ :: TQueue (RecipientId, Client, Subscribed),
-    subscribers :: TMap RecipientId Client,
-    ntfSubscribedQ :: TQueue (NotifierId, Client, Subscribed),
-    notifiers :: TMap NotifierId Client,
-    pendingENDs :: IORef (IntMap (NonEmpty RecipientId)),
-    pendingNtfENDs :: IORef (IntMap (NonEmpty NotifierId)),
+  { subscribedQ :: TQueue (RecipientId, ClientId, Subscribed),
+    subscribers :: TMap RecipientId (TVar Client),
+    ntfSubscribedQ :: TQueue (NotifierId, ClientId, Subscribed),
+    notifiers :: TMap NotifierId (TVar Client),
+    pendingENDs :: TVar (IntMap (NonEmpty RecipientId)),
+    pendingNtfENDs :: TVar (IntMap (NonEmpty NotifierId)),
     savingLock :: Lock
   }
 
@@ -185,8 +184,8 @@ newServer = do
   subscribers <- TM.emptyIO
   ntfSubscribedQ <- newTQueueIO
   notifiers <- TM.emptyIO
-  pendingENDs <- newIORef IM.empty
-  pendingNtfENDs <- newIORef IM.empty
+  pendingENDs <- newTVarIO IM.empty
+  pendingNtfENDs <- newTVarIO IM.empty
   savingLock <- atomically createLock
   return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, pendingENDs, pendingNtfENDs, savingLock}
 
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index 2c1fcff14..fde54ab01 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -178,7 +178,7 @@ labelMyThread :: MonadIO m => String -> m ()
 labelMyThread label = liftIO $ myThreadId >>= (`labelThread` label)
 
 atomicModifyIORef'_ :: IORef a -> (a -> a) -> IO ()
-atomicModifyIORef'_ r f = atomicModifyIORef' r $ \v -> (f v, ())
+atomicModifyIORef'_ r f = atomicModifyIORef' r (\v -> (f v, ()))
 
 encodeJSON :: ToJSON a => a -> Text
 encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode

From d859f2799983bb62f753844191634e01a6f380c9 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 5 Sep 2024 13:26:34 +0100
Subject: [PATCH 090/195] ntf server: remove debug logging (#1284)

---
 apps/ntf-server/Main.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/apps/ntf-server/Main.hs b/apps/ntf-server/Main.hs
index 31dbaec07..ac93580b9 100644
--- a/apps/ntf-server/Main.hs
+++ b/apps/ntf-server/Main.hs
@@ -15,7 +15,7 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 main :: IO ()
 main = do
-  setLogLevel LogDebug -- change to LogError in production
+  setLogLevel LogInfo
   cfgPath <- getEnvPath "NTF_SERVER_CFG_PATH" defaultCfgPath
   logPath <- getEnvPath "NTF_SERVER_LOG_PATH" defaultLogPath
   withGlobalLogging logCfg $ ntfServerCLI cfgPath logPath

From a9e8d02593f37fa8c5ba7944cb7bee1b1d1cc89f Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 5 Sep 2024 13:48:09 +0100
Subject: [PATCH 091/195] server: bind control port server only to 127.0.0.1
 for better security (in case of firewall misconfuguration) (#1280)

---
 src/Simplex/FileTransfer/Server.hs        |  4 ++--
 src/Simplex/Messaging/Server.hs           |  2 +-
 src/Simplex/Messaging/Transport/Server.hs | 16 ++++++++--------
 src/Simplex/RemoteControl/Discovery.hs    |  2 +-
 4 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index a5a0d5d56..a5bdd7877 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -65,7 +65,7 @@ import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
 import Simplex.Messaging.Transport.HTTP2.Server
-import Simplex.Messaging.Transport.Server (runTCPServer, tlsServerCredentials)
+import Simplex.Messaging.Transport.Server (runLocalTCPServer, tlsServerCredentials)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Exit (exitFailure)
@@ -249,7 +249,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
       u <- askUnliftIO
       liftIO $ do
         labelMyThread "control port server"
-        runTCPServer cpStarted port $ runCPClient u
+        runLocalTCPServer cpStarted port $ runCPClient u
       where
         runCPClient :: UnliftIO (ReaderT XFTPEnv IO) -> Socket -> IO ()
         runCPClient u sock = do
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 0570a18ff..cffd1d6df 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -424,7 +424,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       u <- askUnliftIO
       liftIO $ do
         labelMyThread "control port server"
-        runTCPServer cpStarted port $ runCPClient u srv
+        runLocalTCPServer cpStarted port $ runCPClient u srv
       where
         runCPClient :: UnliftIO (ReaderT Env IO) -> Server -> Socket -> IO ()
         runCPClient u srv sock = do
diff --git a/src/Simplex/Messaging/Transport/Server.hs b/src/Simplex/Messaging/Transport/Server.hs
index 0b4da7833..28d4d354d 100644
--- a/src/Simplex/Messaging/Transport/Server.hs
+++ b/src/Simplex/Messaging/Transport/Server.hs
@@ -12,7 +12,7 @@ module Simplex.Messaging.Transport.Server
     newSocketState,
     runTransportServer,
     runTransportServerSocket,
-    runTCPServer,
+    runLocalTCPServer,
     runTCPServerSocket,
     startTCPServer,
     loadSupportedTLSServerParams,
@@ -80,7 +80,7 @@ runTransportServer started port params cfg server = do
   runTransportServerState ss started port params cfg server
 
 runTransportServerState :: forall c . Transport c => SocketState -> TMVar Bool -> ServiceName -> T.ServerParams -> TransportServerConfig -> (c -> IO ()) -> IO ()
-runTransportServerState ss started port = runTransportServerSocketState ss started (startTCPServer started port) (transportName (TProxy :: TProxy c))
+runTransportServerState ss started port = runTransportServerSocketState ss started (startTCPServer started Nothing port) (transportName (TProxy :: TProxy c))
 
 -- | Run a transport server with provided connection setup and handler.
 runTransportServerSocket :: Transport a => TMVar Bool -> IO Socket -> String -> T.ServerParams -> TransportServerConfig -> (a -> IO ()) -> IO ()
@@ -107,10 +107,10 @@ tlsServerCredentials serverParams = case T.sharedCredentials $ T.serverShared se
   _ -> error "server has more than one key"
 
 -- | Run TCP server without TLS
-runTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
-runTCPServer started port server = do
+runLocalTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
+runLocalTCPServer started port server = do
   ss <- newSocketState
-  runTCPServerSocket ss started (startTCPServer started port) server
+  runTCPServerSocket ss started (startTCPServer started (Just "127.0.0.1") port) server
 
 -- | Wrap socket provider in a TCP server bracket.
 runTCPServerSocket :: SocketState -> TMVar Bool -> IO Socket -> (Socket -> IO ()) -> IO ()
@@ -157,12 +157,12 @@ closeServer started clients sock = do
   close sock
   void . atomically $ tryPutTMVar started False
 
-startTCPServer :: TMVar Bool -> ServiceName -> IO Socket
-startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
+startTCPServer :: TMVar Bool -> Maybe HostName -> ServiceName -> IO Socket
+startTCPServer started host port = withSocketsDo $ resolve >>= open >>= setStarted
   where
     resolve =
       let hints = defaultHints {addrFlags = [AI_PASSIVE], addrSocketType = Stream}
-       in select <$> getAddrInfo (Just hints) Nothing (Just port)
+       in select <$> getAddrInfo (Just hints) host (Just port)
     select as = fromJust $ family AF_INET6 <|> family AF_INET
       where
         family f = find ((== f) . addrFamily) as
diff --git a/src/Simplex/RemoteControl/Discovery.hs b/src/Simplex/RemoteControl/Discovery.hs
index e70eb1c25..8ee76c651 100644
--- a/src/Simplex/RemoteControl/Discovery.hs
+++ b/src/Simplex/RemoteControl/Discovery.hs
@@ -71,7 +71,7 @@ preferAddress RCCtrlAddress {address, interface} addrs =
 startTLSServer :: Maybe Word16 -> TMVar (Maybe N.PortNumber) -> TLS.Credentials -> TLS.ServerHooks -> (Transport.TLS -> IO ()) -> IO (Async ())
 startTLSServer port_ startedOnPort credentials hooks server = async . liftIO $ do
   started <- newEmptyTMVarIO
-  bracketOnError (startTCPServer started $ maybe "0" show port_) (\_e -> setPort Nothing) $ \socket ->
+  bracketOnError (startTCPServer started Nothing $ maybe "0" show port_) (\_e -> setPort Nothing) $ \socket ->
     ifM
       (atomically $ readTMVar started)
       (runServer started socket)

From 67d38090ed614f1a7c45dd0a52f5dc5b110d5a72 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 8 Sep 2024 15:45:45 +0100
Subject: [PATCH 092/195] xrcp: use SHA3-256 in hybrid key agreement (#1302)

---
 protocol/xrcp.md                          | 4 ++--
 src/Simplex/Messaging/Crypto/SNTRUP761.hs | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/protocol/xrcp.md b/protocol/xrcp.md
index 9f7187e66..2ed2c8d62 100644
--- a/protocol/xrcp.md
+++ b/protocol/xrcp.md
@@ -250,7 +250,7 @@ In pseudo-code:
 ```
 // session 1
 hostHelloSecret(1) = dhSecret(1)
-sessionSecret(1) = sha256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
+sessionSecret(1) = sha3-256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
 dhSecret(1) = dh(hostHelloDhKey(1), controllerInvitationDhKey(1))
 kemCiphertext(1) = enc(kemSecret(1), kemEncKey(1))
 // kemEncKey is included in host HELLO, kemCiphertext - in controller HELLO
@@ -262,7 +262,7 @@ dhSecret(n') = dh(hostHelloDhKey(n - 1), controllerDhKey(n))
 
 // session n
 hostHelloSecret(n) = dhSecret(n)
-sessionSecret(n) = sha256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
+sessionSecret(n) = sha3-256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
 dhSecret(n) = dh(hostHelloDhKey(n), controllerDhKey(n))
 // controllerDhKey(n) is either from invitation or from multicast announcement
 kemCiphertext(n) = enc(kemSecret(n), kemEncKey(n))
diff --git a/src/Simplex/Messaging/Crypto/SNTRUP761.hs b/src/Simplex/Messaging/Crypto/SNTRUP761.hs
index 99b2771f6..6f903804e 100644
--- a/src/Simplex/Messaging/Crypto/SNTRUP761.hs
+++ b/src/Simplex/Messaging/Crypto/SNTRUP761.hs
@@ -4,7 +4,7 @@
 
 module Simplex.Messaging.Crypto.SNTRUP761 where
 
-import Crypto.Hash (Digest, SHA256, hash)
+import Crypto.Hash (Digest, SHA3_256, hash)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
@@ -28,4 +28,4 @@ kcbEncrypt (KEMHybridSecret k) = sbEncrypt_ k
 kemHybridSecret :: PublicKeyX25519 -> PrivateKeyX25519 -> KEMSharedKey -> KEMHybridSecret
 kemHybridSecret k pk (KEMSharedKey kem) =
   let DhSecretX25519 dh = C.dh' k pk
-   in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA256)
+   in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA3_256)

From 344a295845ceea6a8a926e3f4c10fe79bcf05abe Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 8 Sep 2024 16:50:22 +0100
Subject: [PATCH 093/195] agent: error when user record is not in database
 (#1303)

---
 src/Simplex/Messaging/Agent/Client.hs   | 1 +
 src/Simplex/Messaging/Agent/Protocol.hs | 2 ++
 2 files changed, 3 insertions(+)

diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 9bd469ec5..c2f1c8aa6 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1930,6 +1930,7 @@ withStoreBatch' c actions = withStoreBatch c (fmap (fmap Right) . actions)
 storeError :: StoreError -> AgentErrorType
 storeError = \case
   SEConnNotFound -> CONN NOT_FOUND
+  SEUserNotFound -> NO_USER
   SERatchetNotFound -> CONN NOT_FOUND
   SEConnDuplicate -> CONN DUPLICATE
   SEBadConnType CRcv -> CONN SIMPLEX
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 12c29e6a0..178d87109 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -1338,6 +1338,8 @@ data AgentErrorType
     CMD {cmdErr :: CommandErrorType, errContext :: String}
   | -- | connection errors
     CONN {connErr :: ConnectionErrorType}
+  | -- | user not found in database
+    NO_USER
   | -- | SMP protocol errors forwarded to agent clients
     SMP {serverAddress :: String, smpErr :: ErrorType}
   | -- | NTF protocol errors forwarded to agent clients

From dab1980d79b35634bea9a259b633bd06ed8d5ebf Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 9 Sep 2024 08:08:16 +0100
Subject: [PATCH 094/195] xftp: report receive file error with redirected file
 ID, when redirect is present (#1304)

* xftp: report receive file error with redirected file ID, when redirect is present

* fix test
---
 src/Simplex/FileTransfer/Agent.hs           | 21 +++++++++++----------
 src/Simplex/Messaging/Agent/Store/SQLite.hs | 13 +++++++------
 tests/AgentTests/SQLiteTests.hs             |  2 +-
 3 files changed, 19 insertions(+), 17 deletions(-)

diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 115ca6946..aabe3ff28 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -45,7 +45,7 @@ import Data.List (foldl', partition, sortOn)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
@@ -190,8 +190,9 @@ runXFTPRcvWorker c srv Worker {doWork} = do
     runXFTPOperation :: AgentConfig -> AM ()
     runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpConsecutiveRetries} =
       withWork c doWork (\db -> getNextRcvChunkToDownload db srv rcvFilesTTL) $ \case
-        (RcvFileChunk {rcvFileId, rcvFileEntityId, fileTmpPath, replicas = []}, _) -> rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath) (INTERNAL "chunk has no replicas")
-        (fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _}, approvedRelays) -> do
+        (RcvFileChunk {rcvFileId, rcvFileEntityId, fileTmpPath, replicas = []}, _, redirectEntityId_) ->
+          rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ (Just fileTmpPath) (INTERNAL "chunk has no replicas")
+        (fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _}, approvedRelays, redirectEntityId_) -> do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
             liftIO $ waitWhileSuspended c
@@ -202,7 +203,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
           where
             retryLoop loop e replicaDelay = do
               flip catchAgentError (\_ -> pure ()) $ do
-                when (serverHostError e) $ notify c rcvFileEntityId $ RFWARN e
+                when (serverHostError e) $ notify c (fromMaybe rcvFileEntityId redirectEntityId_) (RFWARN e)
                 liftIO $ closeXFTPServerClient c userId server digest
                 withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
               liftIO $ assertAgentForeground c
@@ -211,7 +212,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
               atomically . incXFTPServerStat c userId srv $ case e of
                 XFTP _ XFTP.AUTH -> downloadAuthErrs
                 _ -> downloadErrs
-              rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath) e
+              rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ (Just fileTmpPath) e
     downloadFileChunk :: RcvFileChunk -> RcvFileChunkReplica -> Bool -> AM ()
     downloadFileChunk RcvFileChunk {userId, rcvFileId, rcvFileEntityId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath} replica approvedRelays = do
       unlessM ((approvedRelays ||) <$> ipAddressProtected') $ throwE $ FILE NOT_APPROVED
@@ -262,11 +263,11 @@ retryOnError name loop done e = do
     then loop
     else done
 
-rcvWorkerInternalError :: AgentClient -> DBRcvFileId -> RcvFileId -> Maybe FilePath -> AgentErrorType -> AM ()
-rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath err = do
+rcvWorkerInternalError :: AgentClient -> DBRcvFileId -> RcvFileId -> Maybe RcvFileId -> Maybe FilePath -> AgentErrorType -> AM ()
+rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ tmpPath err = do
   lift $ forM_ tmpPath (removePath <=< toFSFilePath)
   withStore' c $ \db -> updateRcvFileError db rcvFileId (show err)
-  notify c rcvFileEntityId $ RFERR err
+  notify c (fromMaybe rcvFileEntityId redirectEntityId_) (RFERR err)
 
 runXFTPRcvLocalWorker :: AgentClient -> Worker -> AM ()
 runXFTPRcvLocalWorker c Worker {doWork} = do
@@ -279,8 +280,8 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
     runXFTPOperation :: AgentConfig -> AM ()
     runXFTPOperation AgentConfig {rcvFilesTTL} =
       withWork c doWork (`getNextRcvFileToDecrypt` rcvFilesTTL) $
-        \f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath} ->
-          decryptFile f `catchAgentError` rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath
+        \f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath, redirect} ->
+          decryptFile f `catchAgentError` rcvWorkerInternalError c rcvFileId rcvFileEntityId (redirectEntityId <$> redirect) tmpPath
     decryptFile :: RcvFile -> AM ()
     decryptFile RcvFile {rcvFileId, rcvFileEntityId, size, digest, key, nonce, tmpPath, saveFile, status, chunks, redirect} = do
       let CryptoFile savePath cfArgs = saveFile
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 07074e08f..d3eae9354 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -2525,7 +2525,7 @@ deleteRcvFile' :: DB.Connection -> DBRcvFileId -> IO ()
 deleteRcvFile' db rcvFileId =
   DB.execute db "DELETE FROM rcv_files WHERE rcv_file_id = ?" (Only rcvFileId)
 
-getNextRcvChunkToDownload :: DB.Connection -> XFTPServer -> NominalDiffTime -> IO (Either StoreError (Maybe (RcvFileChunk, Bool)))
+getNextRcvChunkToDownload :: DB.Connection -> XFTPServer -> NominalDiffTime -> IO (Either StoreError (Maybe (RcvFileChunk, Bool, Maybe RcvFileId)))
 getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = do
   getWorkItem "rcv_file_download" getReplicaId getChunkData (markRcvFileFailed db . snd)
   where
@@ -2549,7 +2549,7 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
             LIMIT 1
           |]
           (host, port, keyHash, RFSReceiving, cutoffTs)
-    getChunkData :: (Int64, DBRcvFileId) -> IO (Either StoreError (RcvFileChunk, Bool))
+    getChunkData :: (Int64, DBRcvFileId) -> IO (Either StoreError (RcvFileChunk, Bool, Maybe RcvFileId))
     getChunkData (rcvFileChunkReplicaId, _fileId) =
       firstRow toChunk SEFileNotFound $
         DB.query
@@ -2558,7 +2558,7 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
             SELECT
               f.rcv_file_id, f.rcv_file_entity_id, f.user_id, c.rcv_file_chunk_id, c.chunk_no, c.chunk_size, c.digest, f.tmp_path, c.tmp_path,
               r.rcv_file_chunk_replica_id, r.replica_id, r.replica_key, r.received, r.delay, r.retries,
-              f.approved_relays
+              f.approved_relays, f.redirect_entity_id
             FROM rcv_file_chunk_replicas r
             JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
             JOIN rcv_file_chunks c ON c.rcv_file_chunk_id = r.rcv_file_chunk_id
@@ -2567,8 +2567,8 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
           |]
           (Only rcvFileChunkReplicaId)
       where
-        toChunk :: ((DBRcvFileId, RcvFileId, UserId, Int64, Int, FileSize Word32, FileDigest, FilePath, Maybe FilePath) :. (Int64, ChunkReplicaId, C.APrivateAuthKey, Bool, Maybe Int64, Int) :. Only Bool) -> (RcvFileChunk, Bool)
-        toChunk ((rcvFileId, rcvFileEntityId, userId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath, chunkTmpPath) :. (rcvChunkReplicaId, replicaId, replicaKey, received, delay, retries) :. (Only approvedRelays)) =
+        toChunk :: ((DBRcvFileId, RcvFileId, UserId, Int64, Int, FileSize Word32, FileDigest, FilePath, Maybe FilePath) :. (Int64, ChunkReplicaId, C.APrivateAuthKey, Bool, Maybe Int64, Int) :. (Bool, Maybe RcvFileId)) -> (RcvFileChunk, Bool, Maybe RcvFileId)
+        toChunk ((rcvFileId, rcvFileEntityId, userId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath, chunkTmpPath) :. (rcvChunkReplicaId, replicaId, replicaKey, received, delay, retries) :. (approvedRelays, redirectEntityId_)) =
           ( RcvFileChunk
               { rcvFileId,
                 rcvFileEntityId,
@@ -2581,7 +2581,8 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
                 chunkTmpPath,
                 replicas = [RcvFileChunkReplica {rcvChunkReplicaId, server, replicaId, replicaKey, received, delay, retries}]
               },
-            approvedRelays
+            approvedRelays,
+            redirectEntityId_
           )
 
 getNextRcvFileToDecrypt :: DB.Connection -> NominalDiffTime -> IO (Either StoreError (Maybe RcvFile))
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index 4a8d80dd4..22023cc96 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -741,7 +741,7 @@ testGetNextRcvChunkToDownload st = do
     show e `shouldContain` "ConversionFailed"
     DB.query_ db "SELECT rcv_file_id FROM rcv_files WHERE failed = 1" `shouldReturn` [Only (1 :: Int)]
 
-    Right (Just (RcvFileChunk {rcvFileEntityId}, _)) <- getNextRcvChunkToDownload db xftpServer1 86400
+    Right (Just (RcvFileChunk {rcvFileEntityId}, _, Nothing)) <- getNextRcvChunkToDownload db xftpServer1 86400
     rcvFileEntityId `shouldBe` fId2
 
 testGetNextRcvFileToDecrypt :: SQLiteStore -> Expectation

From 70004312498fd566d9c9f3119efa30f1532da259 Mon Sep 17 00:00:00 2001
From: sh <37271604+shumvgolove@users.noreply.github.com>
Date: Mon, 9 Sep 2024 13:19:17 +0400
Subject: [PATCH 095/195] scripts/servers: update stopscript (#1286)

* scripts/servers: update stopscript

* Major refactoring

* archive -> backups

* simplify logic

* sort files by timestamp
---
 scripts/main/simplex-servers-stopscript | 186 +++++++++++++++++++++---
 1 file changed, 165 insertions(+), 21 deletions(-)

diff --git a/scripts/main/simplex-servers-stopscript b/scripts/main/simplex-servers-stopscript
index 53d9f13bf..acfed3431 100755
--- a/scripts/main/simplex-servers-stopscript
+++ b/scripts/main/simplex-servers-stopscript
@@ -1,30 +1,174 @@
 #!/usr/bin/env sh
 set -eu
 
-path_conf_var="/var/opt"
-path_conf_smp="$path_conf_var/simplex"
-path_conf_xftp="$path_conf_var/simplex-xftp"
-path_conf_storelog_smp="$path_conf_smp/smp-server-store.log"
-path_conf_storelog_xftp="$path_conf_xftp/file-server-store.log"
+# Common
+# ------
 date="$(date -u '+%Y-%m-%dT%H:%M:%S')"
 
-backup_smp() {
- if [ -e "$path_conf_storelog_smp" ]; then
-  cp "$path_conf_storelog_smp" "${path_conf_storelog_smp}.${date:-date-failed}"
- fi
+GRN='\033[0;32m'
+YLW='\033[1;33m'
+BLU='\033[1;34m'
+RED='\033[0;31m'
+NC='\033[0m'
+
+path_conf_var="/var/opt"
+
+smp_variables() {
+	path_conf_smp="$path_conf_var/simplex"
+	path_conf_smp_archive="$path_conf_smp/backups"
+	path_conf_smp_archive_storelog="$path_conf_smp_archive/queues"
+	path_conf_smp_archive_stats="$path_conf_smp_archive/stats"
+	path_conf_smp_archive_messages="$path_conf_smp_archive/messages"
+	path_conf_storelog_smp="$path_conf_smp/smp-server-store.log"
+	path_conf_storelog_smp_out="$path_conf_smp_archive_storelog/smp-server-store.log.${date:-date-failed}"
+
+	path_conf_stats_smp="$path_conf_smp/smp-server-stats.log"
+	path_conf_stats_smp_out="$path_conf_smp_archive_stats/smp-server-stats.log.${date:-date-failed}"
+
+	path_conf_messages_smp="$path_conf_smp/smp-server-messages.log"
+	path_conf_messages_smp_out="$path_conf_smp_archive_messages/smp-server-messages.log.${date:-date-failed}"
 }
 
-backup_xftp() {
- if [ -e "$path_conf_storelog_xftp" ]; then
-  cp "$path_conf_storelog_xftp" "${path_conf_storelog_xftp}.${date:-date-failed}"
- fi
+xftp_variables() {
+	path_conf_xftp="$path_conf_var/simplex-xftp"
+	path_conf_xftp_archive="$path_conf_xftp/backups"
+
+	path_conf_xftp_archive_storelog="$path_conf_xftp_archive/queues"
+	path_conf_xftp_archive_stats="$path_conf_xftp_archive/stats"
+
+	path_conf_storelog_xftp="$path_conf_xftp/file-server-store.log"
+	path_conf_storelog_xftp_out="$path_conf_xftp_archive_storelog/file-server-store.log.${date:-date-failed}"
+
+	path_conf_stats_xftp="$path_conf_xftp/file-server-stats.log"
+	path_conf_stats_xftp_out="$path_conf_xftp_archive_stats/file-server-stats.log.${date:-date-failed}"
 }
 
-if [ "$1" = 'smp-server' ]; then
- backup_smp
-elif [ "$1" = 'xftp-server' ]; then
- backup_xftp
-else
- backup_smp
- backup_xftp
-fi
+checks() {
+	result=${SERVICE_RESULT:-exit-code}
+	status=${EXIT_STATUS:-TERM}
+
+	case "$result" in
+		success)
+			case "$status" in
+				TERM)
+					printf "${RED}Refusing to backup files with failed service state${NC}\n"
+					exit 1
+					;;
+				*)
+					:
+					;;
+			esac
+			;;
+		*)
+			printf "${RED}Refusing to backup files with failed service state${NC}\n"
+			exit 1
+			;;
+	esac
+}
+
+smp_check() {
+	if [ ! -d "$path_conf_smp_archive_storelog" ]; then
+		mkdir -p "$path_conf_smp_archive_storelog"
+	fi
+	if [ ! -d "$path_conf_smp_archive_messages" ]; then
+		mkdir -p "$path_conf_smp_archive_messages"
+	fi
+	if [ ! -d "$path_conf_smp_archive_stats" ]; then
+		mkdir -p "$path_conf_smp_archive_stats"
+	fi
+}
+
+xftp_check() {
+	if [ ! -d "$path_conf_xftp_archive_storelog" ]; then
+		mkdir -p "$path_conf_xftp_archive_storelog"
+	fi
+	if [ ! -d "$path_conf_xftp_archive_stats" ]; then
+		mkdir -p "$path_conf_xftp_archive_stats"
+	fi
+}
+
+backup() {
+	file="$1"
+	out="$2"
+	file_type="$3"
+
+	if [ -e "$file" ]; then
+		if cp "$file" "$out"; then
+			printf "${YLW}${file_type}${NC} ${GRN}backup successful:${NC} ${BLU}%s${NC}\n" "${out}"
+		else
+			printf "${YLW}${file_type}${NC} ${RED}backup failed!${NC}\n"
+		fi
+	fi
+
+	unset file out file_type
+}
+
+cleanup() {
+	directory="$1"
+	
+	file_type="$2"
+	
+	files_date=$(find "$directory" -type f -exec stat --format="%y" {} + | awk '{print $1}' | sort -nr | uniq | awk 'NR==2')
+	
+	if [ -n "$files_date" ]; then
+		files=$(find "$directory" -type f -not -newermt "$files_date" -printf "%T@ %Tc %p\n" | sort -n | awk '{print $NF}')
+
+		if [ -n "$files" ]; then
+			printf '%s' "$files" | xargs rm -f
+			printf "${YLW}Old ${file_type} files${NC}${GRN} has been deleted:${NC}\n"
+			files_colored=$(printf '%s' "$files" | awk '{print "\033[1;34m"$0"\033[0m"}')
+			printf "${files_colored}\n"
+		fi
+	fi
+
+	unset directory file_type files_date files
+}
+
+smp_backup() {
+	backup "$path_conf_storelog_smp" "$path_conf_storelog_smp_out" 'Storelog'
+	backup "$path_conf_messages_smp" "$path_conf_messages_smp_out" 'Messages'
+	backup "$path_conf_stats_smp" "$path_conf_stats_smp_out" 'Stats'
+}
+
+smp_cleanup() {
+	cleanup "$path_conf_smp_archive_storelog" 'storelog'
+	cleanup "$path_conf_smp_archive_stats" 'stats'
+	cleanup "$path_conf_smp_archive_messages" 'messages'
+}
+
+xftp_backup() {
+	backup "$path_conf_storelog_xftp" "$path_conf_storelog_xftp_out" 'Storelog'
+	backup "$path_conf_stats_xftp" "$path_conf_stats_xftp_out" 'Stats'
+}
+
+xftp_cleanup() {
+	cleanup "$path_conf_xftp_archive_storelog" 'storelog'
+	cleanup "$path_conf_xftp_archive_stats" 'stats'
+}
+
+main() {
+	type="${1:-}"
+  
+	checks
+
+	case "$type" in
+		smp-server)
+			smp_variables
+			smp_check
+			smp_backup
+			smp_cleanup
+			;;
+		xftp-server)
+			xftp_variables
+			xftp_check
+			xftp_backup
+			xftp_cleanup
+			;;
+		*)
+			printf "${YLW}Unknown server type.${NC}\n"
+			exit 1
+			;;
+	esac 
+}
+
+main "$@"

From 092ed088caef431b49dfd53f09603346422f77f9 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Mon, 9 Sep 2024 16:03:17 +0400
Subject: [PATCH 096/195] ntf: support for multiple messages encoding (#1305)

---
 src/Simplex/Messaging/Agent.hs                  | 12 ++++++------
 src/Simplex/Messaging/Notifications/Server.hs   |  2 +-
 .../Messaging/Notifications/Server/Push/APNS.hs | 17 +++++++++++++++--
 tests/AgentTests/NotificationTests.hs           |  4 +++-
 tests/NtfServerTests.hs                         |  9 +++++----
 5 files changed, 30 insertions(+), 14 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 554c39249..c45c47ab6 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -174,7 +174,7 @@ import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId)
-import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..))
+import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..), pnMessagesP)
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
 import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, sndAuthKeySMPClientVersion)
@@ -334,7 +334,7 @@ createConnection :: AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe
 createConnection c userId enableNtfs = withAgentEnv c .:: newConn c userId "" enableNtfs
 {-# INLINE createConnection #-}
 
--- | Changes the user id associated with a connection 
+-- | Changes the user id associated with a connection
 changeConnectionUser :: AgentClient -> UserId -> ConnId -> UserId -> AE ()
 changeConnectionUser c oldUserId connId newUserId = withAgentEnv c $ changeConnectionUser' c oldUserId connId newUserId
 {-# INLINE changeConnectionUser #-}
@@ -1020,7 +1020,7 @@ subscribeConnections' c connIds = do
         SomeConn _ conn -> do
           let cmd = if enableNtfs $ toConnData conn then NSCCreate else NSCDelete
               ConnData {connId} = toConnData conn
-          atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)            
+          atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)
     resumeDelivery :: Map ConnId SomeConn -> AM ()
     resumeDelivery conns = do
       conns' <- M.restrictKeys conns . S.fromList <$> withStore' c getConnectionsForDelivery
@@ -1065,7 +1065,7 @@ getNotificationMessage' c nonce encNtfInfo = do
   withStore' c getActiveNtfToken >>= \case
     Just NtfToken {ntfDhSecret = Just dhSecret} -> do
       ntfData <- agentCbDecrypt dhSecret nonce encNtfInfo
-      PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} <- liftEither (parse strP (INTERNAL "error parsing PNMessageData") ntfData)
+      PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| _ <- liftEither (parse pnMessagesP (INTERNAL "error parsing PNMessageData") ntfData)
       (ntfConnId, rcvNtfDhSecret) <- withStore c (`getNtfRcvQueue` smpQueue)
       ntfMsgMeta <- (eitherToMaybe . smpDecode <$> agentCbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta) `catchAgentError` \_ -> pure Nothing
       msgMeta <- getConnectionMessage' c ntfConnId
@@ -1103,8 +1103,8 @@ sendMessagesB_ c reqs connIds = withConnLocks c connIds "sendMessages" $ do
   where
     getConn_ :: DB.Connection -> TVar (Maybe (Either AgentErrorType SomeConn)) -> MsgReq -> IO (Either AgentErrorType (MsgReq, SomeConn))
     getConn_ db prev req@(connId, _, _, _) =
-      (req,) <$$> 
-        if B.null connId
+      (req,)
+        <$$> if B.null connId
           then fromMaybe (Left $ INTERNAL "sendMessagesB_: empty prev connId") <$> readTVarIO prev
           else do
             conn <- first storeError <$> getConn db connId
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 763c45de6..2f4093ac3 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -221,7 +221,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
               liftIO $ updatePeriodStats (activeSubs stats) ntfId
               atomically $
                 findNtfSubscriptionToken st smpQueue
-                  >>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}))
+                  >>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage (PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| [])))
               incNtfStat ntfReceived
             Right SMP.END ->
               whenM (atomically $ activeClientSession' ca sessionId srv) $
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index 2632ff4b4..00d3c6a81 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -28,12 +28,16 @@ import Data.Aeson (ToJSON, (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.TH as JQ
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import Data.Maybe (isNothing)
 import Data.Text (Text)
@@ -103,11 +107,20 @@ readECPrivateKey f = do
 
 data PushNotification
   = PNVerification NtfRegCode
-  | PNMessage PNMessageData
+  | PNMessage (NonEmpty PNMessageData)
   | -- | PNAlert Text
     PNCheckMessages
   deriving (Show)
 
+-- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
+-- because strEncode of NonEmpty list uses comma for separator,
+-- and encoding of PNMessageData's smpQueue has comma in list of hosts
+encodePNMessages :: NonEmpty PNMessageData -> ByteString
+encodePNMessages = B.intercalate ";" . map strEncode . L.toList
+
+pnMessagesP :: A.Parser (NonEmpty PNMessageData)
+pnMessagesP = L.fromList <$> strP `A.sepBy1` A.char ';'
+
 data PNMessageData = PNMessageData
   { smpQueue :: SMPQueueNtf,
     ntfTs :: SystemTime,
@@ -285,7 +298,7 @@ apnsNotification NtfTknData {tknDhSecret} nonce paddedLen = \case
     encrypt code $ \code' ->
       apn APNSBackground {contentAvailable = 1} . Just $ J.object ["nonce" .= nonce, "verification" .= code']
   PNMessage pnMessageData ->
-    encrypt (strEncode pnMessageData) $ \ntfData ->
+    encrypt (encodePNMessages pnMessageData) $ \ntfData ->
       apn apnMutableContent . Just $ J.object ["nonce" .= nonce, "message" .= ntfData]
   -- PNAlert text -> Right $ apn (apnAlert $ APNSAlertText text) Nothing
   PNCheckMessages -> Right $ apn APNSBackground {contentAvailable = 1} . Just $ J.object ["checkMessages" .= True]
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index c45c37124..5f019540f 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -49,6 +49,7 @@ import Data.Bifunctor (bimap, first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.List.NonEmpty (NonEmpty (..))
 import Data.Text.Encoding (encodeUtf8)
 import Database.SQLite.Simple.QQ (sql)
 import NtfClient
@@ -66,6 +67,7 @@ import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Types (NtfTknAction (..), NtfToken (..))
+import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgFlags (MsgFlags), NtfServer, ProtocolServer (..), SMPMsgMeta (..), SubscriptionMode (..))
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
@@ -872,7 +874,7 @@ messageNotificationData :: HasCallStack => AgentClient -> TBQueue APNSMockReques
 messageNotificationData c apnsQ = do
   (nonce, message) <- messageNotification apnsQ
   NtfToken {ntfDhSecret = Just dhSecret} <- getNtfTokenData c
-  Right pnMsgData <- liftEither . first INTERNAL $ Right . strDecode =<< first show (C.cbDecrypt dhSecret nonce message)
+  Right (pnMsgData :| _) <- liftEither . first INTERNAL $ Right . parseAll pnMessagesP =<< first show (C.cbDecrypt dhSecret nonce message)
   pure pnMsgData
 
 noNotification :: TBQueue APNSMockRequest -> ExceptT AgentErrorType IO ()
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index c4b97f18c..b46988b28 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -17,6 +17,7 @@ import qualified Data.Aeson.Types as JT
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
+import Data.List.NonEmpty (NonEmpty (..))
 import Data.Text.Encoding (encodeUtf8)
 import NtfClient
 import SMPClient as SMP
@@ -136,8 +137,8 @@ testNotificationSubscription (ATransport t) =
               Right nonce' = C.cbNonce <$> ntfData' .-> "nonce"
               Right message = ntfData' .-> "message"
               Right ntfDataDecrypted = C.cbDecrypt dhSecret nonce' message
-              Right APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer, notifierId}, nmsgNonce, encNMsgMeta} =
-                parse strP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted
+              Right (APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer, notifierId}, nmsgNonce, encNMsgMeta} :| _) =
+                parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted
               Right nMsgMeta = C.cbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta
               Right NMsgMeta {msgId, msgTs} = parse smpP (AP.INTERNAL "error parsing NMsgMeta") nMsgMeta
           smpServer `shouldBe` srv
@@ -169,8 +170,8 @@ testNotificationSubscription (ATransport t) =
               Right nonce3 = C.cbNonce <$> ntfData3 .-> "nonce"
               Right message3 = ntfData3 .-> "message"
               Right ntfDataDecrypted3 = C.cbDecrypt dhSecret nonce3 message3
-              Right APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} =
-                parse strP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted3
+              Right (APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} :| _) =
+                parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted3
           smpServer3 `shouldBe` srv
           notifierId3 `shouldBe` nId
           send3 APNSRespOk

From 946e16339e16e026f51185ebfb48c3a0c5a5b2e1 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Mon, 9 Sep 2024 16:42:14 +0400
Subject: [PATCH 097/195] agent: process last notification from list (#1307)

---
 src/Simplex/Messaging/Agent.hs        |  3 ++-
 tests/AgentTests/NotificationTests.hs |  6 +++---
 tests/NtfServerTests.hs               | 11 +++++------
 3 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index c45c47ab6..2ead387ca 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1065,7 +1065,8 @@ getNotificationMessage' c nonce encNtfInfo = do
   withStore' c getActiveNtfToken >>= \case
     Just NtfToken {ntfDhSecret = Just dhSecret} -> do
       ntfData <- agentCbDecrypt dhSecret nonce encNtfInfo
-      PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| _ <- liftEither (parse pnMessagesP (INTERNAL "error parsing PNMessageData") ntfData)
+      pnMsgs <- liftEither (parse pnMessagesP (INTERNAL "error parsing PNMessageData") ntfData)
+      let PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} = L.last pnMsgs
       (ntfConnId, rcvNtfDhSecret) <- withStore c (`getNtfRcvQueue` smpQueue)
       ntfMsgMeta <- (eitherToMaybe . smpDecode <$> agentCbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta) `catchAgentError` \_ -> pure Nothing
       msgMeta <- getConnectionMessage' c ntfConnId
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 5f019540f..62429a456 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -49,7 +49,7 @@ import Data.Bifunctor (bimap, first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import Data.Text.Encoding (encodeUtf8)
 import Database.SQLite.Simple.QQ (sql)
 import NtfClient
@@ -874,8 +874,8 @@ messageNotificationData :: HasCallStack => AgentClient -> TBQueue APNSMockReques
 messageNotificationData c apnsQ = do
   (nonce, message) <- messageNotification apnsQ
   NtfToken {ntfDhSecret = Just dhSecret} <- getNtfTokenData c
-  Right (pnMsgData :| _) <- liftEither . first INTERNAL $ Right . parseAll pnMessagesP =<< first show (C.cbDecrypt dhSecret nonce message)
-  pure pnMsgData
+  Right pnMsgs <- liftEither . first INTERNAL $ Right . parseAll pnMessagesP =<< first show (C.cbDecrypt dhSecret nonce message)
+  pure $ L.last pnMsgs
 
 noNotification :: TBQueue APNSMockRequest -> ExceptT AgentErrorType IO ()
 noNotification apnsQ = do
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index b46988b28..e3349e9a3 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -17,7 +17,7 @@ import qualified Data.Aeson.Types as JT
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
-import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import Data.Text.Encoding (encodeUtf8)
 import NtfClient
 import SMPClient as SMP
@@ -36,7 +36,6 @@ import ServerTests
 import qualified Simplex.Messaging.Agent.Protocol as AP
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import qualified Simplex.Messaging.Notifications.Server.Push.APNS as APNS
@@ -137,8 +136,8 @@ testNotificationSubscription (ATransport t) =
               Right nonce' = C.cbNonce <$> ntfData' .-> "nonce"
               Right message = ntfData' .-> "message"
               Right ntfDataDecrypted = C.cbDecrypt dhSecret nonce' message
-              Right (APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer, notifierId}, nmsgNonce, encNMsgMeta} :| _) =
-                parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted
+              Right pnMsgs1 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted
+              APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer, notifierId}, nmsgNonce, encNMsgMeta} = L.last pnMsgs1
               Right nMsgMeta = C.cbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta
               Right NMsgMeta {msgId, msgTs} = parse smpP (AP.INTERNAL "error parsing NMsgMeta") nMsgMeta
           smpServer `shouldBe` srv
@@ -170,8 +169,8 @@ testNotificationSubscription (ATransport t) =
               Right nonce3 = C.cbNonce <$> ntfData3 .-> "nonce"
               Right message3 = ntfData3 .-> "message"
               Right ntfDataDecrypted3 = C.cbDecrypt dhSecret nonce3 message3
-              Right (APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} :| _) =
-                parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted3
+              Right pnMsgs2 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted3
+              APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} = L.last pnMsgs2
           smpServer3 `shouldBe` srv
           notifierId3 `shouldBe` nId
           send3 APNSRespOk

From 75712641ee97d1f0af5de3f7f3bc658c4cb7b8e2 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 9 Sep 2024 14:07:32 +0100
Subject: [PATCH 098/195] rfc: stabilize iOS notifications (#1221)

---
 rfcs/2024-07-06-ios-notifications.md          | 18 ++++++++++++++++++
 rfcs/{ => done}/2023-12-29-pqdr.md            |  0
 rfcs/{ => done}/2024-03-03-pqdr-version.md    |  0
 rfcs/{ => done}/2024-06-14-fast-connection.md |  0
 4 files changed, 18 insertions(+)
 create mode 100644 rfcs/2024-07-06-ios-notifications.md
 rename rfcs/{ => done}/2023-12-29-pqdr.md (100%)
 rename rfcs/{ => done}/2024-03-03-pqdr-version.md (100%)
 rename rfcs/{ => done}/2024-06-14-fast-connection.md (100%)

diff --git a/rfcs/2024-07-06-ios-notifications.md b/rfcs/2024-07-06-ios-notifications.md
new file mode 100644
index 000000000..c60d7baf3
--- /dev/null
+++ b/rfcs/2024-07-06-ios-notifications.md
@@ -0,0 +1,18 @@
+# iOS notifications stability
+
+## Problem
+
+iOS notifications may fail to deliver for several reasons, but there are two important reasons that we could address:
+- when notification server is not subscribed to SMP server(s), the notifications can be dropped - it can happen because either notification server restarts or becuase SMP server restarted and some messages are received before notification server resubscribed. We lose approximately 3% of notifications because of this reason.
+- when user device is offline or has low power condition, Apple does not deliver notification, but puts them to storage. If while the notification is in storage a new one arrives it would overwrite the previous notification. If it was the message to the same message queue, the client will download messages anyway, up to a limit, but if the message was to another queue, it will not be delivered until the app is opened. Apple delivers about 88% of notifications that should be delivered (not accounting for uninstalled apps), the rest is replaced with the newer notifications.
+
+## Solution
+
+The first problem can be solved by preserving notifications for a limited time (say 1 hour) in case there is no subscription to notification from notification server. At the very least, they can be preserved in SMP server memory but can also be stored to a file on restart, similar to messages, and be delivered when notification server resubscribes. It is sufficient to store one notification per messaging queue.
+
+The second problem is both more damaging and more complex to solve. The solution could be to always deliver several last notifications to different queues in one packet (Apple allows up to ~4-5kb notification size, and we are sending packets of fixed size 512 bytes, so we could fit up to 8-10 of them in each notification).
+
+Every time a client receives such batch of notifications if can:
+- check if that notification was already received in the previous batch.
+- if it was received, it would be ignored, otherwise it would be processed.
+- process them one by one, started from the most recent one while the time allows.
diff --git a/rfcs/2023-12-29-pqdr.md b/rfcs/done/2023-12-29-pqdr.md
similarity index 100%
rename from rfcs/2023-12-29-pqdr.md
rename to rfcs/done/2023-12-29-pqdr.md
diff --git a/rfcs/2024-03-03-pqdr-version.md b/rfcs/done/2024-03-03-pqdr-version.md
similarity index 100%
rename from rfcs/2024-03-03-pqdr-version.md
rename to rfcs/done/2024-03-03-pqdr-version.md
diff --git a/rfcs/2024-06-14-fast-connection.md b/rfcs/done/2024-06-14-fast-connection.md
similarity index 100%
rename from rfcs/2024-06-14-fast-connection.md
rename to rfcs/done/2024-06-14-fast-connection.md

From 990dcec3481035f49658331c021a510bba2237c5 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 9 Sep 2024 14:53:11 +0100
Subject: [PATCH 099/195] smp server: add created/updated/used date to queues
 to manage expiration (#1306)

* smp server: add created/updated/used date to queues to manage expiration, all: make Map updates strict in value

* remove strict

* remove time precision

* diff

* style

* only update when time changed
---
 src/Simplex/Messaging/Server.hs               | 27 +++++--
 src/Simplex/Messaging/Server/QueueStore.hs    | 19 ++++-
 .../Messaging/Server/QueueStore/STM.hs        | 27 ++++---
 src/Simplex/Messaging/Server/StoreLog.hs      | 73 +++++++++++++++----
 4 files changed, 112 insertions(+), 34 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index cffd1d6df..e2d5edc4e 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -986,8 +986,8 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
       Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command)
       Cmd SSender command -> Just <$> case command of
         SKEY sKey -> (corrId,entId,) <$> case qr_ of
-          Just QueueRec {sndSecure, recipientId}
-            | sndSecure -> secureQueue_ "SKEY" recipientId sKey
+          Just qr@QueueRec {sndSecure}
+            | sndSecure -> secureQueue_ "SKEY" qr sKey
             | otherwise -> pure $ ERR AUTH
           Nothing -> pure $ ERR INTERNAL
         SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
@@ -1010,7 +1010,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           GET -> withQueue getMessage
           ACK msgId -> withQueue (`acknowledgeMsg` msgId)
           KEY sKey -> (corrId,entId,) <$> case qr_ of
-            Just QueueRec {recipientId} -> secureQueue_ "KEY" recipientId sKey
+            Just qr -> secureQueue_ "KEY" qr sKey
             Nothing -> pure $ ERR INTERNAL
           NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
           NDEL -> deleteQueueNotifier_ st
@@ -1021,6 +1021,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
         createQueue :: QueueStore -> RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> SenderCanSecure -> M (Transmission BrokerMsg)
         createQueue st recipientKey dhKey subMode sndSecure = time "NEW" $ do
           (rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
+          updatedAt <- Just <$> liftIO getSystemDate
           let rcvDhSecret = C.dh' dhKey privDhKey
               qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}
               qRec (recipientId, senderId) =
@@ -1032,7 +1033,8 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                     senderKey = Nothing,
                     notifier = Nothing,
                     status = QueueActive,
-                    sndSecure
+                    sndSecure,
+                    updatedAt
                   }
           (corrId,entId,) <$> addQueueRetry 3 qik qRec
           where
@@ -1061,9 +1063,10 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               n <- asks $ queueIdBytes . config
               liftM2 (,) (randomId n) (randomId n)
 
-        secureQueue_ :: T.Text -> RecipientId -> SndPublicAuthKey -> M BrokerMsg
-        secureQueue_ name rId sKey = time name $ do
+        secureQueue_ :: T.Text -> QueueRec -> SndPublicAuthKey -> M BrokerMsg
+        secureQueue_ name qr@QueueRec {recipientId = rId} sKey = time name $ do
           withLog $ \s -> logSecureQueue s rId sKey
+          updateQueueDate qr
           st <- asks queueStore
           stats <- asks serverStats
           incStat $ qSecured stats
@@ -1172,7 +1175,17 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               pure r
 
         withQueue :: (QueueRec -> M (Transmission BrokerMsg)) -> M (Transmission BrokerMsg)
-        withQueue action = maybe (pure $ err AUTH) action qr_
+        withQueue action = case qr_ of
+          Just qr -> updateQueueDate qr >> action qr
+          Nothing -> pure $ err INTERNAL
+
+        updateQueueDate :: QueueRec -> M ()
+        updateQueueDate QueueRec {updatedAt, recipientId = rId} = do
+          t <- liftIO getSystemDate
+          when (Just t /= updatedAt) $ do
+            withLog $ \s -> logUpdateQueueTime s rId t
+            st <- asks queueStore
+            liftIO $ updateQueueTime st rId t 
 
         subscribeNotifications :: M (Transmission BrokerMsg)
         subscribeNotifications = do
diff --git a/src/Simplex/Messaging/Server/QueueStore.hs b/src/Simplex/Messaging/Server/QueueStore.hs
index 8d5bd8fff..3f7da8d29 100644
--- a/src/Simplex/Messaging/Server/QueueStore.hs
+++ b/src/Simplex/Messaging/Server/QueueStore.hs
@@ -1,10 +1,13 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 
 module Simplex.Messaging.Server.QueueStore where
 
+import Data.Int (Int64)
+import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 
@@ -16,7 +19,8 @@ data QueueRec = QueueRec
     senderKey :: !(Maybe SndPublicAuthKey),
     sndSecure :: !SenderCanSecure,
     notifier :: !(Maybe NtfCreds),
-    status :: !ServerQueueStatus
+    status :: !ServerQueueStatus,
+    updatedAt :: !(Maybe RoundedSystemTime)
   }
   deriving (Show)
 
@@ -34,3 +38,16 @@ instance StrEncoding NtfCreds where
     pure NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}
 
 data ServerQueueStatus = QueueActive | QueueOff deriving (Eq, Show)
+
+newtype RoundedSystemTime = RoundedSystemTime Int64
+  deriving (Eq, Ord, Show)
+
+instance StrEncoding RoundedSystemTime where
+  strEncode (RoundedSystemTime t) = strEncode t
+  strP = RoundedSystemTime <$> strP
+
+getRoundedSystemTime :: Int64 -> IO RoundedSystemTime
+getRoundedSystemTime prec = (\t -> RoundedSystemTime $ (systemSeconds t `div` prec) * prec) <$> getSystemTime
+
+getSystemDate :: IO RoundedSystemTime
+getSystemDate = getRoundedSystemTime 86400
diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index 3a1385269..da9dc4bb3 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -19,6 +19,7 @@ module Simplex.Messaging.Server.QueueStore.STM
     addQueueNotifier,
     deleteQueueNotifier,
     suspendQueue,
+    updateQueueTime,
     deleteQueue,
   )
 where
@@ -65,8 +66,8 @@ getQueue QueueStore {queues, senders, notifiers} party qId =
       SNotifier -> TM.lookupIO qId notifiers $>>= (`TM.lookupIO` queues)
 
 secureQueue :: QueueStore -> RecipientId -> SndPublicAuthKey -> IO (Either ErrorType QueueRec)
-secureQueue QueueStore {queues} rId sKey =
-  atomically $ withQueue rId queues $ \qVar ->
+secureQueue QueueStore {queues} rId sKey = toResult <$> do
+  TM.lookupIO rId queues $>>= \qVar -> atomically $ 
     readTVar qVar >>= \q -> case senderKey q of
       Just k -> pure $ if sKey == k then Just q else Nothing
       _ ->
@@ -74,26 +75,30 @@ secureQueue QueueStore {queues} rId sKey =
          in writeTVar qVar q' $> Just q'
 
 addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType QueueRec)
-addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = atomically $ do
-  ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $
+addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = do
+  ifM (TM.memberIO nId notifiers) (pure $ Left DUPLICATE_) $
     withQueue rId queues $ \qVar -> do
       q <- readTVar qVar
       forM_ (notifier q) $ (`TM.delete` notifiers) . notifierId
-      writeTVar qVar $! q {notifier = Just ntfCreds}
+      let !q' = q {notifier = Just ntfCreds}
+      writeTVar qVar q'
       TM.insert nId rId notifiers
-      pure $ Just q
+      pure q'
 
 deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType ())
 deleteQueueNotifier QueueStore {queues, notifiers} rId =
-  atomically $ withQueue rId queues $ \qVar -> do
+  withQueue rId queues $ \qVar -> do
     q <- readTVar qVar
     forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers
     writeTVar qVar $! q {notifier = Nothing}
-    pure $ Just ()
 
 suspendQueue :: QueueStore -> RecipientId -> IO (Either ErrorType ())
 suspendQueue QueueStore {queues} rId =
-  atomically $ withQueue rId queues $ \qVar -> modifyTVar' qVar (\q -> q {status = QueueOff}) $> Just ()
+  withQueue rId queues (`modifyTVar'` \q -> q {status = QueueOff})
+
+updateQueueTime :: QueueStore -> RecipientId -> RoundedSystemTime -> IO ()
+updateQueueTime QueueStore {queues} rId t =
+  void $ withQueue rId queues (`modifyTVar'` \q -> q {updatedAt = Just t})
 
 deleteQueue :: QueueStore -> RecipientId -> IO (Either ErrorType QueueRec)
 deleteQueue QueueStore {queues, senders, notifiers} rId = atomically $ do
@@ -108,5 +113,5 @@ deleteQueue QueueStore {queues, senders, notifiers} rId = atomically $ do
 toResult :: Maybe a -> Either ErrorType a
 toResult = maybe (Left AUTH) Right
 
-withQueue :: RecipientId -> TMap RecipientId (TVar QueueRec) -> (TVar QueueRec -> STM (Maybe a)) -> STM (Either ErrorType a)
-withQueue rId queues f = toResult <$> TM.lookup rId queues $>>= f
+withQueue :: RecipientId -> TMap RecipientId (TVar QueueRec) -> (TVar QueueRec -> STM a) -> IO (Either ErrorType a)
+withQueue rId queues f = toResult <$> TM.lookupIO rId queues >>= atomically . mapM f
diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs
index 94a340d94..c47b06eb5 100644
--- a/src/Simplex/Messaging/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Server/StoreLog.hs
@@ -20,12 +20,14 @@ module Simplex.Messaging.Server.StoreLog
     logSuspendQueue,
     logDeleteQueue,
     logDeleteNotifier,
+    logUpdateQueueTime,
     readWriteStoreLog,
   )
 where
 
 import Control.Applicative (optional, (<|>))
 import Control.Monad (foldM, unless, when)
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Functor (($>))
@@ -33,7 +35,7 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Server.QueueStore (NtfCreds (..), QueueRec (..), ServerQueueStatus (..))
+import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Util (ifM)
 import System.Directory (doesFileExist, renameFile)
@@ -52,9 +54,19 @@ data StoreLogRecord
   | SuspendQueue QueueId
   | DeleteQueue QueueId
   | DeleteNotifier QueueId
+  | UpdateTime QueueId RoundedSystemTime
+
+data SLRTag
+  = CreateQueue_
+  | SecureQueue_
+  | AddNotifier_
+  | SuspendQueue_
+  | DeleteQueue_
+  | DeleteNotifier_
+  | UpdateTime_
 
 instance StrEncoding QueueRec where
-  strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier} =
+  strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, updatedAt} =
     B.unwords
       [ "rid=" <> strEncode recipientId,
         "rk=" <> strEncode recipientKey,
@@ -64,8 +76,10 @@ instance StrEncoding QueueRec where
       ]
       <> if sndSecure then " sndSecure=" <> strEncode sndSecure else ""
       <> maybe "" notifierStr notifier
+      <> maybe "" updatedAtStr updatedAt
     where
       notifierStr ntfCreds = " notifier=" <> strEncode ntfCreds
+      updatedAtStr t = " updated_at=" <> strEncode t
 
   strP = do
     recipientId <- "rid=" *> strP_
@@ -75,24 +89,49 @@ instance StrEncoding QueueRec where
     senderKey <- "sk=" *> strP
     sndSecure <- (" sndSecure=" *> strP) <|> pure False
     notifier <- optional $ " notifier=" *> strP
-    pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, status = QueueActive}
+    updatedAt <- optional $ " updated_at=" *> strP
+    pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, sndSecure, notifier, status = QueueActive, updatedAt}
+
+instance StrEncoding SLRTag where
+  strEncode = \case
+    CreateQueue_ -> "CREATE"
+    SecureQueue_ -> "SECURE"
+    AddNotifier_ -> "NOTIFIER"
+    SuspendQueue_ -> "SUSPEND"
+    DeleteQueue_ -> "DELETE"
+    DeleteNotifier_ -> "NDELETE"
+    UpdateTime_ -> "TIME"
+
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "CREATE" -> pure CreateQueue_
+      "SECURE" -> pure SecureQueue_
+      "NOTIFIER" -> pure AddNotifier_
+      "SUSPEND" -> pure SuspendQueue_
+      "DELETE" -> pure DeleteQueue_
+      "NDELETE" -> pure DeleteNotifier_
+      "TIME" -> pure UpdateTime_
+      s -> fail $ "invalid log record tag: " <> B.unpack s
 
 instance StrEncoding StoreLogRecord where
   strEncode = \case
-    CreateQueue q -> strEncode (Str "CREATE", q)
-    SecureQueue rId sKey -> strEncode (Str "SECURE", rId, sKey)
-    AddNotifier rId ntfCreds -> strEncode (Str "NOTIFIER", rId, ntfCreds)
-    SuspendQueue rId -> strEncode (Str "SUSPEND", rId)
-    DeleteQueue rId -> strEncode (Str "DELETE", rId)
-    DeleteNotifier rId -> strEncode (Str "NDELETE", rId)
+    CreateQueue q -> strEncode (CreateQueue_, q)
+    SecureQueue rId sKey -> strEncode (SecureQueue_, rId, sKey)
+    AddNotifier rId ntfCreds -> strEncode (AddNotifier_, rId, ntfCreds)
+    SuspendQueue rId -> strEncode (SuspendQueue_, rId)
+    DeleteQueue rId -> strEncode (DeleteQueue_, rId)
+    DeleteNotifier rId -> strEncode (DeleteNotifier_, rId)
+    UpdateTime rId t ->  strEncode (UpdateTime_, rId, t)
 
   strP =
-    "CREATE " *> (CreateQueue <$> strP)
-      <|> "SECURE " *> (SecureQueue <$> strP_ <*> strP)
-      <|> "NOTIFIER " *> (AddNotifier <$> strP_ <*> strP)
-      <|> "SUSPEND " *> (SuspendQueue <$> strP)
-      <|> "DELETE " *> (DeleteQueue <$> strP)
-      <|> "NDELETE " *> (DeleteNotifier <$> strP)
+    strP_ >>= \case
+      CreateQueue_ -> CreateQueue <$> strP
+      SecureQueue_ -> SecureQueue <$> strP_ <*> strP
+      AddNotifier_ -> AddNotifier <$> strP_ <*> strP
+      SuspendQueue_ -> SuspendQueue <$> strP
+      DeleteQueue_ -> DeleteQueue <$> strP
+      DeleteNotifier_ -> DeleteNotifier <$> strP
+      UpdateTime_ -> UpdateTime <$> strP_ <*> strP
 
 openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode)
 openWriteStoreLog f = do
@@ -138,6 +177,9 @@ logDeleteQueue s = writeStoreLogRecord s . DeleteQueue
 logDeleteNotifier :: StoreLog 'WriteMode -> QueueId -> IO ()
 logDeleteNotifier s = writeStoreLogRecord s . DeleteNotifier
 
+logUpdateQueueTime :: StoreLog 'WriteMode -> QueueId -> RoundedSystemTime -> IO ()
+logUpdateQueueTime s qId t = writeStoreLogRecord s $ UpdateTime qId t
+
 readWriteStoreLog :: FilePath -> IO (Map RecipientId QueueRec, StoreLog 'WriteMode)
 readWriteStoreLog f = do
   qs <- ifM (doesFileExist f) readQS (pure M.empty)
@@ -169,5 +211,6 @@ readQueues f = foldM processLine M.empty . LB.lines =<< LB.readFile f
           SuspendQueue qId -> M.adjust (\q -> q {status = QueueOff}) qId m
           DeleteQueue qId -> M.delete qId m
           DeleteNotifier qId -> M.adjust (\q -> q {notifier = Nothing}) qId m
+          UpdateTime qId t -> M.adjust (\q -> q {updatedAt = Just t}) qId m
         printError :: String -> IO ()
         printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s

From a70bd02c678e85c5b3559cdf1bf486d4f3550bee Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 10 Sep 2024 08:14:05 +0100
Subject: [PATCH 100/195] xftp server: round down file creation time to 1 hour
 (#1310)

---
 src/Simplex/FileTransfer/Server.hs          |  9 ++++++---
 src/Simplex/FileTransfer/Server/Store.hs    | 16 ++++++++++------
 src/Simplex/FileTransfer/Server/StoreLog.hs |  6 +++---
 3 files changed, 19 insertions(+), 12 deletions(-)

diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index a5bdd7877..434fcde4d 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -33,7 +33,6 @@ import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
-import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Word (Word32)
 import qualified Data.X509 as X
@@ -57,6 +56,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (CorrId (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity)
 import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
 import Simplex.Messaging.Server.Expiration
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, getRoundedSystemTime)
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -399,7 +399,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
       r <- runExceptT $ do
         sizes <- asks $ allowedChunkSizes . config
         unless (size file `elem` sizes) $ throwE SIZE
-        ts <- liftIO getSystemTime
+        ts <- liftIO getFileTime
         -- TODO validate body empty
         sId <- ExceptT $ addFileRetry st file 3 ts
         rcps <- mapM (ExceptT . addRecipientRetry st 3 sId) rks
@@ -412,7 +412,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
         let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
         pure $ FRSndIds sId rIds
       pure $ either FRErr id r
-    addFileRetry :: FileStore -> FileInfo -> Int -> SystemTime -> M (Either XFTPErrorType XFTPFileId)
+    addFileRetry :: FileStore -> FileInfo -> Int -> RoundedSystemTime -> M (Either XFTPErrorType XFTPFileId)
     addFileRetry st file n ts =
       retryAdd n $ \sId -> runExceptT $ do
         ExceptT $ addFile st sId file ts
@@ -531,6 +531,9 @@ deleteServerFile_ FileRec {senderId, fileInfo, filePath} = do
       liftIO $ atomicModifyIORef'_ (filesCount stats) (subtract 1)
       liftIO $ atomicModifyIORef'_ (filesSize stats) (subtract $ fromIntegral $ size fileInfo)
 
+getFileTime :: IO RoundedSystemTime
+getFileTime = getRoundedSystemTime fileTimePrecision
+
 expireServerFiles :: Maybe Int -> ExpirationConfig -> M ()
 expireServerFiles itemDelay expCfg = do
   st <- asks store
diff --git a/src/Simplex/FileTransfer/Server/Store.hs b/src/Simplex/FileTransfer/Server/Store.hs
index b56b516aa..10c34819f 100644
--- a/src/Simplex/FileTransfer/Server/Store.hs
+++ b/src/Simplex/FileTransfer/Server/Store.hs
@@ -17,6 +17,7 @@ module Simplex.FileTransfer.Server.Store
     expiredFilePath,
     getFile,
     ackFile,
+    fileTimePrecision,
   )
 where
 
@@ -25,12 +26,12 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Int (Int64)
 import Data.Set (Set)
 import qualified Data.Set as S
-import Data.Time.Clock.System (SystemTime (..))
 import Simplex.FileTransfer.Protocol (FileInfo (..), SFileParty (..), XFTPFileId)
 import Simplex.FileTransfer.Transport (XFTPErrorType (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime (..))
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (ifM, ($>>=))
@@ -46,9 +47,12 @@ data FileRec = FileRec
     fileInfo :: FileInfo,
     filePath :: TVar (Maybe FilePath),
     recipientIds :: TVar (Set RecipientId),
-    createdAt :: SystemTime
+    createdAt :: RoundedSystemTime
   }
 
+fileTimePrecision :: Int64
+fileTimePrecision = 3600 -- truncate creation time to 1 hour
+
 data FileRecipient = FileRecipient RecipientId RcvPublicAuthKey
 
 instance StrEncoding FileRecipient where
@@ -62,14 +66,14 @@ newFileStore = do
   usedStorage <- newTVarIO 0
   pure FileStore {files, recipients, usedStorage}
 
-addFile :: FileStore -> SenderId -> FileInfo -> SystemTime -> STM (Either XFTPErrorType ())
+addFile :: FileStore -> SenderId -> FileInfo -> RoundedSystemTime -> STM (Either XFTPErrorType ())
 addFile FileStore {files} sId fileInfo createdAt =
   ifM (TM.member sId files) (pure $ Left DUPLICATE_) $ do
     f <- newFileRec sId fileInfo createdAt
     TM.insert sId f files
     pure $ Right ()
 
-newFileRec :: SenderId -> FileInfo -> SystemTime -> STM FileRec
+newFileRec :: SenderId -> FileInfo -> RoundedSystemTime -> STM FileRec
 newFileRec senderId fileInfo createdAt = do
   recipientIds <- newTVar S.empty
   filePath <- newTVar Nothing
@@ -120,8 +124,8 @@ getFile st party fId = case party of
 expiredFilePath :: FileStore -> XFTPFileId -> Int64 -> STM (Maybe (Maybe FilePath))
 expiredFilePath FileStore {files} sId old =
   TM.lookup sId files
-    $>>= \FileRec {filePath, createdAt} ->
-      if systemSeconds createdAt < old
+    $>>= \FileRec {filePath, createdAt = RoundedSystemTime createdAt} ->
+      if createdAt + fileTimePrecision < old
         then Just <$> readTVar filePath
         else pure Nothing
 
diff --git a/src/Simplex/FileTransfer/Server/StoreLog.hs b/src/Simplex/FileTransfer/Server/StoreLog.hs
index 8e8add3d6..9d3919c2c 100644
--- a/src/Simplex/FileTransfer/Server/StoreLog.hs
+++ b/src/Simplex/FileTransfer/Server/StoreLog.hs
@@ -28,18 +28,18 @@ 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.Time.Clock.System (SystemTime)
 import Simplex.FileTransfer.Protocol (FileInfo (..))
 import Simplex.FileTransfer.Server.Store
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId)
+import Simplex.Messaging.Server.QueueStore (RoundedSystemTime)
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.Util (bshow, whenM)
 import System.Directory (doesFileExist, renameFile)
 import System.IO
 
 data FileStoreLogRecord
-  = AddFile SenderId FileInfo SystemTime
+  = AddFile SenderId FileInfo RoundedSystemTime
   | PutFile SenderId FilePath
   | AddRecipients SenderId (NonEmpty FileRecipient)
   | DeleteFile SenderId
@@ -64,7 +64,7 @@ instance StrEncoding FileStoreLogRecord where
 logFileStoreRecord :: StoreLog 'WriteMode -> FileStoreLogRecord -> IO ()
 logFileStoreRecord = writeStoreLogRecord
 
-logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> SystemTime -> IO ()
+logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> RoundedSystemTime -> IO ()
 logAddFile s = logFileStoreRecord s .:. AddFile
 
 logPutFile :: StoreLog 'WriteMode -> SenderId -> FilePath -> IO ()

From 7c25b3b1e05b62c9f7acae8822ce3c556b19ee74 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Wed, 11 Sep 2024 13:16:51 +0100
Subject: [PATCH 101/195] smp protocol: send DELD when subscribed queue is
 deleted (#1312)

* smp protocol: send DELD when subscribed queue is deleted

* fix, test

* refactor

* send DELD event only if the client supports it (version 10); send END otherwise

* fix test

* notify on notifier rotation

* increase test delays
---
 src/Simplex/Messaging/Agent.hs                | 13 ++-
 src/Simplex/Messaging/Agent/Protocol.hs       |  3 +
 .../Messaging/Notifications/Protocol.hs       |  5 ++
 src/Simplex/Messaging/Notifications/Server.hs |  1 +
 src/Simplex/Messaging/Protocol.hs             |  8 ++
 src/Simplex/Messaging/Server.hs               | 88 ++++++++++---------
 src/Simplex/Messaging/Server/Env/STM.hs       | 14 ++-
 .../Messaging/Server/QueueStore/STM.hs        | 19 ++--
 src/Simplex/Messaging/Transport.hs            | 11 ++-
 tests/AgentTests/NotificationTests.hs         |  2 +-
 tests/ServerTests.hs                          |  9 +-
 tests/XFTPAgent.hs                            |  4 +-
 12 files changed, 111 insertions(+), 66 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 2ead387ca..e8aa309df 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -166,7 +166,7 @@ import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
-import Simplex.Messaging.Client (ProtocolClient (..), SMPClientError, ServerTransmission (..), ServerTransmissionBatch, temporaryClientError, unexpectedResponse)
+import Simplex.Messaging.Client (SMPClientError, ServerTransmission (..), ServerTransmissionBatch, temporaryClientError, unexpectedResponse)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs)
 import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
@@ -181,7 +181,7 @@ import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBod
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (SMPVersion, THandleParams (sessionId))
+import Simplex.Messaging.Transport (SMPVersion)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import Simplex.RemoteControl.Client
@@ -2450,17 +2450,14 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
               handleNotifyAck :: AM ACKd -> AM ACKd
               handleNotifyAck m = m `catchAgentError` \e -> notify (ERR e) >> ack
           SMP.END ->
-            atomically (TM.lookup tSess (smpClients c) $>>= (tryReadTMVar . sessionVar) >>= processEND)
+            atomically (ifM (activeClientSession c tSess sessId) (removeSubscription c connId $> True) (pure False))
               >>= notifyEnd
             where
-              processEND = \case
-                Just (Right clnt)
-                  | sessId == sessionId (thParams $ connectedClient clnt) ->
-                      removeSubscription c connId $> True
-                _ -> pure False
               notifyEnd removed
                 | removed = notify END >> logServer "<--" c srv rId "END"
                 | otherwise = logServer "<--" c srv rId "END from disconnected client - ignored"
+          -- Possibly, we need to add some flag to connection that it was deleted
+          SMP.DELD -> atomically (removeSubscription c connId) >> notify DELD
           SMP.ERR e -> notify $ ERR $ SMP (B.unpack $ strEncode srv) e
           r -> unexpected r
         where
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 178d87109..13e5011a2 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -344,6 +344,7 @@ data AEvent (e :: AEntity) where
   INFO :: PQSupport -> ConnInfo -> AEvent AEConn
   CON :: PQEncryption -> AEvent AEConn -- notification that connection is established
   END :: AEvent AEConn
+  DELD :: AEvent AEConn
   CONNECT :: AProtocolType -> TransportHost -> AEvent AENone
   DISCONNECT :: AProtocolType -> TransportHost -> AEvent AENone
   DOWN :: SMPServer -> [ConnId] -> AEvent AENone
@@ -413,6 +414,7 @@ data AEventTag (e :: AEntity) where
   INFO_ :: AEventTag AEConn
   CON_ :: AEventTag AEConn
   END_ :: AEventTag AEConn
+  DELD_ :: AEventTag AEConn
   CONNECT_ :: AEventTag AENone
   DISCONNECT_ :: AEventTag AENone
   DOWN_ :: AEventTag AENone
@@ -466,6 +468,7 @@ aEventTag = \case
   INFO {} -> INFO_
   CON _ -> CON_
   END -> END_
+  DELD -> DELD_
   CONNECT {} -> CONNECT_
   DISCONNECT {} -> DISCONNECT_
   DOWN {} -> DOWN_
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 736f164ba..556d4a930 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -443,6 +443,8 @@ data NtfSubStatus
     NSInactive
   | -- | END received
     NSEnd
+  | -- | DELD received (connection was deleted)
+    NSDeleted
   | -- | SMP AUTH error
     NSAuth
   | -- | SMP error other than AUTH
@@ -456,6 +458,7 @@ ntfShouldSubscribe = \case
   NSActive -> True
   NSInactive -> True
   NSEnd -> False
+  NSDeleted -> False
   NSAuth -> False
   NSErr _ -> False
 
@@ -466,6 +469,7 @@ instance Encoding NtfSubStatus where
     NSActive -> "ACTIVE"
     NSInactive -> "INACTIVE"
     NSEnd -> "END"
+    NSDeleted -> "DELETED"
     NSAuth -> "AUTH"
     NSErr err -> "ERR " <> err
   smpP =
@@ -475,6 +479,7 @@ instance Encoding NtfSubStatus where
       "ACTIVE" -> pure NSActive
       "INACTIVE" -> pure NSInactive
       "END" -> pure NSEnd
+      "DELETED" -> pure NSDeleted
       "AUTH" -> pure NSAuth
       "ERR" -> NSErr <$> (A.space *> A.takeByteString)
       _ -> fail "bad NtfSubStatus"
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 2f4093ac3..2c964f9bf 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -226,6 +226,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
             Right SMP.END ->
               whenM (atomically $ activeClientSession' ca sessionId srv) $
                 updateSubStatus smpQueue NSEnd
+            Right SMP.DELD -> updateSubStatus smpQueue NSDeleted
             Right (SMP.ERR e) -> logError $ "SMP server error: " <> tshow e
             Right _ -> logError "SMP server unexpected response"
             Left e -> logError $ "SMP client error: " <> tshow e
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index 9dc6a7ea9..cad84454f 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -484,6 +484,7 @@ data BrokerMsg where
   RRES :: EncFwdResponse -> BrokerMsg -- relay to proxy
   PRES :: EncResponse -> BrokerMsg -- proxy to client
   END :: BrokerMsg
+  DELD :: BrokerMsg
   INFO :: QueueInfo -> BrokerMsg
   OK :: BrokerMsg
   ERR :: ErrorType -> BrokerMsg
@@ -705,6 +706,7 @@ data BrokerMsgTag
   | RRES_
   | PRES_
   | END_
+  | DELD_
   | INFO_
   | OK_
   | ERR_
@@ -778,6 +780,7 @@ instance Encoding BrokerMsgTag where
     RRES_ -> "RRES"
     PRES_ -> "PRES"
     END_ -> "END"
+    DELD_ -> "DELD"
     INFO_ -> "INFO"
     OK_ -> "OK"
     ERR_ -> "ERR"
@@ -794,6 +797,7 @@ instance ProtocolMsgTag BrokerMsgTag where
     "RRES" -> Just RRES_
     "PRES" -> Just PRES_
     "END" -> Just END_
+    "DELD" -> Just DELD_
     "INFO" -> Just INFO_
     "OK" -> Just OK_
     "ERR" -> Just ERR_
@@ -1423,6 +1427,9 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     RRES (EncFwdResponse encBlock) -> e (RRES_, ' ', Tail encBlock)
     PRES (EncResponse encBlock) -> e (PRES_, ' ', Tail encBlock)
     END -> e END_
+    DELD
+      | v >= deletedEventSMPVersion -> e DELD_
+      | otherwise -> e END_
     INFO info -> e (INFO_, ' ', info)
     OK -> e OK_
     ERR err -> e (ERR_, ' ', err)
@@ -1448,6 +1455,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     RRES_ -> RRES <$> (EncFwdResponse . unTail <$> _smpP)
     PRES_ -> PRES <$> (EncResponse . unTail <$> _smpP)
     END_ -> pure END
+    DELD_ -> pure DELD
     INFO_ -> INFO <$> _smpP
     OK_ -> pure OK
     ERR_ -> ERR <$> _smpP
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index e2d5edc4e..969c5399b 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -136,9 +136,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
   expired <- restoreServerMessages
   restoreServerStats expired
   raceAny_
-    ( serverThread s "server subscribedQ" subscribedQ subscribers pendingENDs subscriptions cancelSub
-        : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers pendingNtfENDs ntfSubscriptions (\_ -> pure ())
-        : sendPendingENDsThread s
+    ( serverThread s "server subscribedQ" True subscribedQ subscribers pendingENDs subscriptions cancelSub
+        : serverThread s "server deletedQ" False deletedQ  subscribers pendingDELDs subscriptions cancelSub
+        : serverThread s "server ntfSubscribedQ" True ntfSubscribedQ Env.notifiers pendingNtfENDs ntfSubscriptions (\_ -> pure ())
+        : serverThread s "server ntfDeletedQ" False ntfDeletedQ Env.notifiers pendingNtfDELDs ntfSubscriptions (\_ -> pure ())
+        : sendPendingEvtsThread s
         : receiveFromProxyAgent pa
         : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
     )
@@ -163,13 +165,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       forall s.
       Server ->
       String ->
-      (Server -> TQueue (QueueId, ClientId, Subscribed)) ->
+      Subscribed ->
+      (Server -> TQueue (QueueId, ClientId)) ->
       (Server -> TMap QueueId (TVar Client)) ->
       (Server -> TVar (IM.IntMap (NonEmpty RecipientId))) ->
       (Client -> TMap QueueId s) ->
       (s -> IO ()) ->
       M ()
-    serverThread s label subQ subs ends clientSubs unsub = do
+    serverThread s label subscribed subQ subs pendingEvts clientSubs unsub = do
       labelMyThread label
       cls <- asks clients
       liftIO . forever $
@@ -177,8 +180,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           $>>= endPreviousSubscriptions
           >>= mapM_ unsub
       where
-        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, ClientId, Bool) -> STM (Maybe (QueueId, Client))
-        updateSubscribers cls (qId, clntId, subscribed) =
+        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, ClientId) -> STM (Maybe (QueueId, Client))
+        updateSubscribers cls (qId, clntId) =
           -- Client lookup by ID is in the same STM transaction.
           -- In case client disconnects during the transaction,
           -- it will be re-evaluated, and the client won't be stored as subscribed.
@@ -201,37 +204,41 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
               | otherwise = (\yes -> if yes then Just (qId, c') else Nothing) <$> readTVar (connected c')
         endPreviousSubscriptions :: (QueueId, Client) -> IO (Maybe s)
         endPreviousSubscriptions (qId, c) = do
-          atomically $ modifyTVar' (ends s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
+          atomically $ modifyTVar' (pendingEvts s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
           atomically $ TM.lookupDelete qId (clientSubs c)
 
-    sendPendingENDsThread :: Server -> M ()
-    sendPendingENDsThread s = do
+    sendPendingEvtsThread :: Server -> M ()
+    sendPendingEvtsThread s = do
       endInt <- asks $ pendingENDInterval . config
       cls <- asks clients
       forever $ do
         threadDelay endInt
-        sendPending cls $ pendingENDs s
-        sendPending cls $ pendingNtfENDs s
+        sendPending cls END $ pendingENDs s
+        sendPending cls DELD $ pendingDELDs s
+        sendPending cls END $ pendingNtfENDs s
+        sendPending cls DELD $ pendingNtfDELDs s
       where
-        sendPending cls ref = do
+        sendPending cls evt ref = do
           ends <- atomically $ swapTVar ref IM.empty
           unless (null ends) $ forM_ (IM.assocs ends) $ \(cId, qIds) ->
-            mapM_ (queueENDs qIds) . join . IM.lookup cId =<< readTVarIO cls
-        queueENDs qIds c@Client {connected, sndQ = q} =
+            mapM_ (queueEvts qIds evt) . join . IM.lookup cId =<< readTVarIO cls
+        queueEvts qIds evt c@Client {connected, sndQ = q} =
           whenM (readTVarIO connected) $ do
             sent <- atomically $ ifM (isFullTBQueue q) (pure False) (writeTBQueue q ts $> True)
             if sent
               then updateEndStats
               else -- if queue is full it can block
-                forkClient c ("sendPendingENDsThread.queueENDs") $
+                forkClient c ("sendPendingEvtsThread.queueEvts") $
                   atomically (writeTBQueue q ts) >> updateEndStats
           where
-            ts = L.map (CorrId "",,END) qIds
-            updateEndStats = do
-              stats <- asks serverStats
-              let len = L.length qIds
-              liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
-              liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
+            ts = L.map (CorrId "",,evt) qIds
+            updateEndStats = case evt of
+              END -> do
+                stats <- asks serverStats
+                let len = L.length qIds
+                liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
+                liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
+              _ -> pure ()
 
     receiveFromProxyAgent :: ProxyAgent -> M ()
     receiveFromProxyAgent ProxyAgent {smpAgent = SMPClientAgent {agentQ}} =
@@ -892,7 +899,7 @@ forkClient Client {endThreads, endThreadSeq} label action = do
   mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId
 
 client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
-client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers, notifiers} = do
+client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, deletedQ, ntfSubscribedQ, ntfDeletedQ, subscribers, notifiers} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
   forever $
     atomically (readTBQueue rcvQ)
@@ -985,11 +992,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
     processCommand (qr_, (corrId, entId, cmd)) = case cmd of
       Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command)
       Cmd SSender command -> Just <$> case command of
-        SKEY sKey -> (corrId,entId,) <$> case qr_ of
-          Just qr@QueueRec {sndSecure}
-            | sndSecure -> secureQueue_ "SKEY" qr sKey
-            | otherwise -> pure $ ERR AUTH
-          Nothing -> pure $ ERR INTERNAL
+        SKEY sKey ->
+          withQueue $ \QueueRec {sndSecure, recipientId} ->
+            (corrId,entId,) <$> if sndSecure then secureQueue_ "SKEY" recipientId sKey else pure $ ERR AUTH
         SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
         PING -> pure (corrId, NoEntity, PONG)
         RFWD encBlock -> (corrId, NoEntity,) <$> processForwardedCommand encBlock
@@ -1009,9 +1014,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           SUB -> withQueue (`subscribeQueue` entId)
           GET -> withQueue getMessage
           ACK msgId -> withQueue (`acknowledgeMsg` msgId)
-          KEY sKey -> (corrId,entId,) <$> case qr_ of
-            Just qr -> secureQueue_ "KEY" qr sKey
-            Nothing -> pure $ ERR INTERNAL
+          KEY sKey ->
+            withQueue $ \QueueRec {recipientId} ->
+              (corrId,entId,) <$> secureQueue_ "KEY" recipientId sKey
           NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
           NDEL -> deleteQueueNotifier_ st
           OFF -> suspendQueue_ st
@@ -1063,10 +1068,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               n <- asks $ queueIdBytes . config
               liftM2 (,) (randomId n) (randomId n)
 
-        secureQueue_ :: T.Text -> QueueRec -> SndPublicAuthKey -> M BrokerMsg
-        secureQueue_ name qr@QueueRec {recipientId = rId} sKey = time name $ do
+        secureQueue_ :: T.Text -> RecipientId -> SndPublicAuthKey -> M BrokerMsg
+        secureQueue_ name rId sKey = time name $ do
           withLog $ \s -> logSecureQueue s rId sKey
-          updateQueueDate qr
           st <- asks queueStore
           stats <- asks serverStats
           incStat $ qSecured stats
@@ -1086,20 +1090,22 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               liftIO (addQueueNotifier st entId ntfCreds) >>= \case
                 Left DUPLICATE_ -> addNotifierRetry (n - 1) rcvPublicDhKey rcvNtfDhSecret
                 Left e -> pure $ ERR e
-                Right _ -> do
+                Right nId_ -> do
                   withLog $ \s -> logAddNotifier s entId ntfCreds
                   incStat . ntfCreated =<< asks serverStats
+                  forM_ nId_ $ \nId -> atomically $ writeTQueue ntfDeletedQ (nId, clientId)
                   pure $ NID notifierId rcvPublicDhKey
 
         deleteQueueNotifier_ :: QueueStore -> M (Transmission BrokerMsg)
         deleteQueueNotifier_ st = do
           withLog (`logDeleteNotifier` entId)
           liftIO (deleteQueueNotifier st entId) >>= \case
-            Right () -> do
+            Right (Just nId) -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              atomically $ writeTQueue ntfSubscribedQ (entId, clientId, False)
+              atomically $ writeTQueue ntfDeletedQ (nId, clientId)
               incStat . ntfDeleted =<< asks serverStats
               pure ok
+            Right Nothing -> pure ok
             Left e -> pure $ err e
 
         suspendQueue_ :: QueueStore -> M (Transmission BrokerMsg)
@@ -1124,7 +1130,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           where
             newSub :: M Sub
             newSub = time "SUB newSub" . atomically $ do
-              writeTQueue subscribedQ (rId, clientId, True)
+              writeTQueue subscribedQ (rId, clientId)
               sub <- newSubscription NoSub
               TM.insert rId sub subscriptions
               pure sub
@@ -1199,7 +1205,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           pure ok
           where
             newSub = do
-              writeTQueue ntfSubscribedQ (entId, clientId, True)
+              writeTQueue ntfSubscribedQ (entId, clientId)
               TM.insert entId () ntfSubscriptions
 
         acknowledgeMsg :: QueueRec -> MsgId -> M (Transmission BrokerMsg)
@@ -1480,9 +1486,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           liftIO (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case
             Right q -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              atomically $ writeTQueue subscribedQ (entId, clientId, False)
+              atomically $ writeTQueue deletedQ (entId, clientId)
               forM_ (notifierId <$> notifier q) $ \nId ->
-                atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
+                atomically $ writeTQueue ntfDeletedQ (nId, clientId)
               updateDeletedStats q
               pure ok
             Left e -> pure $ err e
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index dac00f228..8012f5154 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -136,12 +136,16 @@ data Env = Env
 type Subscribed = Bool
 
 data Server = Server
-  { subscribedQ :: TQueue (RecipientId, ClientId, Subscribed),
+  { subscribedQ :: TQueue (RecipientId, ClientId),
+    deletedQ :: TQueue (RecipientId, ClientId),
     subscribers :: TMap RecipientId (TVar Client),
-    ntfSubscribedQ :: TQueue (NotifierId, ClientId, Subscribed),
+    ntfSubscribedQ :: TQueue (NotifierId, ClientId),
+    ntfDeletedQ :: TQueue (NotifierId, ClientId),
     notifiers :: TMap NotifierId (TVar Client),
     pendingENDs :: TVar (IntMap (NonEmpty RecipientId)),
+    pendingDELDs :: TVar (IntMap (NonEmpty RecipientId)),
     pendingNtfENDs :: TVar (IntMap (NonEmpty NotifierId)),
+    pendingNtfDELDs :: TVar (IntMap (NonEmpty NotifierId)),
     savingLock :: Lock
   }
 
@@ -181,13 +185,17 @@ data Sub = Sub
 newServer :: IO Server
 newServer = do
   subscribedQ <- newTQueueIO
+  deletedQ <- newTQueueIO
   subscribers <- TM.emptyIO
   ntfSubscribedQ <- newTQueueIO
+  ntfDeletedQ <- newTQueueIO
   notifiers <- TM.emptyIO
   pendingENDs <- newTVarIO IM.empty
+  pendingDELDs <- newTVarIO IM.empty
   pendingNtfENDs <- newTVarIO IM.empty
+  pendingNtfDELDs <- newTVarIO IM.empty
   savingLock <- atomically createLock
-  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, pendingENDs, pendingNtfENDs, savingLock}
+  return Server {subscribedQ, deletedQ, subscribers, ntfSubscribedQ, ntfDeletedQ, notifiers, pendingENDs, pendingDELDs, pendingNtfENDs, pendingNtfDELDs, savingLock}
 
 newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
 newClient clientId qSize thVersion sessionId createdAt = do
diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index da9dc4bb3..5efff9cfd 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -74,23 +74,26 @@ secureQueue QueueStore {queues} rId sKey = toResult <$> do
         let !q' = q {senderKey = Just sKey}
          in writeTVar qVar q' $> Just q'
 
-addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType QueueRec)
+addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType (Maybe NotifierId))
 addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = do
-  ifM (TM.memberIO nId notifiers) (pure $ Left DUPLICATE_) $
-    withQueue rId queues $ \qVar -> do
+  TM.lookupIO rId queues >>= \case
+    Just qVar -> atomically $ ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $ do
       q <- readTVar qVar
-      forM_ (notifier q) $ (`TM.delete` notifiers) . notifierId
+      nId_ <- forM (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers $> notifierId
       let !q' = q {notifier = Just ntfCreds}
       writeTVar qVar q'
       TM.insert nId rId notifiers
-      pure q'
+      pure $ Right nId_
+    Nothing -> pure $ Left AUTH
 
-deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType ())
+deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType (Maybe NotifierId))
 deleteQueueNotifier QueueStore {queues, notifiers} rId =
   withQueue rId queues $ \qVar -> do
     q <- readTVar qVar
-    forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers
-    writeTVar qVar $! q {notifier = Nothing}
+    forM (notifier q) $ \NtfCreds {notifierId} -> do
+      TM.delete notifierId notifiers
+      writeTVar qVar $! q {notifier = Nothing}
+      pure notifierId
 
 suspendQueue :: QueueStore -> RecipientId -> IO (Either ErrorType ())
 suspendQueue QueueStore {queues} rId =
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index 4b581bb6c..e681ec396 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -47,6 +47,7 @@ module Simplex.Messaging.Transport
     authCmdsSMPVersion,
     sendingProxySMPVersion,
     sndAuthKeySMPVersion,
+    deletedEventSMPVersion,
     simplexMQVersion,
     smpBlockSize,
     TransportConfig (..),
@@ -130,6 +131,9 @@ smpBlockSize = 16384
 -- 5 - basic auth for SMP servers (11/12/2022)
 -- 6 - allow creating queues without subscribing (9/10/2023)
 -- 7 - support authenticated encryption to verify senders' commands, imply but do NOT send session ID in signed part (4/30/2024)
+-- 8 - SMP proxy for sender commands
+-- 9 - faster handshake: SKEY command for sender to secure queue
+-- 10 - DELD event to subscriber when queue is deleted via another connnection
 
 data SMPVersion
 
@@ -160,14 +164,17 @@ sendingProxySMPVersion = VersionSMP 8
 sndAuthKeySMPVersion :: VersionSMP
 sndAuthKeySMPVersion = VersionSMP 9
 
+deletedEventSMPVersion :: VersionSMP
+deletedEventSMPVersion = VersionSMP 10
+
 currentClientSMPRelayVersion :: VersionSMP
-currentClientSMPRelayVersion = VersionSMP 9
+currentClientSMPRelayVersion = VersionSMP 10
 
 legacyServerSMPRelayVersion :: VersionSMP
 legacyServerSMPRelayVersion = VersionSMP 6
 
 currentServerSMPRelayVersion :: VersionSMP
-currentServerSMPRelayVersion = VersionSMP 9
+currentServerSMPRelayVersion = VersionSMP 10
 
 -- Max SMP protocol version to be used in e2e encrypted
 -- connection between client and server, as defined by SMP proxy.
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 62429a456..a25564a0b 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -166,7 +166,7 @@ testNtfMatrix t runTest = do
     it "curr servers; curr clients" $ runNtfTestCfg t 1 cfg ntfServerCfg agentCfg agentCfg runTest
     it "curr servers; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
     it "prev servers; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
-    it "prev servers; curr clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest
+    it "prev servers; curr clients" $ runNtfTestCfg t 1 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest
     -- servers can be upgraded in any order
     it "servers: curr SMP, prev NTF; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
     it "servers: prev SMP, curr NTF; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 63508a033..0a1729ab8 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -385,6 +385,10 @@ testSwitchSub (ATransport t) =
       Resp "bcda" _ ok3 <- signSendRecv rh2 rKey ("bcda", rId, ACK mId3)
       (ok3, OK) #== "accepts ACK from the 2nd TCP connection"
 
+      Resp "cdab" _ OK <- signSendRecv rh1 rKey ("cdab", rId, DEL)
+      Resp "" rId' DELD <- tGet1 rh2
+      (rId', rId) #== "connection deleted event delivered to subscribed client"
+
       1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh1 >>= \case
         Nothing -> return ()
         Just _ -> error "nothing else is delivered to the 1st TCP connection"
@@ -839,7 +843,8 @@ testMessageNotifications (ATransport t) =
       Resp "3a" _ OK <- signSendRecv rh rKey ("3a", rId, ACK mId1)
       Resp "" _ (NMSG _ _) <- tGet1 nh1
       Resp "4" _ OK <- signSendRecv nh2 nKey ("4", nId, NSUB)
-      Resp "" _ END <- tGet1 nh1
+      Resp "" nId2 END <- tGet1 nh1
+      nId2 `shouldBe` nId
       Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello again")
       Resp "" _ (Msg mId2 msg2) <- tGet1 rh
       Resp "5a" _ OK <- signSendRecv rh rKey ("5a", rId, ACK mId2)
@@ -849,6 +854,8 @@ testMessageNotifications (ATransport t) =
         Nothing -> pure ()
         Just _ -> error "nothing else should be delivered to the 1st notifier's TCP connection"
       Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, NDEL)
+      Resp "" nId3 DELD <- tGet1 nh2
+      nId3 `shouldBe` nId
       Resp "7" _ OK <- signSendRecv sh sKey ("7", sId, _SEND' "hello there")
       Resp "" _ (Msg mId3 msg3) <- tGet1 rh
       (dec mId3 msg3, Right "hello there") #== "delivered from queue again"
diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index 8de86eff1..9803cb8b9 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -429,7 +429,7 @@ testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do
       ("", sfId', SFPROG _ _) <- sfGet sndr'
       liftIO $ sfId' `shouldBe` sfId
 
-  threadDelay 100000
+  threadDelay 200000
 
   withXFTPServerStoreLogOn $ \_ -> do
     -- send file - should continue uploading with server up
@@ -443,7 +443,7 @@ testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do
       pure rfd1
 
     -- prefix path should be removed after sending file
-    threadDelay 100000
+    threadDelay 200000
     doesDirectoryExist prefixPath `shouldReturn` False
     doesFileExist encPath `shouldReturn` False
 

From 3b50e1fb7d7887b55f2261ea4ac1c791f0ab8dd7 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Wed, 11 Sep 2024 18:41:40 +0100
Subject: [PATCH 102/195] ntf server: only use SOCKS proxy for servers without
 public address (#1314)

---
 src/Simplex/Messaging/Notifications/Server/Main.hs |  9 ++++++++-
 src/Simplex/Messaging/Server/Main.hs               | 11 ++++++-----
 2 files changed, 14 insertions(+), 6 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index cd8561dd3..5002d2d45 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -16,7 +16,7 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
-import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
+import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Server (runNtfServer)
@@ -26,6 +26,7 @@ import Simplex.Messaging.Notifications.Transport (supportedNTFHandshakes, suppor
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Expiration
+import Simplex.Messaging.Server.Main (textToHostMode)
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
@@ -92,6 +93,10 @@ ntfServerCLI cfgPath logPath =
             <> "websockets: off\n\n\
                \[SUBSCRIBER]\n\
                \# Network configuration for notification server client.\n\
+               \# `host_mode` can be 'public' (default) or 'onion'.\n\
+               \# It defines prefferred hostname for destination servers with multiple hostnames.\n\
+               \# host_mode: public\n\
+               \# required_host_mode: off\n\n\
                \# SOCKS proxy port for subscribing to SMP servers.\n\
                \# You may need a separate instance of SOCKS proxy for incoming single-hop requests.\n\
                \# socks_proxy: localhost:9050\n\n\
@@ -134,6 +139,8 @@ ntfServerCLI cfgPath logPath =
                             defaultNetworkConfig
                               { socksProxy = either error id <$!> strDecodeIni "SUBSCRIBER" "socks_proxy" ini,
                                 socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini,
+                                hostMode = either (const HMPublic) textToHostMode $ lookupValue "SUBSCRIBER" "host_mode" ini,
+                                requiredHostMode = fromMaybe False $ iniOnOff "SUBSCRIBER" "required_host_mode" ini,
                                 smpPingInterval = 60_000_000 -- 1 minutes
                               }
                         },
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index e06bdd3ee..8a1ea0a60 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -318,11 +318,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
               serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini,
               information = serverPublicInfo ini
             }
-        textToHostMode :: Text -> HostMode
-        textToHostMode = \case
-          "public" -> HMPublic
-          "onion" -> HMOnionViaSocks
-          s -> error . T.unpack $ "Invalid host_mode: " <> s
         textToOwnServers :: Text -> [ByteString]
         textToOwnServers = map encodeUtf8 . T.words
 
@@ -346,6 +341,12 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
           where
             isOnion = \case THOnionHost _ -> True; _ -> False
 
+textToHostMode :: Text -> HostMode
+textToHostMode = \case
+  "public" -> HMPublic
+  "onion" -> HMOnionViaSocks
+  s -> error . T.unpack $ "Invalid host_mode: " <> s
+
 data EmbeddedWebParams = EmbeddedWebParams
   { webStaticPath :: FilePath,
     webHttpPort :: Maybe Int,

From 62133ceb24b2ccccd2a8e17a22beee1449b2bd27 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 11 Sep 2024 18:45:44 +0100
Subject: [PATCH 103/195] Revert "xrcp: use SHA3-256 in hybrid key agreement
 (#1302)"

This reverts commit 67d38090ed614f1a7c45dd0a52f5dc5b110d5a72.
---
 protocol/xrcp.md                          | 4 ++--
 src/Simplex/Messaging/Crypto/SNTRUP761.hs | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/protocol/xrcp.md b/protocol/xrcp.md
index 2ed2c8d62..9f7187e66 100644
--- a/protocol/xrcp.md
+++ b/protocol/xrcp.md
@@ -250,7 +250,7 @@ In pseudo-code:
 ```
 // session 1
 hostHelloSecret(1) = dhSecret(1)
-sessionSecret(1) = sha3-256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
+sessionSecret(1) = sha256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
 dhSecret(1) = dh(hostHelloDhKey(1), controllerInvitationDhKey(1))
 kemCiphertext(1) = enc(kemSecret(1), kemEncKey(1))
 // kemEncKey is included in host HELLO, kemCiphertext - in controller HELLO
@@ -262,7 +262,7 @@ dhSecret(n') = dh(hostHelloDhKey(n - 1), controllerDhKey(n))
 
 // session n
 hostHelloSecret(n) = dhSecret(n)
-sessionSecret(n) = sha3-256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
+sessionSecret(n) = sha256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
 dhSecret(n) = dh(hostHelloDhKey(n), controllerDhKey(n))
 // controllerDhKey(n) is either from invitation or from multicast announcement
 kemCiphertext(n) = enc(kemSecret(n), kemEncKey(n))
diff --git a/src/Simplex/Messaging/Crypto/SNTRUP761.hs b/src/Simplex/Messaging/Crypto/SNTRUP761.hs
index 6f903804e..99b2771f6 100644
--- a/src/Simplex/Messaging/Crypto/SNTRUP761.hs
+++ b/src/Simplex/Messaging/Crypto/SNTRUP761.hs
@@ -4,7 +4,7 @@
 
 module Simplex.Messaging.Crypto.SNTRUP761 where
 
-import Crypto.Hash (Digest, SHA3_256, hash)
+import Crypto.Hash (Digest, SHA256, hash)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
@@ -28,4 +28,4 @@ kcbEncrypt (KEMHybridSecret k) = sbEncrypt_ k
 kemHybridSecret :: PublicKeyX25519 -> PrivateKeyX25519 -> KEMSharedKey -> KEMHybridSecret
 kemHybridSecret k pk (KEMSharedKey kem) =
   let DhSecretX25519 dh = C.dh' k pk
-   in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA3_256)
+   in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA256)

From f5e666ae4f41351d5d5ac416cd6fb1d5fadc8ab7 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 11 Sep 2024 18:51:26 +0100
Subject: [PATCH 104/195] 6.0.4.0

---
 CHANGELOG.md    | 22 ++++++++++++++++++++++
 package.yaml    |  2 +-
 simplexmq.cabal |  2 +-
 3 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 5c78253a9..21e752c68 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,25 @@
+# 6.0.4
+
+SMP server:
+- better performance/memory: fewer map updates on re-subscriptions (#1297), split and reduce STM transactions (#1294)
+- send DELD when subscribed queue is deleted (#1312)
+- add created/updated/used date to queues to manage expiration (#1306)
+
+XFTP server: truncate file creation time to 1 hour (#1310)
+
+Servers:
+- bind control port only to 127.0.0.1 for better security in case of firewall misconfiguration (#1280)
+- reduce memory used for period stats (#1298)
+
+Agent: process last notification from list (#1307)
+- report receive file error with redirected file ID, when redirect is present (#1304)
+- special error when deleted user record is not in database (#1303)
+- fix race when sending a message to the deleted connection (#1296)
+- support for multiple messages in a single notification
+
+Ntf server:
+- only use SOCKS proxy for servers without public address (#1314)
+
 # 6.0.3
 
 Agent:
diff --git a/package.yaml b/package.yaml
index 26936b4af..da0ec8a9c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.3.0
+version: 6.0.4.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 98cf23d06..86eda28b4 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.3.0
+version:        6.0.4.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 30e15b881faeff9cd4bd7972d8e6cd616bbefec9 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Wed, 11 Sep 2024 22:30:59 +0400
Subject: [PATCH 105/195] agent: don't prohibit deletion of notifications token
 if different is passed (fixes turning notifications off after importing
 database) (#1308)

* agent: don't prohibit deletion of notifications token if different is passed (fixes turning notifications off after importing database)

* ignore error

* notify
---
 src/Simplex/Messaging/Agent.hs | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index e8aa309df..1dc86d081 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1984,7 +1984,7 @@ deleteNtfToken' :: AgentClient -> DeviceToken -> AM ()
 deleteNtfToken' c deviceToken =
   withStore' c getSavedNtfToken >>= \case
     Just tkn@NtfToken {deviceToken = savedDeviceToken} -> do
-      when (deviceToken /= savedDeviceToken) . throwE $ CMD PROHIBITED "deleteNtfToken: different token"
+      when (deviceToken /= savedDeviceToken) $ logWarn "deleteNtfToken: different token"
       deleteToken_ c tkn
       deleteNtfSubs c NSCSmpDelete
     _ -> throwE $ CMD PROHIBITED "deleteNtfToken: no token"
@@ -2021,17 +2021,18 @@ toggleConnectionNtfs' c connId enable = do
           atomically $ sendNtfSubCommand ns (connId, cmd)
 
 deleteToken_ :: AgentClient -> NtfToken -> AM ()
-deleteToken_ c tkn@NtfToken {ntfTokenId, ntfTknStatus} = do
+deleteToken_ c@AgentClient {subQ} tkn@NtfToken {ntfTokenId, ntfTknStatus} = do
   ns <- asks ntfSupervisor
   forM_ ntfTokenId $ \tknId -> do
     let ntfTknAction = Just NTADelete
     withStore' c $ \db -> updateNtfToken db tkn ntfTknStatus ntfTknAction
     atomically $ nsUpdateToken ns tkn {ntfTknStatus, ntfTknAction}
-    agentNtfDeleteToken c tknId tkn `catchAgentError` \case
-      NTF _ AUTH -> pure ()
-      e -> throwE e
+    agentNtfDeleteToken c tknId tkn `catchAgentError` \e -> notify (ERR e) -- TODO cleanup task
   withStore' c $ \db -> removeNtfToken db tkn
   atomically $ nsRemoveNtfToken ns
+  where
+    notify :: forall e. AEntityI e => AEvent e -> AM ()
+    notify cmd = atomically $ writeTBQueue subQ ("", "", AEvt (sAEntity @e) cmd)
 
 withToken :: AgentClient -> NtfToken -> Maybe (NtfTknStatus, NtfTknAction) -> (NtfTknStatus, Maybe NtfTknAction) -> AM a -> AM NtfTknStatus
 withToken c tkn@NtfToken {deviceToken, ntfMode} from_ (toStatus, toAction_) f = do

From 896b2425a406f39b555b6f3d32e069bf29fba015 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 11 Sep 2024 19:32:40 +0100
Subject: [PATCH 106/195] xrcp: use SHA3-256 in hybrid key agreement (#1302)

This reverts commit 62133ceb24b2ccccd2a8e17a22beee1449b2bd27.
---
 protocol/xrcp.md                          | 4 ++--
 src/Simplex/Messaging/Crypto/SNTRUP761.hs | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/protocol/xrcp.md b/protocol/xrcp.md
index 9f7187e66..2ed2c8d62 100644
--- a/protocol/xrcp.md
+++ b/protocol/xrcp.md
@@ -250,7 +250,7 @@ In pseudo-code:
 ```
 // session 1
 hostHelloSecret(1) = dhSecret(1)
-sessionSecret(1) = sha256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
+sessionSecret(1) = sha3-256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
 dhSecret(1) = dh(hostHelloDhKey(1), controllerInvitationDhKey(1))
 kemCiphertext(1) = enc(kemSecret(1), kemEncKey(1))
 // kemEncKey is included in host HELLO, kemCiphertext - in controller HELLO
@@ -262,7 +262,7 @@ dhSecret(n') = dh(hostHelloDhKey(n - 1), controllerDhKey(n))
 
 // session n
 hostHelloSecret(n) = dhSecret(n)
-sessionSecret(n) = sha256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
+sessionSecret(n) = sha3-256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
 dhSecret(n) = dh(hostHelloDhKey(n), controllerDhKey(n))
 // controllerDhKey(n) is either from invitation or from multicast announcement
 kemCiphertext(n) = enc(kemSecret(n), kemEncKey(n))
diff --git a/src/Simplex/Messaging/Crypto/SNTRUP761.hs b/src/Simplex/Messaging/Crypto/SNTRUP761.hs
index 99b2771f6..6f903804e 100644
--- a/src/Simplex/Messaging/Crypto/SNTRUP761.hs
+++ b/src/Simplex/Messaging/Crypto/SNTRUP761.hs
@@ -4,7 +4,7 @@
 
 module Simplex.Messaging.Crypto.SNTRUP761 where
 
-import Crypto.Hash (Digest, SHA256, hash)
+import Crypto.Hash (Digest, SHA3_256, hash)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
@@ -28,4 +28,4 @@ kcbEncrypt (KEMHybridSecret k) = sbEncrypt_ k
 kemHybridSecret :: PublicKeyX25519 -> PrivateKeyX25519 -> KEMSharedKey -> KEMHybridSecret
 kemHybridSecret k pk (KEMSharedKey kem) =
   let DhSecretX25519 dh = C.dh' k pk
-   in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA256)
+   in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA3_256)

From e247f691cb2d1e2553eea832710d1c4e5280d00e Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Thu, 12 Sep 2024 14:02:51 +0400
Subject: [PATCH 107/195] agent: do not reuse notifier credentials when
 re-creating notification subscription; on deleting ntf sub delete directly on
 smp server skipping ntf server (#1311)

* agent: change notifier credentials when re-creating notification subscription

* skip ndel

* enable tests

* fix race

* Revert "fix race"

This reverts commit ed9b18e8a7f79b0deebac1f4addf598781f34b97.

* delete record

* rename

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
---
 src/Simplex/Messaging/Agent.hs                |  8 ++--
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |  2 +-
 .../Messaging/Agent/NtfSubSupervisor.hs       | 43 ++++++-------------
 src/Simplex/Messaging/Agent/Store/SQLite.hs   | 20 ++++++---
 src/Simplex/Messaging/Notifications/Types.hs  |  4 +-
 5 files changed, 33 insertions(+), 44 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 1dc86d081..1a3565f2f 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1018,7 +1018,7 @@ subscribeConnections' c connIds = do
       let oks = M.keysSet $ M.filter (either temporaryAgentError $ const True) rcvRs
       forM_ (M.restrictKeys cs oks) $ \case
         SomeConn _ conn -> do
-          let cmd = if enableNtfs $ toConnData conn then NSCCreate else NSCDelete
+          let cmd = if enableNtfs $ toConnData conn then NSCCreate else NSCSmpDelete
               ConnData {connId} = toConnData conn
           atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)
     resumeDelivery :: Map ConnId SomeConn -> AM ()
@@ -1720,7 +1720,7 @@ disableConn :: AgentClient -> ConnId -> AM' ()
 disableConn c connId = do
   atomically $ removeSubscription c connId
   ns <- asks ntfSupervisor
-  atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCDelete)
+  atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCDeleteSub)
 
 -- Unlike deleteConnectionsAsync, this function does not mark connections as deleted in case of deletion failure.
 deleteConnections' :: AgentClient -> [ConnId] -> AM (Map ConnId (Either AgentErrorType ()))
@@ -1902,7 +1902,7 @@ registerNtfToken' c suppliedDeviceToken suppliedNtfMode =
                 cron <- asks $ ntfCron . config
                 agentNtfEnableCron c tknId tkn cron
                 when (suppliedNtfMode == NMInstant) $ initializeNtfSubs c
-                when (suppliedNtfMode == NMPeriodic && savedNtfMode == NMInstant) $ deleteNtfSubs c NSCDelete
+                when (suppliedNtfMode == NMPeriodic && savedNtfMode == NMInstant) $ deleteNtfSubs c NSCSmpDelete
               -- possible improvement: get updated token status from the server, or maybe TCRON could return the current status
               pure ntfTknStatus
           | otherwise -> replaceToken tknId
@@ -2017,7 +2017,7 @@ toggleConnectionNtfs' c connId enable = do
       | otherwise = do
           withStore' c $ \db -> setConnectionNtfs db connId enable
           ns <- asks ntfSupervisor
-          let cmd = if enable then NSCCreate else NSCDelete
+          let cmd = if enable then NSCCreate else NSCSmpDelete
           atomically $ sendNtfSubCommand ns (connId, cmd)
 
 deleteToken_ :: AgentClient -> NtfToken -> AM ()
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index bc5e800c5..c10ba91ca 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -259,7 +259,7 @@ data NtfSupervisor = NtfSupervisor
     ntfSMPWorkers :: TMap SMPServer Worker
   }
 
-data NtfSupervisorCommand = NSCCreate | NSCDelete | NSCSmpDelete | NSCNtfWorker NtfServer | NSCNtfSMPWorker SMPServer
+data NtfSupervisorCommand = NSCCreate | NSCSmpDelete | NSCNtfWorker NtfServer | NSCNtfSMPWorker SMPServer | NSCDeleteSub
   deriving (Show)
 
 newNtfSubSupervisor :: Natural -> IO NtfSupervisor
diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
index 23a88ea70..fa6291a00 100644
--- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
+++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
@@ -73,22 +73,16 @@ processNtfSub c (connId, cmd) = do
       case a of
         Nothing -> do
           withTokenServer $ \ntfServer -> do
-            case clientNtfCreds of
-              Just ClientNtfCreds {notifierId} -> do
-                let newSub = newNtfSubscription userId connId smpServer (Just notifierId) ntfServer NASKey
-                withStore c $ \db -> createNtfSubscription db newSub $ NSANtf NSACreate
-                lift . void $ getNtfNTFWorker True c ntfServer
-              Nothing -> do
-                let newSub = newNtfSubscription userId connId smpServer Nothing ntfServer NASNew
-                withStore c $ \db -> createNtfSubscription db newSub $ NSASMP NSASmpKey
-                lift . void $ getNtfSMPWorker True c smpServer
-        (Just (sub@NtfSubscription {ntfSubStatus, ntfServer = subNtfServer, smpServer = smpServer', ntfQueueId}, action_)) -> do
+            let newSub = newNtfSubscription userId connId smpServer Nothing ntfServer NASNew
+            withStore c $ \db -> createNtfSubscription db newSub $ NSASMP NSASmpKey
+            lift . void $ getNtfSMPWorker True c smpServer
+        (Just (sub@NtfSubscription {ntfServer = subNtfServer, smpServer = smpServer', ntfQueueId}, action_)) -> do
           case (clientNtfCreds, ntfQueueId) of
             (Just ClientNtfCreds {notifierId}, Just ntfQueueId')
               | sameSrvAddr smpServer smpServer' && notifierId == ntfQueueId' -> create
-              | otherwise -> rotate
+              | otherwise -> resetSubscription
             (Nothing, Nothing) -> create
-            _ -> rotate
+            _ -> resetSubscription
           where
             create :: AM ()
             create = case action_ of
@@ -96,33 +90,17 @@ processNtfSub c (connId, cmd) = do
               Nothing -> resetSubscription
               Just (action, _)
                 -- subscription was marked for deletion / is being deleted
-                | isDeleteNtfSubAction action -> do
-                    if ntfSubStatus == NASNew || ntfSubStatus == NASOff || ntfSubStatus == NASDeleted
-                      then resetSubscription
-                      else withTokenServer $ \ntfServer -> do
-                        withStore' c $ \db -> supervisorUpdateNtfSub db sub {ntfServer} (NSANtf NSACreate)
-                        lift . void $ getNtfNTFWorker True c ntfServer
+                | isDeleteNtfSubAction action -> resetSubscription
+                -- continue work on subscription (e.g. supervisor was repeatedly tasked with creating a subscription)
                 | otherwise -> case action of
                     NSANtf _ -> lift . void $ getNtfNTFWorker True c subNtfServer
                     NSASMP _ -> lift . void $ getNtfSMPWorker True c smpServer
-            rotate :: AM ()
-            rotate = do
-              withStore' c $ \db -> supervisorUpdateNtfSub db sub (NSANtf NSARotate)
-              lift . void $ getNtfNTFWorker True c subNtfServer
             resetSubscription :: AM ()
             resetSubscription =
               withTokenServer $ \ntfServer -> do
-                let sub' = sub {ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
+                let sub' = sub {smpServer, ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
                 withStore' c $ \db -> supervisorUpdateNtfSub db sub' (NSASMP NSASmpKey)
                 lift . void $ getNtfSMPWorker True c smpServer
-    NSCDelete -> do
-      sub_ <- withStore' c $ \db -> do
-        supervisorUpdateNtfAction db connId (NSANtf NSADelete)
-        getNtfSubscription db connId
-      logInfo $ "processNtfSub, NSCDelete - sub_ = " <> tshow sub_
-      case sub_ of
-        (Just (NtfSubscription {ntfServer}, _)) -> lift . void $ getNtfNTFWorker True c ntfServer
-        _ -> pure () -- err "NSCDelete - no subscription"
     NSCSmpDelete -> do
       withStore' c (`getPrimaryRcvQueue` connId) >>= \case
         Right rq@RcvQueue {server = smpServer} -> do
@@ -132,6 +110,7 @@ processNtfSub c (connId, cmd) = do
         _ -> notifyInternalError c connId "NSCSmpDelete - no rcv queue"
     NSCNtfWorker ntfServer -> lift . void $ getNtfNTFWorker True c ntfServer
     NSCNtfSMPWorker smpServer -> lift . void $ getNtfSMPWorker True c smpServer
+    NSCDeleteSub -> withStore' c $ \db -> deleteNtfSubscription' db connId
 
 getNtfNTFWorker :: Bool -> AgentClient -> NtfServer -> AM' Worker
 getNtfNTFWorker hasWork c server = do
@@ -199,6 +178,7 @@ runNtfWorker c srv Worker {doWork} =
                     atomically $ incNtfServerStat c userId ntfServer ntfChecked
                   Nothing -> workerInternalError c connId "NSACheck - no subscription ID"
               _ -> workerInternalError c connId "NSACheck - no active token"
+          -- NSADelete and NSARotate are deprecated, but their processing is kept for legacy db records
           NSADelete ->
             deleteNtfSub $ do
               let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
@@ -211,6 +191,7 @@ runNtfWorker c srv Worker {doWork} =
               ns <- asks ntfSupervisor
               atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCCreate)
       where
+        -- deleteNtfSub is only used in NSADelete and NSARotate, so also deprecated
         deleteNtfSub continue = case ntfSubId of
           Just nSubId ->
             lift getNtfToken >>= \case
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index d3eae9354..f354ad530 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -158,6 +158,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     updateNtfSubscription,
     setNullNtfSubscriptionAction,
     deleteNtfSubscription,
+    deleteNtfSubscription',
     getNextNtfSubNTFAction,
     markNtfSubActionNtfFailed_, -- exported for tests
     getNextNtfSubSMPAction,
@@ -1491,7 +1492,7 @@ getNtfSubscription db connId =
       |]
       (Only connId)
   where
-    ntfSubscription ((userId, smpHost, smpPort, smpKeyHash, ntfHost, ntfPort, ntfKeyHash ) :. (ntfQueueId, ntfSubId, ntfSubStatus, ntfAction_, smpAction_, actionTs_)) =
+    ntfSubscription ((userId, smpHost, smpPort, smpKeyHash, ntfHost, ntfPort, ntfKeyHash) :. (ntfQueueId, ntfSubId, ntfSubStatus, ntfAction_, smpAction_, actionTs_)) =
       let smpServer = SMPServer smpHost smpPort smpKeyHash
           ntfServer = NtfServer ntfHost ntfPort ntfKeyHash
           action = case (ntfAction_, smpAction_, actionTs_) of
@@ -1521,16 +1522,19 @@ createNtfSubscription db ntfSubscription action = runExceptT $ do
     (ntfSubAction, ntfSubSMPAction) = ntfSubAndSMPAction action
 
 supervisorUpdateNtfSub :: DB.Connection -> NtfSubscription -> NtfSubAction -> IO ()
-supervisorUpdateNtfSub db NtfSubscription {connId, ntfQueueId, ntfServer = (NtfServer ntfHost ntfPort _), ntfSubId, ntfSubStatus} action = do
+supervisorUpdateNtfSub db NtfSubscription {connId, smpServer = (SMPServer smpHost smpPort _), ntfQueueId, ntfServer = (NtfServer ntfHost ntfPort _), ntfSubId, ntfSubStatus} action = do
   ts <- getCurrentTime
   DB.execute
     db
     [sql|
       UPDATE ntf_subscriptions
-      SET smp_ntf_id = ?, ntf_host = ?, ntf_port = ?, ntf_sub_id = ?, ntf_sub_status = ?, ntf_sub_action = ?, ntf_sub_smp_action = ?, ntf_sub_action_ts = ?, updated_by_supervisor = ?, updated_at = ?
+      SET smp_host = ?, smp_port = ?, smp_ntf_id = ?, ntf_host = ?, ntf_port = ?, ntf_sub_id = ?,
+          ntf_sub_status = ?, ntf_sub_action = ?, ntf_sub_smp_action = ?, ntf_sub_action_ts = ?, updated_by_supervisor = ?, updated_at = ?
       WHERE conn_id = ?
     |]
-    ((ntfQueueId, ntfHost, ntfPort, ntfSubId) :. (ntfSubStatus, ntfSubAction, ntfSubSMPAction, ts, True, ts, connId))
+    ( (smpHost, smpPort, ntfQueueId, ntfHost, ntfPort, ntfSubId)
+        :. (ntfSubStatus, ntfSubAction, ntfSubSMPAction, ts, True, ts, connId)
+    )
   where
     (ntfSubAction, ntfSubSMPAction) = ntfSubAndSMPAction action
 
@@ -1605,7 +1609,11 @@ deleteNtfSubscription db connId = do
             WHERE conn_id = ?
           |]
           (Nothing :: Maybe SMP.NotifierId, Nothing :: Maybe NtfSubscriptionId, NASDeleted, False, updatedAt, connId)
-      else DB.execute db "DELETE FROM ntf_subscriptions WHERE conn_id = ?" (Only connId)
+      else deleteNtfSubscription' db connId
+
+deleteNtfSubscription' :: DB.Connection -> ConnId -> IO ()
+deleteNtfSubscription' db connId = do
+  DB.execute db "DELETE FROM ntf_subscriptions WHERE conn_id = ?" (Only connId)
 
 getNextNtfSubNTFAction :: DB.Connection -> NtfServer -> IO (Either StoreError (Maybe (NtfSubscription, NtfSubNTFAction, NtfActionTs)))
 getNextNtfSubNTFAction db ntfServer@(NtfServer ntfHost ntfPort _) =
@@ -2004,7 +2012,7 @@ setConnDeleted db waitDelivery connId
       DB.execute db "UPDATE connections SET deleted = ? WHERE conn_id = ?" (True, connId)
 
 setConnUserId :: DB.Connection -> UserId -> ConnId -> UserId -> IO ()
-setConnUserId db oldUserId connId newUserId = 
+setConnUserId db oldUserId connId newUserId =
   DB.execute db "UPDATE connections SET user_id = ? WHERE conn_id = ? and user_id = ?" (newUserId, connId, oldUserId)
 
 setConnAgentVersion :: DB.Connection -> ConnId -> VersionSMPA -> IO ()
diff --git a/src/Simplex/Messaging/Notifications/Types.hs b/src/Simplex/Messaging/Notifications/Types.hs
index 8fcedab53..774f354bb 100644
--- a/src/Simplex/Messaging/Notifications/Types.hs
+++ b/src/Simplex/Messaging/Notifications/Types.hs
@@ -99,8 +99,8 @@ type NtfActionTs = UTCTime
 data NtfSubNTFAction
   = NSACreate
   | NSACheck
-  | NSADelete
-  | NSARotate
+  | NSADelete -- deprecated
+  | NSARotate -- deprecated
   deriving (Show)
 
 instance Encoding NtfSubNTFAction where

From ea67b34ba73ea419efc382a85ab49826a8d5cb59 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Fri, 13 Sep 2024 15:26:57 +0400
Subject: [PATCH 108/195] ntf: batch supervisor commands (#1313)

---
 src/Simplex/Messaging/Agent.hs                |  62 ++++---
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |   2 +-
 .../Messaging/Agent/NtfSubSupervisor.hs       | 171 ++++++++++++------
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |   5 +-
 4 files changed, 153 insertions(+), 87 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 1a3565f2f..7417b823a 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -778,7 +778,7 @@ newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv
   lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
   when enableNtfs $ do
     ns <- asks ntfSupervisor
-    atomically $ sendNtfSubCommand ns (connId, NSCCreate)
+    atomically $ sendNtfSubCommand ns (NSCCreate, [connId])
   let crData = ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData
   case cMode of
     SCMContact -> pure (connId, CRContactUri crData)
@@ -923,7 +923,7 @@ createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVers
   lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
   when enableNtfs $ do
     ns <- asks ntfSupervisor
-    atomically $ sendNtfSubCommand ns (connId, NSCCreate)
+    atomically $ sendNtfSubCommand ns (NSCCreate, [connId])
   pure qInfo
 
 -- | Approve confirmation (LET command) in Reader monad
@@ -1013,14 +1013,13 @@ subscribeConnections' c connIds = do
         order _ = 4
     sendNtfCreate :: NtfSupervisor -> Map ConnId (Either AgentErrorType ()) -> Map ConnId SomeConn -> AM' ()
     sendNtfCreate ns rcvRs cs = do
-      -- TODO this needs to be batched end to end.
-      -- Currently, the only change is to ignore failed subscriptions.
       let oks = M.keysSet $ M.filter (either temporaryAgentError $ const True) rcvRs
-      forM_ (M.restrictKeys cs oks) $ \case
-        SomeConn _ conn -> do
-          let cmd = if enableNtfs $ toConnData conn then NSCCreate else NSCSmpDelete
-              ConnData {connId} = toConnData conn
-          atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)
+          cs' = M.restrictKeys cs oks
+          (csCreate, csDelete) = M.partition (\(SomeConn _ conn) -> enableNtfs $ toConnData conn) cs'
+      sendNtfCmd NSCCreate csCreate
+      sendNtfCmd NSCSmpDelete csDelete
+      where
+        sendNtfCmd cmd cs' = forM_ (L.nonEmpty $ M.keys cs') $ \cids -> atomically $ writeTBQueue (ntfSubQ ns) (cmd, cids)
     resumeDelivery :: Map ConnId SomeConn -> AM ()
     resumeDelivery conns = do
       conns' <- M.restrictKeys conns . S.fromList <$> withStore' c getConnectionsForDelivery
@@ -1259,7 +1258,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
                     withStore' c $ \db -> deleteConnRcvQueue db rq'
                     when (enableNtfs cData) $ do
                       ns <- asks ntfSupervisor
-                      atomically $ sendNtfSubCommand ns (connId, NSCCreate)
+                      atomically $ sendNtfSubCommand ns (NSCCreate, [connId])
                     let conn' = DuplexConnection cData (rq'' :| rqs') sqs
                     notify $ SWITCH QDRcv SPCompleted $ connectionStats conn'
               _ -> internalErr "ICQDelete: cannot delete the only queue in connection"
@@ -1716,12 +1715,6 @@ connRcvQueues = \case
   SndConnection _ _ -> []
   NewConnection _ -> []
 
-disableConn :: AgentClient -> ConnId -> AM' ()
-disableConn c connId = do
-  atomically $ removeSubscription c connId
-  ns <- asks ntfSupervisor
-  atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCDeleteSub)
-
 -- Unlike deleteConnectionsAsync, this function does not mark connections as deleted in case of deletion failure.
 deleteConnections' :: AgentClient -> [ConnId] -> AM (Map ConnId (Either AgentErrorType ()))
 deleteConnections' = deleteConnections_ getConns False False
@@ -1748,7 +1741,7 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do
       (delRs, rcvQs) = M.mapEither rcvQueues cs
       rqs = concat $ M.elems rcvQs
       connIds' = M.keys rcvQs
-  lift . forM_ connIds' $ disableConn c
+  lift $ forM_ (L.nonEmpty connIds') unsubConnIds
   -- ! delRs is not used to notify about the result in any of the calling functions,
   -- ! it is only used to check results count in deleteConnections_;
   -- ! if it was used to notify about the result, it might be necessary to differentiate
@@ -1762,6 +1755,12 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do
     rcvQueues (SomeConn _ conn) = case connRcvQueues conn of
       [] -> Left $ Right ()
       rqs -> Right rqs
+    unsubConnIds :: NonEmpty ConnId -> AM' ()
+    unsubConnIds connIds' = do
+      forM_ connIds' $ \connId ->
+        atomically $ removeSubscription c connId
+      ns <- asks ntfSupervisor
+      atomically $ writeTBQueue (ntfSubQ ns) (NSCDeleteSub, connIds')
     notify = atomically . writeTBQueue (subQ c)
 
 deleteConnQueues :: AgentClient -> Bool -> Bool -> [RcvQueue] -> AM' (Map ConnId (Either AgentErrorType ()))
@@ -2018,7 +2017,7 @@ toggleConnectionNtfs' c connId enable = do
           withStore' c $ \db -> setConnectionNtfs db connId enable
           ns <- asks ntfSupervisor
           let cmd = if enable then NSCCreate else NSCSmpDelete
-          atomically $ sendNtfSubCommand ns (connId, cmd)
+          atomically $ sendNtfSubCommand ns (cmd, [connId])
 
 deleteToken_ :: AgentClient -> NtfToken -> AM ()
 deleteToken_ c@AgentClient {subQ} tkn@NtfToken {ntfTokenId, ntfTknStatus} = do
@@ -2066,13 +2065,26 @@ deleteNtfSubs c deleteCmd = do
 sendNtfConnCommands :: AgentClient -> NtfSupervisorCommand -> AM ()
 sendNtfConnCommands c cmd = do
   ns <- asks ntfSupervisor
-  connIds <- liftIO $ getSubscriptions c
-  forM_ connIds $ \connId -> do
-    withStore' c (`getConnData` connId) >>= \case
-      Just (ConnData {enableNtfs}, _) ->
-        when enableNtfs . atomically $ writeTBQueue (ntfSubQ ns) (connId, cmd)
-      _ ->
-        atomically $ writeTBQueue (subQ c) ("", connId, AEvt SAEConn $ ERR $ INTERNAL "no connection data")
+  connIds <- liftIO $ S.toList <$> getSubscriptions c
+  rs <- lift $ withStoreBatch' c (\db -> map (getConnData db) connIds)
+  let (connIds', errs) = enabledNtfConns (zip connIds rs)
+  forM_ (L.nonEmpty connIds') $ \connIds'' ->
+    atomically $ writeTBQueue (ntfSubQ ns) (cmd, connIds'')
+  -- TODO [batch ntf] notify ERRS
+  forM_ errs $ \(connId, e) ->
+    atomically $ writeTBQueue (subQ c) ("", connId, AEvt SAEConn $ ERR e)
+  where
+    enabledNtfConns :: [(ConnId, Either AgentErrorType (Maybe (ConnData, ConnectionMode)))] -> ([ConnId], [(ConnId, AgentErrorType)])
+    enabledNtfConns = foldr addEnabledConn ([], [])
+      where
+        addEnabledConn ::
+          (ConnId, Either AgentErrorType (Maybe (ConnData, ConnectionMode))) ->
+          ([ConnId], [(ConnId, AgentErrorType)]) ->
+          ([ConnId], [(ConnId, AgentErrorType)])
+        addEnabledConn cData_ (cIds, errs) = case cData_ of
+          (_, Right (Just (ConnData {connId, enableNtfs}, _))) -> if enableNtfs then (connId : cIds, errs) else (cIds, errs)
+          (connId, Right Nothing) -> (cIds, (connId, INTERNAL "no connection data") : errs)
+          (connId, Left e) -> (cIds, (connId, e) : errs)
 
 setNtfServers :: AgentClient -> [NtfServer] -> IO ()
 setNtfServers c = atomically . writeTVar (ntfServers c)
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index c10ba91ca..0f179c70c 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -254,7 +254,7 @@ createAgentStore dbFilePath dbKey keepKey = createSQLiteStore dbFilePath dbKey k
 
 data NtfSupervisor = NtfSupervisor
   { ntfTkn :: TVar (Maybe NtfToken),
-    ntfSubQ :: TBQueue (ConnId, NtfSupervisorCommand),
+    ntfSubQ :: TBQueue (NtfSupervisorCommand, NonEmpty ConnId),
     ntfWorkers :: TMap NtfServer Worker,
     ntfSMPWorkers :: TMap SMPServer Worker
   }
diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
index fa6291a00..c45a3184a 100644
--- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
+++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
@@ -2,9 +2,9 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Messaging.Agent.NtfSubSupervisor
@@ -23,21 +23,27 @@ import Control.Monad
 import Control.Monad.Reader
 import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
+import Data.Either (rights)
+import Data.Foldable (foldr')
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
+import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Time (UTCTime, addUTCTime, getCurrentTime)
 import Data.Time.Clock (diffUTCTime)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
-import Simplex.Messaging.Agent.Protocol (AEvent (..), AEvt (..), AgentErrorType (..), BrokerErrorType (..), ConnId, NotificationsMode (..), SAEntity (..))
+import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
+import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol (NtfSubStatus (..), NtfTknStatus (..), SMPQueueNtf (..))
 import Simplex.Messaging.Notifications.Types
-import Simplex.Messaging.Protocol (NtfServer, SMPServer, sameSrvAddr)
+import Simplex.Messaging.Protocol (NtfServer, sameSrvAddr)
 import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow, unlessM)
 import System.Random (randomR)
 import UnliftIO
@@ -48,69 +54,110 @@ runNtfSupervisor :: AgentClient -> AM' ()
 runNtfSupervisor c = do
   ns <- asks ntfSupervisor
   forever $ do
-    cmd@(connId, _) <- atomically . readTBQueue $ ntfSubQ ns
-    handleErr connId . agentOperationBracket c AONtfNetwork waitUntilActive $
-      runExceptT (processNtfSub c cmd) >>= \case
-        Left e -> notifyErr connId e
+    cmd <- atomically . readTBQueue $ ntfSubQ ns
+    handleErr . agentOperationBracket c AONtfNetwork waitUntilActive $
+      runExceptT (processNtfCmd c cmd) >>= \case
+        Left e -> notifyErr e
         Right _ -> return ()
   where
-    handleErr :: ConnId -> AM' () -> AM' ()
-    handleErr connId = E.handle $ \(e :: E.SomeException) -> do
+    handleErr :: AM' () -> AM' ()
+    handleErr = E.handle $ \(e :: E.SomeException) -> do
       logError $ "runNtfSupervisor error " <> tshow e
-      notifyErr connId e
-    notifyErr connId e = notifyInternalError c connId $ "runNtfSupervisor error " <> show e
+      notifyErr e
+    notifyErr e = notifyInternalError' c $ "runNtfSupervisor error " <> show e
 
-processNtfSub :: AgentClient -> (ConnId, NtfSupervisorCommand) -> AM ()
-processNtfSub c (connId, cmd) = do
-  logInfo $ "processNtfSub - connId = " <> tshow connId <> " - cmd = " <> tshow cmd
+-- TODO [batch ntf] notify ERRS
+processNtfCmd :: AgentClient -> (NtfSupervisorCommand, NonEmpty ConnId) -> AM ()
+processNtfCmd c (cmd, connIds) = do
+  logInfo $ "processNtfCmd - cmd = " <> tshow cmd
   case cmd of
     NSCCreate -> do
-      (a, RcvQueue {userId, server = smpServer, clientNtfCreds}) <- withStore c $ \db -> runExceptT $ do
-        a <- liftIO $ getNtfSubscription db connId
-        q <- ExceptT $ getPrimaryRcvQueue db connId
-        pure (a, q)
-      logInfo $ "processNtfSub, NSCCreate - a = " <> tshow a
-      case a of
-        Nothing -> do
+      rqSubActions <- lift $ rights <$> withStoreBatch c (\db -> map (getQueueSub db) (L.toList connIds))
+      logInfo $ "processNtfCmd, NSCCreate - length rqSubs = " <> tshow (length rqSubActions)
+      let (ns, rs, css, cns) = partitionQueueSubActions rqSubActions
+      createNewSubs ns
+      resetSubs rs
+      lift $ do
+        mapM_ (getNtfSMPWorker True c) (S.fromList css)
+        mapM_ (getNtfNTFWorker True c) (S.fromList cns)
+      where
+        getQueueSub ::
+          DB.Connection ->
+          ConnId ->
+          IO (Either AgentErrorType (RcvQueue, Maybe NtfSupervisorSub))
+        getQueueSub db connId = fmap (first storeError) $ runExceptT $ do
+          rq <- ExceptT $ getPrimaryRcvQueue db connId
+          sub <- liftIO $ getNtfSubscription db connId
+          pure (rq, sub)
+        createNewSubs :: [RcvQueue] -> AM ()
+        createNewSubs rqs = do
           withTokenServer $ \ntfServer -> do
-            let newSub = newNtfSubscription userId connId smpServer Nothing ntfServer NASNew
-            withStore c $ \db -> createNtfSubscription db newSub $ NSASMP NSASmpKey
-            lift . void $ getNtfSMPWorker True c smpServer
-        (Just (sub@NtfSubscription {ntfServer = subNtfServer, smpServer = smpServer', ntfQueueId}, action_)) -> do
-          case (clientNtfCreds, ntfQueueId) of
-            (Just ClientNtfCreds {notifierId}, Just ntfQueueId')
-              | sameSrvAddr smpServer smpServer' && notifierId == ntfQueueId' -> create
-              | otherwise -> resetSubscription
-            (Nothing, Nothing) -> create
-            _ -> resetSubscription
+            let newSubs = map (rqToNewSub ntfServer) rqs
+            void $ lift $ withStoreBatch c (\db -> map (storeNewSub db) newSubs)
+            kickSMPWorkers rqs
           where
-            create :: AM ()
-            create = case action_ of
-              -- action was set to NULL after worker internal error
-              Nothing -> resetSubscription
-              Just (action, _)
-                -- subscription was marked for deletion / is being deleted
-                | isDeleteNtfSubAction action -> resetSubscription
-                -- continue work on subscription (e.g. supervisor was repeatedly tasked with creating a subscription)
-                | otherwise -> case action of
-                    NSANtf _ -> lift . void $ getNtfNTFWorker True c subNtfServer
-                    NSASMP _ -> lift . void $ getNtfSMPWorker True c smpServer
-            resetSubscription :: AM ()
-            resetSubscription =
-              withTokenServer $ \ntfServer -> do
-                let sub' = sub {smpServer, ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
-                withStore' c $ \db -> supervisorUpdateNtfSub db sub' (NSASMP NSASmpKey)
-                lift . void $ getNtfSMPWorker True c smpServer
+            rqToNewSub :: NtfServer -> RcvQueue -> NtfSubscription
+            rqToNewSub ntfServer RcvQueue {userId, connId, server} = newNtfSubscription userId connId server Nothing ntfServer NASNew
+            storeNewSub :: DB.Connection -> NtfSubscription -> IO (Either AgentErrorType ())
+            storeNewSub db sub = first storeError <$> createNtfSubscription db sub (NSASMP NSASmpKey)
+        resetSubs :: [(RcvQueue, NtfSubscription)] -> AM ()
+        resetSubs rqSubs = do
+          withTokenServer $ \ntfServer -> do
+            let subsToReset = map (toResetSub ntfServer) rqSubs
+            lift $ void $ withStoreBatch' c (\db -> map (\sub -> supervisorUpdateNtfSub db sub (NSASMP NSASmpKey)) subsToReset)
+            let rqs = map fst rqSubs
+            kickSMPWorkers rqs
+          where
+            toResetSub :: NtfServer -> (RcvQueue, NtfSubscription) -> NtfSubscription
+            toResetSub ntfServer (rq, sub) =
+              let RcvQueue {server = smpServer} = rq
+               in sub {smpServer, ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
+        partitionQueueSubActions ::
+          [(RcvQueue, Maybe NtfSupervisorSub)] ->
+          ( [RcvQueue], -- new subs
+            [(RcvQueue, NtfSubscription)], -- reset subs
+            [SMPServer], -- continue work (SMP)
+            [NtfServer] -- continue work (Ntf)
+          )
+        partitionQueueSubActions = foldr' decideSubWork ([], [], [], [])
+          where
+            -- sub = Nothing, needs to be created
+            decideSubWork (rq, Nothing) (ns, rs, css, cns) = (rq : ns, rs, css, cns)
+            decideSubWork (rq, Just (sub, subAction_)) (ns, rs, css, cns) =
+              case (clientNtfCreds rq, ntfQueueId sub) of
+                -- notifier ID created on SMP server (on ntf server subscription can be registered or not yet),
+                -- need to clarify action
+                (Just ClientNtfCreds {notifierId}, Just ntfQueueId')
+                  | sameSrvAddr (qServer rq) subSMPServer && notifierId == ntfQueueId' -> contOrReset
+                  | otherwise -> reset
+                (Nothing, Nothing) -> contOrReset
+                _ -> reset
+              where
+                NtfSubscription {ntfServer = subNtfServer, smpServer = subSMPServer} = sub
+                contOrReset = case subAction_ of
+                  -- action was set to NULL after worker internal error
+                  Nothing -> reset
+                  Just (action, _)
+                    -- subscription was marked for deletion / is being deleted
+                    | isDeleteNtfSubAction action -> reset
+                    -- continue work on subscription (e.g. supervisor was repeatedly tasked with creating a subscription)
+                    | otherwise -> case action of
+                        NSASMP _ -> (ns, rs, qServer rq : css, cns)
+                        NSANtf _ -> (ns, rs, css, subNtfServer : cns)
+                reset = (ns, (rq, sub) : rs, css, cns)
     NSCSmpDelete -> do
-      withStore' c (`getPrimaryRcvQueue` connId) >>= \case
-        Right rq@RcvQueue {server = smpServer} -> do
-          logInfo $ "processNtfSub, NSCSmpDelete - rq = " <> tshow rq
-          withStore' c $ \db -> supervisorUpdateNtfAction db connId (NSASMP NSASmpDelete)
-          lift . void $ getNtfSMPWorker True c smpServer
-        _ -> notifyInternalError c connId "NSCSmpDelete - no rcv queue"
+      rqs <- lift $ rights <$> withStoreBatch c (\db -> map (fmap (first storeError) . getPrimaryRcvQueue db) (L.toList connIds))
+      logInfo $ "processNtfCmd, NSCSmpDelete - length rqs = " <> tshow (length rqs)
+      lift $ void $ withStoreBatch' c (\db -> map (\rq -> supervisorUpdateNtfAction db (qConnId rq) (NSASMP NSASmpDelete)) rqs)
+      kickSMPWorkers rqs
     NSCNtfWorker ntfServer -> lift . void $ getNtfNTFWorker True c ntfServer
     NSCNtfSMPWorker smpServer -> lift . void $ getNtfSMPWorker True c smpServer
-    NSCDeleteSub -> withStore' c $ \db -> deleteNtfSubscription' db connId
+    NSCDeleteSub -> void $ lift $ withStoreBatch' c $ \db -> map (deleteNtfSubscription' db) (L.toList connIds)
+  where
+    kickSMPWorkers :: [RcvQueue] -> AM ()
+    kickSMPWorkers rqs = do
+      let smpServers = S.fromList $ map qServer rqs
+      lift $ mapM_ (getNtfSMPWorker True c) smpServers
 
 getNtfNTFWorker :: Bool -> AgentClient -> NtfServer -> AM' Worker
 getNtfNTFWorker hasWork c server = do
@@ -173,7 +220,7 @@ runNtfWorker c srv Worker {doWork} =
                         withStore' c $ \db ->
                           updateNtfSubscription db sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew} (NSASMP NSASmpKey) ts
                         ns <- asks ntfSupervisor
-                        atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
+                        atomically $ writeTBQueue (ntfSubQ ns) (NSCNtfSMPWorker smpServer, [connId])
                       status -> updateSubNextCheck ts status
                     atomically $ incNtfServerStat c userId ntfServer ntfChecked
                   Nothing -> workerInternalError c connId "NSACheck - no subscription ID"
@@ -184,12 +231,12 @@ runNtfWorker c srv Worker {doWork} =
               let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
               withStore' c $ \db -> updateNtfSubscription db sub' (NSASMP NSASmpDelete) ts
               ns <- asks ntfSupervisor
-              atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
+              atomically $ writeTBQueue (ntfSubQ ns) (NSCNtfSMPWorker smpServer, [connId]) -- TODO [batch ntf] loop
           NSARotate ->
             deleteNtfSub $ do
               withStore' c $ \db -> deleteNtfSubscription db connId
               ns <- asks ntfSupervisor
-              atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCCreate)
+              atomically $ writeTBQueue (ntfSubQ ns) (NSCCreate, [connId]) -- TODO [batch ntf] loop
       where
         -- deleteNtfSub is only used in NSADelete and NSARotate, so also deprecated
         deleteNtfSub continue = case ntfSubId of
@@ -248,7 +295,7 @@ runNtfSMPWorker c srv Worker {doWork} = do
                   setRcvQueueNtfCreds db connId $ Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
                   updateNtfSubscription db sub {ntfQueueId = Just notifierId, ntfSubStatus = NASKey} (NSANtf NSACreate) ts
                 ns <- asks ntfSupervisor
-                atomically $ sendNtfSubCommand ns (connId, NSCNtfWorker ntfServer)
+                atomically $ sendNtfSubCommand ns (NSCNtfWorker ntfServer, [connId])
               _ -> workerInternalError c connId "NSASmpKey - no active token"
           NSASmpDelete -> do
             -- TODO should we remove it after successful removal from the server?
@@ -292,6 +339,10 @@ notifyInternalError :: MonadIO m => AgentClient -> ConnId -> String -> m ()
 notifyInternalError AgentClient {subQ} connId internalErrStr = atomically $ writeTBQueue subQ ("", connId, AEvt SAEConn $ ERR $ INTERNAL internalErrStr)
 {-# INLINE notifyInternalError #-}
 
+notifyInternalError' :: MonadIO m => AgentClient -> String -> m ()
+notifyInternalError' AgentClient {subQ} internalErrStr = atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL internalErrStr)
+{-# INLINE notifyInternalError' #-}
+
 getNtfToken :: AM' (Maybe NtfToken)
 getNtfToken = do
   tkn <- asks $ ntfTkn . ntfSupervisor
@@ -303,7 +354,7 @@ nsUpdateToken ns tkn = writeTVar (ntfTkn ns) $ Just tkn
 nsRemoveNtfToken :: NtfSupervisor -> STM ()
 nsRemoveNtfToken ns = writeTVar (ntfTkn ns) Nothing
 
-sendNtfSubCommand :: NtfSupervisor -> (ConnId, NtfSupervisorCommand) -> STM ()
+sendNtfSubCommand :: NtfSupervisor -> (NtfSupervisorCommand, NonEmpty ConnId) -> STM ()
 sendNtfSubCommand ns cmd = do
   tkn <- readTVar (ntfTkn ns)
   when (instantNotifications tkn) $ writeTBQueue (ntfSubQ ns) cmd
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index f354ad530..55f1ab85e 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -151,6 +151,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     updateNtfToken,
     removeNtfToken,
     -- Notification subscription persistence
+    NtfSupervisorSub,
     getNtfSubscription,
     createNtfSubscription,
     supervisorUpdateNtfSub,
@@ -1476,7 +1477,9 @@ removeNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer
     |]
     (provider, token, host, port)
 
-getNtfSubscription :: DB.Connection -> ConnId -> IO (Maybe (NtfSubscription, Maybe (NtfSubAction, NtfActionTs)))
+type NtfSupervisorSub = (NtfSubscription, Maybe (NtfSubAction, NtfActionTs))
+
+getNtfSubscription :: DB.Connection -> ConnId -> IO (Maybe NtfSupervisorSub)
 getNtfSubscription db connId =
   maybeFirstRow ntfSubscription $
     DB.query

From bec4e5e038629bcafc990da3a1e73b72b790c310 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 14 Sep 2024 17:34:29 +0100
Subject: [PATCH 109/195] smp: reduce max message sizes (#1318)

---
 src/Simplex/Messaging/Agent/Protocol.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 13e5011a2..bfa6e46b0 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -277,14 +277,14 @@ supportedSMPAgentVRange = mkVersionRange minSupportedSMPAgentVersion currentSMPA
 e2eEncConnInfoLength :: VersionSMPA -> PQSupport -> Int
 e2eEncConnInfoLength v = \case
   -- reduced by 3726 (roughly the increase of message ratchet header size + key and ciphertext in reply link)
-  PQSupportOn | v >= pqdrSMPAgentVersion -> 11122
-  _ -> 14848
+  PQSupportOn | v >= pqdrSMPAgentVersion -> 11106
+  _ -> 14832
 
 e2eEncAgentMsgLength :: VersionSMPA -> PQSupport -> Int
 e2eEncAgentMsgLength v = \case
   -- reduced by 2222 (the increase of message ratchet header size)
-  PQSupportOn | v >= pqdrSMPAgentVersion -> 13634
-  _ -> 15856
+  PQSupportOn | v >= pqdrSMPAgentVersion -> 13618
+  _ -> 15840
 
 -- | SMP agent event
 type ATransmission = (ACorrId, AEntityId, AEvt)

From fa772af6c63fab8f04d9d32d8e8397d75d7d0391 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 15 Sep 2024 21:36:31 +0100
Subject: [PATCH 110/195] agent: support socks proxy without isolate-by-auth,
 with and without credentials (#1320)

* agent: support socks proxy without isolate-by-auth, with and without credentials

* add unit tests

* make xftp use correct SOCKS credentials

* rename

* support ipv6 in brackets, test parsing

* constant

* textToHostMode

* space
---
 simplexmq.cabal                               |   1 +
 src/Simplex/FileTransfer/Client.hs            |   5 +-
 src/Simplex/Messaging/Client.hs               |  33 ++++-
 .../Messaging/Notifications/Server/Main.hs    |   5 +-
 src/Simplex/Messaging/Server/Main.hs          |  10 +-
 src/Simplex/Messaging/Transport/Client.hs     |  79 ++++++++---
 .../Messaging/Transport/HTTP2/Client.hs       |  14 +-
 tests/CoreTests/SOCKSSettings.hs              | 127 ++++++++++++++++++
 tests/Test.hs                                 |   2 +
 9 files changed, 229 insertions(+), 47 deletions(-)
 create mode 100644 tests/CoreTests/SOCKSSettings.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 86eda28b4..c910e2ea3 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -610,6 +610,7 @@ test-suite simplexmq-test
       CoreTests.CryptoTests
       CoreTests.EncodingTests
       CoreTests.RetryIntervalTests
+      CoreTests.SOCKSSettings
       CoreTests.TRcvQueuesTests
       CoreTests.UtilTests
       CoreTests.VersionRangeTests
diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs
index 33e927265..6f3b467e8 100644
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -38,6 +38,7 @@ import Simplex.Messaging.Client
     defaultNetworkConfig,
     proxyUsername,
     transportClientConfig,
+    clientSocksCredentials,
     unexpectedResponse,
   )
 import qualified Simplex.Messaging.Crypto as C
@@ -100,7 +101,7 @@ defaultXFTPClientConfig =
 
 getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
 getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} disconnected = runExceptT $ do
-  let username = proxyUsername transportSession
+  let socksCreds = clientSocksCredentials xftpNetworkConfig $ proxyUsername transportSession
       ProtocolServer _ host port keyHash = srv
   useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
   let tcConfig = (transportClientConfig xftpNetworkConfig useHost) {alpn = clientALPN}
@@ -108,7 +109,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
   clientVar <- newTVarIO Nothing
   let usePort = if null port then "443" else port
       clientDisconnected = readTVarIO clientVar >>= mapM_ disconnected
-  http2Client <- liftError' xftpClientError $ getVerifiedHTTP2Client (Just username) useHost usePort (Just keyHash) Nothing http2Config clientDisconnected
+  http2Client <- liftError' xftpClientError $ getVerifiedHTTP2Client socksCreds useHost usePort (Just keyHash) Nothing http2Config clientDisconnected
   let HTTP2Client {sessionId, sessionALPN} = http2Client
       v = VersionXFTP 1
       thServerVRange = versionToRange v
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index c0ce663ec..c255d7f69 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -80,10 +80,12 @@ module Simplex.Messaging.Client
     defaultSMPClientConfig,
     defaultNetworkConfig,
     transportClientConfig,
+    clientSocksCredentials,
     chooseTransportHost,
     proxyUsername,
     temporaryClientError,
     smpProxyError,
+    textToHostMode,
     ServerTransmissionBatch,
     ServerTransmission (..),
     ClientCommand,
@@ -122,10 +124,13 @@ import Data.List (find)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (catMaybes, fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
 import Network.Socket (ServiceName)
+import Network.Socks5 (SocksCredentials (..))
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
@@ -136,7 +141,7 @@ import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Transport.Client (SocksProxy, TransportClientConfig (..), TransportHost (..), defaultTcpConnectTimeout, runTransportClient)
+import Simplex.Messaging.Transport.Client (SocksAuth (..), SocksProxyWithAuth (..), TransportClientConfig (..), TransportHost (..), defaultTcpConnectTimeout, runTransportClient)
 import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, diffToMicroseconds, ifM, liftEitherWith, raceAny_, threadDelay', tshow, whenM)
@@ -236,6 +241,12 @@ data HostMode
     HMPublic
   deriving (Eq, Show)
 
+textToHostMode :: Text -> Either String HostMode
+textToHostMode = \case
+  "public" -> Right HMPublic
+  "onion" -> Right HMOnionViaSocks
+  s -> Left $ T.unpack $ "Invalid host_mode: " <> s
+
 data SocksMode
   = -- | always use SOCKS proxy when enabled
     SMAlways
@@ -257,7 +268,7 @@ instance StrEncoding SocksMode where
 -- | network configuration for the client
 data NetworkConfig = NetworkConfig
   { -- | use SOCKS5 proxy
-    socksProxy :: Maybe SocksProxy,
+    socksProxy :: Maybe SocksProxyWithAuth,
     -- | when to use SOCKS proxy
     socksMode :: SocksMode,
     -- | determines critera which host is chosen from the list
@@ -355,12 +366,22 @@ transportClientConfig :: NetworkConfig -> TransportHost -> TransportClientConfig
 transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} host =
   TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, alpn = Nothing}
   where
-    useSocksProxy SMAlways = socksProxy
+    socksProxy' = (\(SocksProxyWithAuth _ proxy) -> proxy) <$> socksProxy
+    useSocksProxy SMAlways = socksProxy'
     useSocksProxy SMOnion = case host of
-      THOnionHost _ -> socksProxy
+      THOnionHost _ -> socksProxy'
       _ -> Nothing
 {-# INLINE transportClientConfig #-}
 
+clientSocksCredentials :: NetworkConfig -> ByteString -> Maybe SocksCredentials
+clientSocksCredentials NetworkConfig {socksProxy} sessionUsername = case socksProxy of
+  Just (SocksProxyWithAuth auth _) -> case auth of
+    SocksAuthUsername {username, password} -> Just $ SocksCredentials username password
+    SocksAuthNull -> Nothing
+    SocksIsolateByAuth -> Just $ SocksCredentials sessionUsername ""
+  Nothing -> Nothing
+{-# INLINE clientSocksCredentials #-}
+
 -- | protocol client configuration.
 data ProtocolClientConfig v = ProtocolClientConfig
   { -- | size of TBQueue to use for server commands and responses
@@ -489,9 +510,9 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
     runClient (port', ATransport t) useHost c = do
       cVar <- newEmptyTMVarIO
       let tcConfig = (transportClientConfig networkConfig useHost) {alpn = clientALPN}
-          username = proxyUsername transportSession
+          socksCreds = clientSocksCredentials networkConfig $ proxyUsername transportSession
       tId <-
-        runTransportClient tcConfig (Just username) useHost port' (Just $ keyHash srv) (client t c cVar)
+        runTransportClient tcConfig socksCreds useHost port' (Just $ keyHash srv) (client t c cVar)
           `forkFinally` \_ -> void (atomically . tryPutTMVar cVar $ Left PCENetworkError)
       c_ <- tcpConnectTimeout `timeout` atomically (takeTMVar cVar)
       case c_ of
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index 5002d2d45..cd7135f5a 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -16,7 +16,7 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
-import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
+import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Server (runNtfServer)
@@ -26,7 +26,6 @@ import Simplex.Messaging.Notifications.Transport (supportedNTFHandshakes, suppor
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Server.Main (textToHostMode)
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
@@ -139,7 +138,7 @@ ntfServerCLI cfgPath logPath =
                             defaultNetworkConfig
                               { socksProxy = either error id <$!> strDecodeIni "SUBSCRIBER" "socks_proxy" ini,
                                 socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini,
-                                hostMode = either (const HMPublic) textToHostMode $ lookupValue "SUBSCRIBER" "host_mode" ini,
+                                hostMode = either (const HMPublic) (either error id . textToHostMode) $ lookupValue "SUBSCRIBER" "host_mode" ini,
                                 requiredHostMode = fromMaybe False $ iniOnOff "SUBSCRIBER" "required_host_mode" ini,
                                 smpPingInterval = 60_000_000 -- 1 minutes
                               }
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 8a1ea0a60..94490bcb8 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -29,7 +29,7 @@ import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
 import Simplex.Messaging.Agent.Protocol (connReqUriP')
-import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
+import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
@@ -307,7 +307,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
                             defaultNetworkConfig
                               { socksProxy = either error id <$!> strDecodeIni "PROXY" "socks_proxy" ini,
                                 socksMode = maybe SMOnion (either error id) $! strDecodeIni "PROXY" "socks_mode" ini,
-                                hostMode = either (const HMPublic) textToHostMode $ lookupValue "PROXY" "host_mode" ini,
+                                hostMode = either (const HMPublic) (either error id . textToHostMode) $ lookupValue "PROXY" "host_mode" ini,
                                 requiredHostMode = fromMaybe False $ iniOnOff "PROXY" "required_host_mode" ini
                               }
                         },
@@ -341,12 +341,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
           where
             isOnion = \case THOnionHost _ -> True; _ -> False
 
-textToHostMode :: Text -> HostMode
-textToHostMode = \case
-  "public" -> HMPublic
-  "onion" -> HMOnionViaSocks
-  s -> error . T.unpack $ "Invalid host_mode: " <> s
-
 data EmbeddedWebParams = EmbeddedWebParams
   { webStaticPath :: FilePath,
     webHttpPort :: Maybe Int,
diff --git a/src/Simplex/Messaging/Transport/Client.hs b/src/Simplex/Messaging/Transport/Client.hs
index da2c6c253..a23c68dd7 100644
--- a/src/Simplex/Messaging/Transport/Client.hs
+++ b/src/Simplex/Messaging/Transport/Client.hs
@@ -13,9 +13,13 @@ module Simplex.Messaging.Transport.Client
     defaultSMPPort,
     defaultTcpConnectTimeout,
     defaultTransportClientConfig,
+    defaultSocksProxyWithAuth,
     defaultSocksProxy,
+    defaultSocksHost,
     TransportClientConfig (..),
-    SocksProxy,
+    SocksProxy (..),
+    SocksProxyWithAuth (..),
+    SocksAuth (..),
     TransportHost (..),
     TransportHosts (..),
     TransportHosts_ (..),
@@ -23,7 +27,7 @@ module Simplex.Messaging.Transport.Client
   )
 where
 
-import Control.Applicative (optional)
+import Control.Applicative (optional, (<|>))
 import Control.Logger.Simple (logError)
 import Control.Monad (when)
 import Data.Aeson (FromJSON (..), ToJSON (..))
@@ -79,7 +83,7 @@ instance StrEncoding TransportHost where
   strP =
     A.choice
       [ THIPv4 <$> ((,,,) <$> ipNum <*> ipNum <*> ipNum <*> A.decimal),
-        maybe (Left "bad IPv6") (Right . THIPv6 . fromIPv6w) . readMaybe . B.unpack <$?> A.takeWhile1 (\c -> isHexDigit c || c == ':'),
+        maybe (Left "bad IPv6") (Right . THIPv6 . fromIPv6w) . readMaybe . B.unpack <$?> ipv6StrP,
         THOnionHost <$> ((<>) <$> A.takeWhile (\c -> isAsciiLower c || isDigit c) <*> A.string ".onion"),
         THDomainName . B.unpack <$> (notOnion <$?> A.takeWhile1 (A.notInClass ":#,;/ \n\r\t"))
       ]
@@ -87,6 +91,9 @@ instance StrEncoding TransportHost where
       ipNum = validIP <$?> (A.decimal <* A.char '.')
       validIP :: Int -> Either String Word8
       validIP n = if 0 <= n && n <= 255 then Right $ fromIntegral n else Left "invalid IP address"
+      ipv6StrP =
+        A.char '[' *> A.takeWhile1 (/= ']') <* A.char ']'
+          <|> A.takeWhile1 (\c -> isHexDigit c || c == ':')
       notOnion s = if ".onion" `B.isSuffixOf` s then Left "invalid onion host" else Right s
 
 instance ToJSON TransportHost where
@@ -134,16 +141,16 @@ clientTransportConfig TransportClientConfig {logTLSErrors} =
   TransportConfig {logTLSErrors, transportTimeout = Nothing}
 
 -- | Connect to passed TCP host:port and pass handle to the client.
-runTransportClient :: Transport c => TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a
+runTransportClient :: Transport c => TransportClientConfig -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a
 runTransportClient = runTLSTransportClient supportedParameters Nothing
 
-runTLSTransportClient :: Transport c => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a
-runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials, alpn} proxyUsername host port keyHash client = do
+runTLSTransportClient :: Transport c => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a
+runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials, alpn} socksCreds host port keyHash client = do
   serverCert <- newEmptyTMVarIO
   let hostName = B.unpack $ strEncode host
       clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash clientCredentials alpn serverCert
       connectTCP = case socksProxy of
-        Just proxy -> connectSocksClient proxy proxyUsername (hostAddr host)
+        Just proxy -> connectSocksClient proxy socksCreds (hostAddr host)
         _ -> connectTCPClient hostName
   c <- do
     sock <- connectTCP port
@@ -191,40 +198,70 @@ connectTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
 defaultSMPPort :: PortNumber
 defaultSMPPort = 5223
 
-connectSocksClient :: SocksProxy -> Maybe ByteString -> SocksHostAddress -> ServiceName -> IO Socket
-connectSocksClient (SocksProxy addr) proxyUsername hostAddr _port = do
+connectSocksClient :: SocksProxy -> Maybe SocksCredentials -> SocksHostAddress -> ServiceName -> IO Socket
+connectSocksClient (SocksProxy addr) socksCreds hostAddr _port = do
   let port = if null _port then defaultSMPPort else fromMaybe defaultSMPPort $ readMaybe _port
-  fst <$> case proxyUsername of
-    Just username -> socksConnectAuth (defaultSocksConf addr) (SocksAddress hostAddr port) (SocksCredentials username "")
+  fst <$> case socksCreds of
+    Just creds -> socksConnectAuth (defaultSocksConf addr) (SocksAddress hostAddr port) creds
     _ -> socksConnect (defaultSocksConf addr) (SocksAddress hostAddr port)
 
-defaultSocksHost :: HostAddress
-defaultSocksHost = tupleToHostAddress (127, 0, 0, 1)
+defaultSocksHost :: (Word8, Word8, Word8, Word8)
+defaultSocksHost = (127, 0, 0, 1)
+
+defaultSocksProxyWithAuth :: SocksProxyWithAuth
+defaultSocksProxyWithAuth = SocksProxyWithAuth SocksIsolateByAuth defaultSocksProxy
 
 defaultSocksProxy :: SocksProxy
-defaultSocksProxy = SocksProxy $ SockAddrInet 9050 defaultSocksHost
+defaultSocksProxy = SocksProxy $ SockAddrInet 9050 $ tupleToHostAddress defaultSocksHost
 
 newtype SocksProxy = SocksProxy SockAddr
   deriving (Eq)
 
+data SocksProxyWithAuth = SocksProxyWithAuth SocksAuth SocksProxy
+  deriving (Eq, Show)
+
+data SocksAuth
+  = SocksAuthUsername {username :: ByteString, password :: ByteString}
+  | SocksAuthNull
+  | SocksIsolateByAuth -- this is default
+  deriving (Eq, Show)
+
 instance Show SocksProxy where show (SocksProxy addr) = show addr
 
 instance StrEncoding SocksProxy where
   strEncode = B.pack . show
   strP = do
-    host <- maybe defaultSocksHost tupleToHostAddress <$> optional ipv4P
+    host <- fromMaybe (THIPv4 defaultSocksHost) <$> optional strP
     port <- fromMaybe 9050 <$> optional (A.char ':' *> (fromInteger <$> A.decimal))
-    pure . SocksProxy $ SockAddrInet port host
+    SocksProxy <$> socksAddr port host
     where
-      ipv4P = (,,,) <$> ipNum <*> ipNum <*> ipNum <*> A.decimal
-      ipNum = A.decimal <* A.char '.'
+      socksAddr port = \case
+        THIPv4 addr -> pure $ SockAddrInet port $ tupleToHostAddress addr
+        THIPv6 addr -> pure $ SockAddrInet6 port 0 addr 0
+        _ -> fail "SOCKS5 host should be IPv4 or IPv6 address"          
 
-instance ToJSON SocksProxy where
+instance StrEncoding SocksProxyWithAuth where
+  strEncode (SocksProxyWithAuth auth proxy) = strEncode auth <> strEncode proxy
+  strP = SocksProxyWithAuth <$> strP <*> strP
+
+instance ToJSON SocksProxyWithAuth where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
-instance FromJSON SocksProxy where
-  parseJSON = strParseJSON "SocksProxy"
+instance FromJSON SocksProxyWithAuth where
+  parseJSON = strParseJSON "SocksProxyWithAuth"
+
+instance StrEncoding SocksAuth where
+  strEncode = \case
+    SocksAuthUsername {username, password} -> username <> ":" <> password <> "@"
+    SocksAuthNull -> "@"
+    SocksIsolateByAuth -> ""
+  strP = usernameP <|> (SocksAuthNull <$ A.char '@') <|> pure SocksIsolateByAuth
+    where
+      usernameP = do
+        username <- A.takeTill (== ':') <* A.char ':'
+        password <- A.takeTill (== '@') <* A.char '@'
+        pure SocksAuthUsername {username, password}
 
 mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe (X.CertificateChain, T.PrivKey) -> Maybe [ALPN] -> TMVar X.CertificateChain -> T.ClientParams
 mkTLSClientParams supported caStore_ host port cafp_ clientCreds_ alpn_ serverCerts =
diff --git a/src/Simplex/Messaging/Transport/HTTP2/Client.hs b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
index d8d3d495d..53f229f06 100644
--- a/src/Simplex/Messaging/Transport/HTTP2/Client.hs
+++ b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
@@ -11,7 +11,6 @@ import Control.Concurrent.Async
 import Control.Exception (IOException, try)
 import qualified Control.Exception as E
 import Control.Monad
-import Data.ByteString.Char8 (ByteString)
 import Data.Functor (($>))
 import Data.Time (UTCTime, getCurrentTime)
 import qualified Data.X509 as X
@@ -20,6 +19,7 @@ import Network.HPACK (BufferSize)
 import Network.HTTP2.Client (ClientConfig (..), Request, Response)
 import qualified Network.HTTP2.Client as H
 import Network.Socket (HostName, ServiceName)
+import Network.Socks5 (SocksCredentials)
 import qualified Network.TLS as T
 import Numeric.Natural (Natural)
 import qualified Simplex.Messaging.Crypto as C
@@ -91,10 +91,10 @@ data HTTP2ClientError = HCResponseTimeout | HCNetworkError | HCIOError IOExcepti
 getHTTP2Client :: HostName -> ServiceName -> Maybe XS.CertificateStore -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
 getHTTP2Client host port = getVerifiedHTTP2Client Nothing (THDomainName host) port Nothing
 
-getVerifiedHTTP2Client :: Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> Maybe XS.CertificateStore -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
-getVerifiedHTTP2Client proxyUsername host port keyHash caStore config disconnected = getVerifiedHTTP2ClientWith config host port disconnected setup
+getVerifiedHTTP2Client :: Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> Maybe XS.CertificateStore -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
+getVerifiedHTTP2Client socksCreds host port keyHash caStore config disconnected = getVerifiedHTTP2ClientWith config host port disconnected setup
   where
-    setup = runHTTP2Client (suportedTLSParams config) caStore (transportConfig config) (bufferSize config) proxyUsername host port keyHash
+    setup = runHTTP2Client (suportedTLSParams config) caStore (transportConfig config) (bufferSize config) socksCreds host port keyHash
 
 attachHTTP2Client :: HTTP2ClientConfig -> TransportHost -> ServiceName -> IO () -> Int -> TLS -> IO (Either HTTP2ClientError HTTP2Client)
 attachHTTP2Client config host port disconnected bufferSize tls = getVerifiedHTTP2ClientWith config host port disconnected setup
@@ -178,11 +178,11 @@ sendRequestDirect HTTP2Client {client_ = HClient {config, disconnected}, sendReq
 http2RequestTimeout :: HTTP2ClientConfig -> Maybe Int -> Int
 http2RequestTimeout HTTP2ClientConfig {connTimeout} = maybe connTimeout (connTimeout +)
 
-runHTTP2Client :: forall a. T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> BufferSize -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (TLS -> H.Client a) -> IO a
-runHTTP2Client tlsParams caStore tcConfig bufferSize proxyUsername host port keyHash = runHTTP2ClientWith bufferSize host setup
+runHTTP2Client :: forall a. T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> BufferSize -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (TLS -> H.Client a) -> IO a
+runHTTP2Client tlsParams caStore tcConfig bufferSize socksCreds host port keyHash = runHTTP2ClientWith bufferSize host setup
   where
     setup :: (TLS -> IO a) -> IO a
-    setup = runTLSTransportClient tlsParams caStore tcConfig proxyUsername host port keyHash
+    setup = runTLSTransportClient tlsParams caStore tcConfig socksCreds host port keyHash
 
 runHTTP2ClientWith :: forall a. BufferSize -> TransportHost -> ((TLS -> IO a) -> IO a) -> (TLS -> H.Client a) -> IO a
 runHTTP2ClientWith bufferSize host setup client = setup $ \tls -> withHTTP2 bufferSize (run tls) (pure ()) tls
diff --git a/tests/CoreTests/SOCKSSettings.hs b/tests/CoreTests/SOCKSSettings.hs
new file mode 100644
index 000000000..438be0949
--- /dev/null
+++ b/tests/CoreTests/SOCKSSettings.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+
+module CoreTests.SOCKSSettings where
+
+import Network.Socket (SockAddr (..), tupleToHostAddress)
+import Simplex.Messaging.Client
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (ErrorType)
+import Simplex.Messaging.Transport.Client
+import Test.Hspec
+
+socksSettingsTests :: Spec
+socksSettingsTests = do
+  describe "hostMode and requiredHostMode settings" testHostMode
+  describe "socksMode setting, independent of hostMode setting" testSocksMode
+  describe "socks proxy address encoding" testSocksProxyEncoding
+
+testPublicHost :: TransportHost
+testPublicHost = "smp.example.com"
+
+testOnionHost :: TransportHost
+testOnionHost = "abcdefghijklmnopqrstuvwxyz0123456789abcdefghijklmnopqrst.onion"
+
+testHostMode :: Spec
+testHostMode = do
+  describe "requiredHostMode = False (default)" $ do
+    it "without socks proxy, should choose onion host only with HMOnion" $ do
+      chooseTransportHost @ErrorType defaultNetworkConfig [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost
+      chooseHost HMOnionViaSocks Nothing [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost
+      chooseHost HMOnion Nothing [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMPublic Nothing [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost
+    it "with socks proxy, should choose onion host with HMOnionViaSocks (default) and HMOnion" $ do
+      chooseTransportHost @ErrorType defaultNetworkConfig {socksProxy = Just defaultSocksProxyWithAuth} [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMOnionViaSocks (Just defaultSocksProxyWithAuth) [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMOnion (Just defaultSocksProxyWithAuth) [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMPublic (Just defaultSocksProxyWithAuth) [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost
+    it "should choose any available host, if preferred not available" $ do
+      chooseHost HMOnionViaSocks Nothing [testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMOnion Nothing [testPublicHost] `shouldBe` Right testPublicHost
+      chooseHost HMPublic Nothing [testOnionHost] `shouldBe` Right testOnionHost
+      chooseHost HMOnionViaSocks (Just defaultSocksProxyWithAuth) [testPublicHost] `shouldBe` Right testPublicHost
+      chooseHost HMOnion (Just defaultSocksProxyWithAuth) [testPublicHost] `shouldBe` Right testPublicHost
+      chooseHost HMPublic (Just defaultSocksProxyWithAuth) [testOnionHost] `shouldBe` Right testOnionHost
+  describe "requiredHostMode = True" $ do
+    it "should fail, if preferred host not available" $ do
+      testOnionHost `incompatible` (HMOnionViaSocks, Nothing)
+      testPublicHost `incompatible` (HMOnion, Nothing)
+      testOnionHost `incompatible` (HMPublic, Nothing)
+      testPublicHost `incompatible` (HMOnionViaSocks, Just defaultSocksProxyWithAuth)
+      testPublicHost `incompatible` (HMOnion, Just defaultSocksProxyWithAuth)
+      testOnionHost `incompatible` (HMPublic, Just defaultSocksProxyWithAuth)
+    it "should choose preferred host, if available" $ do
+      testPublicHost `compatible` (HMOnionViaSocks, Nothing)
+      testOnionHost `compatible` (HMOnion, Nothing)
+      testPublicHost `compatible` (HMPublic, Nothing)
+      testOnionHost `compatible` (HMOnionViaSocks, Just defaultSocksProxyWithAuth)
+      testOnionHost `compatible` (HMOnion, Just defaultSocksProxyWithAuth)
+      testPublicHost `compatible` (HMPublic, Just defaultSocksProxyWithAuth)
+  where
+    chooseHost = chooseHostCfg defaultNetworkConfig
+    host `incompatible` (hostMode, socksProxy) =
+      chooseHostCfg defaultNetworkConfig {requiredHostMode = True} hostMode socksProxy [host] `shouldBe` Left PCEIncompatibleHost
+    host `compatible` (hostMode, socksProxy) = do
+      chooseHostCfg defaultNetworkConfig {requiredHostMode = True} hostMode socksProxy [host] `shouldBe` Right host
+      chooseHostCfg defaultNetworkConfig {requiredHostMode = True} hostMode socksProxy [host, testPublicHost, testOnionHost] `shouldBe` Right host
+    chooseHostCfg cfg hostMode socksProxy =
+      chooseTransportHost @ErrorType cfg {hostMode, socksProxy}
+
+testSocksMode :: Spec
+testSocksMode = do
+  it "should not use SOCKS proxy if not specified" $ do
+    transportSocksCfg defaultNetworkConfig testPublicHost `shouldBe` Nothing
+    transportSocksCfg defaultNetworkConfig testOnionHost `shouldBe` Nothing
+    transportSocks Nothing SMAlways testPublicHost `shouldBe` Nothing
+    transportSocks Nothing SMAlways testOnionHost `shouldBe` Nothing
+    transportSocks Nothing SMOnion testPublicHost `shouldBe` Nothing
+    transportSocks Nothing SMOnion testOnionHost `shouldBe` Nothing
+  it "should always use SOCKS proxy if specified and (socksMode = SMAlways or (socksMode = SMOnion and onion host))" $ do
+    transportSocksCfg defaultNetworkConfig {socksProxy = Just defaultSocksProxyWithAuth} testPublicHost `shouldBe` Just defaultSocksProxy
+    transportSocksCfg defaultNetworkConfig {socksProxy = Just defaultSocksProxyWithAuth} testOnionHost `shouldBe` Just defaultSocksProxy
+    transportSocks (Just defaultSocksProxyWithAuth) SMAlways testPublicHost `shouldBe` Just defaultSocksProxy
+    transportSocks (Just defaultSocksProxyWithAuth) SMAlways testOnionHost `shouldBe` Just defaultSocksProxy
+    transportSocks (Just defaultSocksProxyWithAuth) SMOnion testPublicHost `shouldBe` Nothing
+    transportSocks (Just defaultSocksProxyWithAuth) SMOnion testOnionHost `shouldBe` Just defaultSocksProxy
+  where
+    transportSocks proxy socksMode = transportSocksCfg defaultNetworkConfig {socksProxy = proxy, socksMode}
+    transportSocksCfg cfg host =
+      let TransportClientConfig {socksProxy} = transportClientConfig cfg host
+       in socksProxy
+
+testSocksProxyEncoding :: Spec
+testSocksProxyEncoding = do
+  it "should decode SOCKS proxy with isolate-by-auth mode" $ do
+    let authIsolate proxy = Right $ SocksProxyWithAuth SocksIsolateByAuth proxy
+    strDecode "" `shouldBe` authIsolate defaultSocksProxy
+    strDecode ":9050" `shouldBe` authIsolate defaultSocksProxy
+    strDecode ":8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet 8080 $ tupleToHostAddress defaultSocksHost)
+    strDecode "127.0.0.1" `shouldBe` authIsolate defaultSocksProxy
+    strDecode "1.1.1.1" `shouldBe` authIsolate (SocksProxy $ SockAddrInet 9050 $ tupleToHostAddress (1, 1, 1, 1))
+    strDecode "::1" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 9050 0 (0, 0, 0, 1) 0)
+    strDecode "[fd12:3456:789a:1::1]" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 9050 0 (0xfd123456, 0x789a0001, 0, 1) 0)
+    strDecode "127.0.0.1:9050" `shouldBe` authIsolate defaultSocksProxy
+    strDecode "127.0.0.1:8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet 8080 $ tupleToHostAddress defaultSocksHost)
+    strDecode "[::1]:9050" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 9050 0 (0, 0, 0, 1) 0)
+    strDecode "[::1]:8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 8080 0 (0, 0, 0, 1) 0)
+    strDecode "[fd12:3456:789a:1::1]:8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)
+  it "should decode SOCKS proxy without credentials" $ do
+    let authNull proxy = Right $ SocksProxyWithAuth SocksAuthNull proxy
+    strDecode "@" `shouldBe` authNull defaultSocksProxy
+    strDecode "@:9050" `shouldBe` authNull defaultSocksProxy
+    strDecode "@127.0.0.1" `shouldBe` authNull defaultSocksProxy
+    strDecode "@1.1.1.1" `shouldBe` authNull (SocksProxy $ SockAddrInet 9050 $ tupleToHostAddress (1, 1, 1, 1))
+    strDecode "@127.0.0.1:9050" `shouldBe` authNull defaultSocksProxy
+    strDecode "@[fd12:3456:789a:1::1]:8080" `shouldBe` authNull (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)
+  it "should decode SOCKS proxy with credentials" $ do
+    let authUser proxy = Right $ SocksProxyWithAuth SocksAuthUsername {username = "user", password = "pass"} proxy
+    strDecode "user:pass@" `shouldBe` authUser defaultSocksProxy
+    strDecode "user:pass@:9050" `shouldBe` authUser defaultSocksProxy
+    strDecode "user:pass@127.0.0.1" `shouldBe` authUser defaultSocksProxy
+    strDecode "user:pass@127.0.0.1:9050" `shouldBe` authUser defaultSocksProxy
+    strDecode "user:pass@fd12:3456:789a:1::1" `shouldBe` authUser (SocksProxy $ SockAddrInet6 9050 0 (0xfd123456, 0x789a0001, 0, 1) 0)
+    strDecode "user:pass@[fd12:3456:789a:1::1]:8080" `shouldBe` authUser (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)
diff --git a/tests/Test.hs b/tests/Test.hs
index 98d902163..ac95f8c06 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -12,6 +12,7 @@ import CoreTests.CryptoFileTests
 import CoreTests.CryptoTests
 import CoreTests.EncodingTests
 import CoreTests.RetryIntervalTests
+import CoreTests.SOCKSSettings
 import CoreTests.TRcvQueuesTests
 import CoreTests.UtilTests
 import CoreTests.VersionRangeTests
@@ -52,6 +53,7 @@ main = do
           describe "Encryption tests" cryptoTests
           describe "Encrypted files tests" cryptoFileTests
           describe "Retry interval tests" retryIntervalTests
+          describe "SOCKS settings tests" socksSettingsTests
           describe "TRcvQueues tests" tRcvQueuesTests
           describe "Util tests" utilTests
         describe "SMP server via TLS" $ serverTests (transport @TLS)

From 398dbeedea190df84df87b445a758904786ff49c Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 15 Sep 2024 21:37:09 +0100
Subject: [PATCH 111/195] servers: allow multiple server ports for SMP and Ntf
 servers (#1319)

* servers: allow multiple server ports for SMP and Ntf servers

* fix
---
 src/Simplex/Messaging/Notifications/Server/Main.hs |  8 +++++---
 src/Simplex/Messaging/Server/CLI.hs                | 14 +++++++++++---
 src/Simplex/Messaging/Server/Main.hs               |  6 ++++--
 3 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index 5002d2d45..f401ce225 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -86,11 +86,13 @@ ntfServerCLI cfgPath logPath =
             <> ("enable: " <> onOff enableStoreLog <> "\n\n")
             <> "log_stats: off\n\n\
                \[TRANSPORT]\n\
-               \# host is only used to print server address on start\n"
+               \# Host is only used to print server address on start.\n\
+               \# You can specify multiple server ports.\n"
             <> ("host: " <> T.pack host <> "\n")
             <> ("port: " <> T.pack defaultServerPort <> "\n")
-            <> "log_tls_errors: off\n"
-            <> "websockets: off\n\n\
+            <> "log_tls_errors: off\n\n\
+               \# Use `websockets: 443` to run websockets server in addition to plain TLS.\n\
+               \websockets: off\n\n\
                \[SUBSCRIBER]\n\
                \# Network configuration for notification server client.\n\
                \# `host_mode` can be 'public' (default) or 'onion'.\n\
diff --git a/src/Simplex/Messaging/Server/CLI.hs b/src/Simplex/Messaging/Server/CLI.hs
index 956b30816..0ae228496 100644
--- a/src/Simplex/Messaging/Server/CLI.hs
+++ b/src/Simplex/Messaging/Server/CLI.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Simplex.Messaging.Server.CLI where
@@ -16,6 +17,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (fromRight)
 import Data.Ini (Ini, lookupValue)
+import Data.List ((\\))
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -275,9 +277,15 @@ checkSavedFingerprint cfgPath x509cfg = do
 
 iniTransports :: Ini -> [(String, ATransport)]
 iniTransports ini =
-  let port = T.unpack $ strictIni "TRANSPORT" "port" ini
-      enableWebsockets = (== "on") $ strictIni "TRANSPORT" "websockets" ini
-   in (port, transport @TLS) : [("80", transport @WS) | enableWebsockets]
+  let smpPorts = ports $ strictIni "TRANSPORT" "port" ini
+      ws = strictIni "TRANSPORT" "websockets" ini
+      wsPorts
+        | ws == "off" = []
+        | ws == "on" = ["80"]
+        | otherwise = ports ws \\ smpPorts
+   in map (,transport @TLS) smpPorts <> map (,transport @WS) wsPorts
+  where
+    ports = map T.unpack . T.splitOn ","
 
 printServerConfig :: [(ServiceName, ATransport)] -> Maybe FilePath -> IO ()
 printServerConfig transports logFile = do
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 8a1ea0a60..b9e5e861c 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -168,10 +168,12 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
                    \# control_port_admin_password:\n\
                    \# control_port_user_password:\n\n\
                    \[TRANSPORT]\n\
-                   \# host is only used to print server address on start\n"
+                   \# Host is only used to print server address on start.\n\
+                   \# You can specify multiple server ports.\n"
                 <> ("host: " <> T.pack host <> "\n")
                 <> ("port: " <> T.pack defaultServerPort <> "\n")
-                <> "log_tls_errors: off\n\
+                <> "log_tls_errors: off\n\n\
+                   \# Use `websockets: 443` to run websockets server in addition to plain TLS.\n\
                    \websockets: off\n\
                    \# control_port: 5224\n\n\
                    \[PROXY]\n\

From 309ef3766cc6b69e0c3aa0c140faab25383b732a Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 16 Sep 2024 07:28:50 +0100
Subject: [PATCH 112/195] 6.1.0.0

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index da0ec8a9c..e73b0748c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.4.0
+version: 6.1.0.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index c910e2ea3..6ec1b387a 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.4.0
+version:        6.1.0.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From d5a65656f5446b11cfbb03c954db3cdf818cc2bc Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 16 Sep 2024 13:15:30 +0100
Subject: [PATCH 113/195] test: socks proxy parameter encoding

---
 tests/CoreTests/SOCKSSettings.hs | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/tests/CoreTests/SOCKSSettings.hs b/tests/CoreTests/SOCKSSettings.hs
index 438be0949..385208fd4 100644
--- a/tests/CoreTests/SOCKSSettings.hs
+++ b/tests/CoreTests/SOCKSSettings.hs
@@ -109,6 +109,9 @@ testSocksProxyEncoding = do
     strDecode "[::1]:9050" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 9050 0 (0, 0, 0, 1) 0)
     strDecode "[::1]:8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 8080 0 (0, 0, 0, 1) 0)
     strDecode "[fd12:3456:789a:1::1]:8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)
+    strEncode (SocksProxyWithAuth SocksIsolateByAuth defaultSocksProxy) `shouldBe` "127.0.0.1:9050"
+    strEncode (SocksProxyWithAuth SocksIsolateByAuth (SocksProxy $ SockAddrInet6 9050 0 (0, 0, 0, 1) 0)) `shouldBe` "[::1]:9050"
+    strEncode (SocksProxyWithAuth SocksIsolateByAuth (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)) `shouldBe` "[fd12:3456:789a:1::1]:8080"
   it "should decode SOCKS proxy without credentials" $ do
     let authNull proxy = Right $ SocksProxyWithAuth SocksAuthNull proxy
     strDecode "@" `shouldBe` authNull defaultSocksProxy
@@ -117,11 +120,18 @@ testSocksProxyEncoding = do
     strDecode "@1.1.1.1" `shouldBe` authNull (SocksProxy $ SockAddrInet 9050 $ tupleToHostAddress (1, 1, 1, 1))
     strDecode "@127.0.0.1:9050" `shouldBe` authNull defaultSocksProxy
     strDecode "@[fd12:3456:789a:1::1]:8080" `shouldBe` authNull (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)
+    strEncode (SocksProxyWithAuth SocksAuthNull defaultSocksProxy) `shouldBe` "@127.0.0.1:9050"
+    strEncode (SocksProxyWithAuth SocksAuthNull (SocksProxy $ SockAddrInet6 9050 0 (0, 0, 0, 1) 0)) `shouldBe` "@[::1]:9050"
+    strEncode (SocksProxyWithAuth SocksAuthNull (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)) `shouldBe` "@[fd12:3456:789a:1::1]:8080"
   it "should decode SOCKS proxy with credentials" $ do
-    let authUser proxy = Right $ SocksProxyWithAuth SocksAuthUsername {username = "user", password = "pass"} proxy
+    let auth = SocksAuthUsername {username = "user", password = "pass"}
+        authUser proxy = Right $ SocksProxyWithAuth auth proxy
     strDecode "user:pass@" `shouldBe` authUser defaultSocksProxy
     strDecode "user:pass@:9050" `shouldBe` authUser defaultSocksProxy
     strDecode "user:pass@127.0.0.1" `shouldBe` authUser defaultSocksProxy
     strDecode "user:pass@127.0.0.1:9050" `shouldBe` authUser defaultSocksProxy
     strDecode "user:pass@fd12:3456:789a:1::1" `shouldBe` authUser (SocksProxy $ SockAddrInet6 9050 0 (0xfd123456, 0x789a0001, 0, 1) 0)
     strDecode "user:pass@[fd12:3456:789a:1::1]:8080" `shouldBe` authUser (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)
+    strEncode (SocksProxyWithAuth auth defaultSocksProxy) `shouldBe` "user:pass@127.0.0.1:9050"
+    strEncode (SocksProxyWithAuth auth (SocksProxy $ SockAddrInet6 9050 0 (0, 0, 0, 1) 0)) `shouldBe` "user:pass@[::1]:9050"
+    strEncode (SocksProxyWithAuth auth (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0)) `shouldBe` "user:pass@[fd12:3456:789a:1::1]:8080"

From bef11e4cbe0a3776f0910375f2adb60399043835 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Fri, 20 Sep 2024 20:08:42 +0400
Subject: [PATCH 114/195] agent: ntf errs (#1316)

* agent: ntf errs

* refactor

* errs

* refactor

* simplify

* inline

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
---
 src/Simplex/Messaging/Agent.hs                |  6 +--
 .../Messaging/Agent/NtfSubSupervisor.hs       | 37 +++++++++++++++----
 src/Simplex/Messaging/Agent/Protocol.hs       |  3 ++
 3 files changed, 34 insertions(+), 12 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 7417b823a..61f9d5da1 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -2067,12 +2067,10 @@ sendNtfConnCommands c cmd = do
   ns <- asks ntfSupervisor
   connIds <- liftIO $ S.toList <$> getSubscriptions c
   rs <- lift $ withStoreBatch' c (\db -> map (getConnData db) connIds)
-  let (connIds', errs) = enabledNtfConns (zip connIds rs)
+  let (connIds', cErrs) = enabledNtfConns (zip connIds rs)
   forM_ (L.nonEmpty connIds') $ \connIds'' ->
     atomically $ writeTBQueue (ntfSubQ ns) (cmd, connIds'')
-  -- TODO [batch ntf] notify ERRS
-  forM_ errs $ \(connId, e) ->
-    atomically $ writeTBQueue (subQ c) ("", connId, AEvt SAEConn $ ERR e)
+  unless (null cErrs) $ atomically $ writeTBQueue (subQ c) ("", "", AEvt SAENone $ ERRS cErrs)
   where
     enabledNtfConns :: [(ConnId, Either AgentErrorType (Maybe (ConnData, ConnectionMode)))] -> ([ConnId], [(ConnId, AgentErrorType)])
     enabledNtfConns = foldr addEnabledConn ([], [])
diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
index c45a3184a..ad1acae5a 100644
--- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
+++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Messaging.Agent.NtfSubSupervisor
@@ -23,7 +24,7 @@ import Control.Monad
 import Control.Monad.Reader
 import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
-import Data.Either (rights)
+import Data.Either (partitionEithers)
 import Data.Foldable (foldr')
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
@@ -66,13 +67,18 @@ runNtfSupervisor c = do
       notifyErr e
     notifyErr e = notifyInternalError' c $ "runNtfSupervisor error " <> show e
 
--- TODO [batch ntf] notify ERRS
+partitionErrs :: (a -> ConnId) -> [a] -> [Either AgentErrorType b] -> ([(ConnId, AgentErrorType)], [b])
+partitionErrs f xs = partitionEithers . zipWith (\x -> first (f x,)) xs
+{-# INLINE partitionErrs #-}
+
 processNtfCmd :: AgentClient -> (NtfSupervisorCommand, NonEmpty ConnId) -> AM ()
 processNtfCmd c (cmd, connIds) = do
   logInfo $ "processNtfCmd - cmd = " <> tshow cmd
+  let connIds' = L.toList connIds
   case cmd of
     NSCCreate -> do
-      rqSubActions <- lift $ rights <$> withStoreBatch c (\db -> map (getQueueSub db) (L.toList connIds))
+      (cErrs, rqSubActions) <- lift $ partitionErrs id connIds' <$> (withStoreBatch c $ \db -> map (getQueueSub db) connIds')
+      notifyErrs c cErrs
       logInfo $ "processNtfCmd, NSCCreate - length rqSubs = " <> tshow (length rqSubActions)
       let (ns, rs, css, cns) = partitionQueueSubActions rqSubActions
       createNewSubs ns
@@ -93,7 +99,8 @@ processNtfCmd c (cmd, connIds) = do
         createNewSubs rqs = do
           withTokenServer $ \ntfServer -> do
             let newSubs = map (rqToNewSub ntfServer) rqs
-            void $ lift $ withStoreBatch c (\db -> map (storeNewSub db) newSubs)
+            (cErrs, _) <- lift $ partitionErrs ntfSubConnId newSubs <$> (withStoreBatch c $ \db -> map (storeNewSub db) newSubs)
+            notifyErrs c cErrs
             kickSMPWorkers rqs
           where
             rqToNewSub :: NtfServer -> RcvQueue -> NtfSubscription
@@ -104,7 +111,8 @@ processNtfCmd c (cmd, connIds) = do
         resetSubs rqSubs = do
           withTokenServer $ \ntfServer -> do
             let subsToReset = map (toResetSub ntfServer) rqSubs
-            lift $ void $ withStoreBatch' c (\db -> map (\sub -> supervisorUpdateNtfSub db sub (NSASMP NSASmpKey)) subsToReset)
+            (cErrs, _) <- lift $ partitionErrs ntfSubConnId subsToReset <$> (withStoreBatch' c $ \db -> map (storeResetSub db) subsToReset)
+            notifyErrs c cErrs
             let rqs = map fst rqSubs
             kickSMPWorkers rqs
           where
@@ -112,6 +120,9 @@ processNtfCmd c (cmd, connIds) = do
             toResetSub ntfServer (rq, sub) =
               let RcvQueue {server = smpServer} = rq
                in sub {smpServer, ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
+            storeResetSub :: DB.Connection -> NtfSubscription -> IO ()
+            storeResetSub db sub = supervisorUpdateNtfSub db sub (NSASMP NSASmpKey)
+        ntfSubConnId NtfSubscription {connId} = connId
         partitionQueueSubActions ::
           [(RcvQueue, Maybe NtfSupervisorSub)] ->
           ( [RcvQueue], -- new subs
@@ -146,13 +157,19 @@ processNtfCmd c (cmd, connIds) = do
                         NSANtf _ -> (ns, rs, css, subNtfServer : cns)
                 reset = (ns, (rq, sub) : rs, css, cns)
     NSCSmpDelete -> do
-      rqs <- lift $ rights <$> withStoreBatch c (\db -> map (fmap (first storeError) . getPrimaryRcvQueue db) (L.toList connIds))
+      (cErrs, rqs) <- lift $ partitionErrs id connIds' <$> (withStoreBatch c $ \db -> map (getQueue db) connIds')
       logInfo $ "processNtfCmd, NSCSmpDelete - length rqs = " <> tshow (length rqs)
-      lift $ void $ withStoreBatch' c (\db -> map (\rq -> supervisorUpdateNtfAction db (qConnId rq) (NSASMP NSASmpDelete)) rqs)
+      (cErrs', _) <- lift $ partitionErrs qConnId rqs <$> (withStoreBatch' c $ \db -> map (updateAction db) rqs)
+      notifyErrs c (cErrs <> cErrs')
       kickSMPWorkers rqs
+      where
+        getQueue :: DB.Connection -> ConnId -> IO (Either AgentErrorType RcvQueue)
+        getQueue db connId = first storeError <$> getPrimaryRcvQueue db connId
+        updateAction :: DB.Connection -> RcvQueue -> IO ()
+        updateAction db rq = supervisorUpdateNtfAction db (qConnId rq) (NSASMP NSASmpDelete)
     NSCNtfWorker ntfServer -> lift . void $ getNtfNTFWorker True c ntfServer
     NSCNtfSMPWorker smpServer -> lift . void $ getNtfSMPWorker True c smpServer
-    NSCDeleteSub -> void $ lift $ withStoreBatch' c $ \db -> map (deleteNtfSubscription' db) (L.toList connIds)
+    NSCDeleteSub -> void $ lift $ withStoreBatch' c $ \db -> map (deleteNtfSubscription' db) connIds'
   where
     kickSMPWorkers :: [RcvQueue] -> AM ()
     kickSMPWorkers rqs = do
@@ -343,6 +360,10 @@ notifyInternalError' :: MonadIO m => AgentClient -> String -> m ()
 notifyInternalError' AgentClient {subQ} internalErrStr = atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL internalErrStr)
 {-# INLINE notifyInternalError' #-}
 
+notifyErrs :: MonadIO m => AgentClient -> [(ConnId, AgentErrorType)] -> m ()
+notifyErrs AgentClient {subQ} connErrs = unless (null connErrs) $ atomically $ writeTBQueue subQ ("", "", AEvt SAENone $ ERRS connErrs)
+{-# INLINE notifyErrs #-}
+
 getNtfToken :: AM' (Maybe NtfToken)
 getNtfToken = do
   tkn <- asks $ ntfTkn . ntfSupervisor
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index bfa6e46b0..635bb1aee 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -366,6 +366,7 @@ data AEvent (e :: AEntity) where
   OK :: AEvent AEConn
   JOINED :: SndQueueSecured -> AEvent AEConn
   ERR :: AgentErrorType -> AEvent AEConn
+  ERRS :: [(ConnId, AgentErrorType)] -> AEvent AENone
   SUSPENDED :: AEvent AENone
   RFPROG :: Int64 -> Int64 -> AEvent AERcvFile
   RFDONE :: FilePath -> AEvent AERcvFile
@@ -436,6 +437,7 @@ data AEventTag (e :: AEntity) where
   OK_ :: AEventTag AEConn
   JOINED_ :: AEventTag AEConn
   ERR_ :: AEventTag AEConn
+  ERRS_ :: AEventTag AENone
   SUSPENDED_ :: AEventTag AENone
   -- XFTP commands and responses
   RFDONE_ :: AEventTag AERcvFile
@@ -490,6 +492,7 @@ aEventTag = \case
   OK -> OK_
   JOINED _ -> JOINED_
   ERR _ -> ERR_
+  ERRS _ -> ERRS_
   SUSPENDED -> SUSPENDED_
   RFPROG {} -> RFPROG_
   RFDONE {} -> RFDONE_

From 22260cd719932ebce93520237725730762a98b73 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 22 Sep 2024 22:22:05 +0100
Subject: [PATCH 115/195] agent: transport isolation mode "Session" (default)
 to use new SOCKS credentials when client restarts or SOCKS proxy
 configuration changes (#1321)

* agent: transport isolation mode "Session" (default) to use new SOCKS credentials when client restarts or SOCKS proxy configuration changes

* fix test
---
 src/Simplex/FileTransfer/Client.hs       |  8 +++----
 src/Simplex/FileTransfer/Client/Agent.hs |  9 ++++---
 src/Simplex/Messaging/Agent.hs           | 15 ++++++------
 src/Simplex/Messaging/Agent/Client.hs    | 27 ++++++++++++++-------
 src/Simplex/Messaging/Client.hs          | 30 +++++++++++++-----------
 src/Simplex/Messaging/Client/Agent.hs    |  7 ++++--
 src/Simplex/Messaging/Protocol.hs        |  2 +-
 tests/AgentTests/FunctionalAPITests.hs   |  4 ++--
 tests/SMPProxyTests.hs                   |  9 ++++---
 tests/XFTPClient.hs                      |  6 +++--
 tests/XFTPServerTests.hs                 |  4 +++-
 11 files changed, 73 insertions(+), 48 deletions(-)

diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs
index 6f3b467e8..fde24f8be 100644
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -22,6 +22,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
+import Data.Time.Clock (UTCTime)
 import Data.Word (Word32)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
@@ -36,7 +37,6 @@ import Simplex.Messaging.Client
     TransportSession,
     chooseTransportHost,
     defaultNetworkConfig,
-    proxyUsername,
     transportClientConfig,
     clientSocksCredentials,
     unexpectedResponse,
@@ -99,9 +99,9 @@ defaultXFTPClientConfig =
       clientALPN = Just supportedXFTPhandshakes
     }
 
-getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
-getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} disconnected = runExceptT $ do
-  let socksCreds = clientSocksCredentials xftpNetworkConfig $ proxyUsername transportSession
+getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> UTCTime -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
+getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} proxySessTs disconnected = runExceptT $ do
+  let socksCreds = clientSocksCredentials xftpNetworkConfig proxySessTs transportSession
       ProtocolServer _ host port keyHash = srv
   useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
   let tcConfig = (transportClientConfig xftpNetworkConfig useHost) {alpn = clientALPN}
diff --git a/src/Simplex/FileTransfer/Client/Agent.hs b/src/Simplex/FileTransfer/Client/Agent.hs
index 863a91ce1..5d6b5c7a5 100644
--- a/src/Simplex/FileTransfer/Client/Agent.hs
+++ b/src/Simplex/FileTransfer/Client/Agent.hs
@@ -16,6 +16,7 @@ import Data.Bifunctor (first)
 import qualified Data.ByteString.Char8 as B
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8)
+import Data.Time.Clock (UTCTime, getCurrentTime)
 import Simplex.FileTransfer.Client
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientError (..), temporaryClientError)
@@ -30,6 +31,7 @@ type XFTPClientVar = TMVar (Either XFTPClientAgentError XFTPClient)
 
 data XFTPClientAgent = XFTPClientAgent
   { xftpClients :: TMap XFTPServer XFTPClientVar,
+    startedAt :: UTCTime,
     config :: XFTPClientAgentConfig
   }
 
@@ -56,19 +58,20 @@ data XFTPClientAgentError = XFTPClientAgentError XFTPServer XFTPClientError
 newXFTPAgent :: XFTPClientAgentConfig -> IO XFTPClientAgent
 newXFTPAgent config = do
   xftpClients <- TM.emptyIO
-  pure XFTPClientAgent {xftpClients, config}
+  startedAt <- getCurrentTime
+  pure XFTPClientAgent {xftpClients, startedAt, config}
 
 type ME a = ExceptT XFTPClientAgentError IO a
 
 getXFTPServerClient :: XFTPClientAgent -> XFTPServer -> ME XFTPClient
-getXFTPServerClient XFTPClientAgent {xftpClients, config} srv = do
+getXFTPServerClient XFTPClientAgent {xftpClients, startedAt, config} srv = do
   atomically getClientVar >>= either newXFTPClient waitForXFTPClient
   where
     connectClient :: ME XFTPClient
     connectClient =
       ExceptT $
         first (XFTPClientAgentError srv)
-          <$> getXFTPClient (1, srv, Nothing) (xftpConfig config) clientDisconnected
+          <$> getXFTPClient (1, srv, Nothing) (xftpConfig config) startedAt clientDisconnected
 
     clientDisconnected :: XFTPClient -> IO ()
     clientDisconnected _ = do
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 61f9d5da1..3f375420e 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -473,14 +474,14 @@ testProtocolServer c userId srv = withAgentEnv' c $ case protocolTypeI @p of
 
 -- | set SOCKS5 proxy on/off and optionally set TCP timeouts for fast network
 setNetworkConfig :: AgentClient -> NetworkConfig -> IO ()
-setNetworkConfig c@AgentClient {useNetworkConfig} cfg' = do
-  changed <- atomically $ do
+setNetworkConfig c@AgentClient {useNetworkConfig, proxySessTs} cfg' = do
+  (spChanged, changed) <- atomically $ do
     (_, cfg) <- readTVar useNetworkConfig
-    if cfg == cfg'
-      then pure False
-      else
-        let cfgSlow = slowNetworkConfig cfg'
-         in True <$ (cfgSlow `seq` writeTVar useNetworkConfig (cfgSlow, cfg'))
+    let changed = cfg /= cfg'
+        !cfgSlow = slowNetworkConfig cfg'
+    when changed $ writeTVar useNetworkConfig (cfgSlow, cfg')
+    pure (socksProxy cfg /= socksProxy cfg', changed)
+  when spChanged $ getCurrentTime >>= atomically . writeTVar proxySessTs
   when changed $ reconnectAllServers c
 
 setUserNetworkInfo :: AgentClient -> UserNetworkInfo -> IO ()
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index c2f1c8aa6..82d5d2785 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -333,6 +333,7 @@ data AgentClient = AgentClient
     smpSubWorkers :: TMap SMPTransportSession (SessionVar (Async ())),
     clientId :: Int,
     agentEnv :: Env,
+    proxySessTs :: TVar UTCTime,
     smpServersStats :: TMap (UserId, SMPServer) AgentSMPServerStats,
     xftpServersStats :: TMap (UserId, XFTPServer) AgentXFTPServerStats,
     ntfServersStats :: TMap (UserId, NtfServer) AgentNtfServerStats,
@@ -461,6 +462,7 @@ newAgentClient :: Int -> InitialAgentServers -> UTCTime -> Env -> IO AgentClient
 newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs agentEnv = do
   let cfg = config agentEnv
       qSize = tbqSize cfg
+  proxySessTs <- newTVarIO =<< getCurrentTime
   acThread <- newTVarIO Nothing
   active <- newTVarIO True
   subQ <- newTBQueueIO qSize
@@ -533,6 +535,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
         smpSubWorkers,
         clientId,
         agentEnv,
+        proxySessTs,
         smpServersStats,
         xftpServersStats,
         ntfServersStats,
@@ -657,7 +660,7 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
         Nothing -> Left $ BROKER (B.unpack $ strEncode srv) TIMEOUT
 
 smpConnectClient :: AgentClient -> SMPTransportSession -> TMap SMPServer ProxiedRelayVar -> SMPClientVar -> AM SMPConnectedClient
-smpConnectClient c@AgentClient {smpClients, msgQ} tSess@(_, srv, _) prs v =
+smpConnectClient c@AgentClient {smpClients, msgQ, proxySessTs} tSess@(_, srv, _) prs v =
   newProtocolClient c tSess smpClients connectClient v
     `catchAgentError` \e -> lift (resubscribeSMPSession c tSess) >> throwE e
   where
@@ -667,7 +670,8 @@ smpConnectClient c@AgentClient {smpClients, msgQ} tSess@(_, srv, _) prs v =
       g <- asks random
       env <- ask
       liftError (protocolClientError SMP $ B.unpack $ strEncode srv) $ do
-        smp <- ExceptT $ getProtocolClient g tSess cfg (Just msgQ) $ smpClientDisconnected c tSess env v' prs
+        ts <- readTVarIO proxySessTs
+        smp <- ExceptT $ getProtocolClient g tSess cfg (Just msgQ) ts $ smpClientDisconnected c tSess env v' prs
         pure SMPConnectedClient {connectedClient = smp, proxiedRelays = prs}
 
 smpClientDisconnected :: AgentClient -> SMPTransportSession -> Env -> SMPClientVar -> TMap SMPServer ProxiedRelayVar -> SMPClient -> IO ()
@@ -756,7 +760,7 @@ reconnectSMPClient c tSess@(_, srv, _) qs = handleNotify $ do
     notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, AEvt (sAEntity @e) cmd)
 
 getNtfServerClient :: AgentClient -> NtfTransportSession -> AM NtfClient
-getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(_, srv, _) = do
+getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs} tSess@(_, srv, _) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess ntfClients ts)
@@ -768,8 +772,9 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(_, srv,
     connectClient v = do
       cfg <- lift $ getClientConfig c ntfCfg
       g <- asks random
+      ts <- readTVarIO proxySessTs
       liftError' (protocolClientError NTF $ B.unpack $ strEncode srv) $
-        getProtocolClient g tSess cfg Nothing $
+        getProtocolClient g tSess cfg Nothing ts $
           clientDisconnected v
 
     clientDisconnected :: NtfClientVar -> NtfClient -> IO ()
@@ -779,7 +784,7 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(_, srv,
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
 getXFTPServerClient :: AgentClient -> XFTPTransportSession -> AM XFTPClient
-getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(_, srv, _) = do
+getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq, proxySessTs} tSess@(_, srv, _) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess xftpClients ts)
@@ -791,8 +796,9 @@ getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(_, srv
     connectClient v = do
       cfg <- asks $ xftpCfg . config
       xftpNetworkConfig <- getNetworkConfig c
+      ts <- readTVarIO proxySessTs
       liftError' (protocolClientError XFTP $ B.unpack $ strEncode srv) $
-        X.getXFTPClient tSess cfg {xftpNetworkConfig} $
+        X.getXFTPClient tSess cfg {xftpNetworkConfig} ts $
           clientDisconnected v
 
     clientDisconnected :: XFTPClientVar -> XFTPClient -> IO ()
@@ -1199,7 +1205,8 @@ runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
   g <- asks random
   liftIO $ do
     let tSess = (userId, srv, Nothing)
-    getProtocolClient g tSess cfg Nothing (\_ -> pure ()) >>= \case
+    ts <- readTVarIO $ proxySessTs c
+    getProtocolClient g tSess cfg Nothing ts (\_ -> pure ()) >>= \case
       Right smp -> do
         rKeys@(_, rpKey) <- atomically $ C.generateAuthKeyPair ra g
         (sKey, spKey) <- atomically $ C.generateAuthKeyPair sa g
@@ -1229,7 +1236,8 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
   rcvPath <- getTempFilePath workDir
   liftIO $ do
     let tSess = (userId, srv, Nothing)
-    X.getXFTPClient tSess cfg {xftpNetworkConfig} (\_ -> pure ()) >>= \case
+    ts <- readTVarIO $ proxySessTs c
+    X.getXFTPClient tSess cfg {xftpNetworkConfig} ts (\_ -> pure ()) >>= \case
       Right xftp -> withTestChunk filePath $ do
         (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
         (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -1273,7 +1281,8 @@ runNTFServerTest c userId (ProtoServerWithAuth srv _) = do
   g <- asks random
   liftIO $ do
     let tSess = (userId, srv, Nothing)
-    getProtocolClient g tSess cfg Nothing (\_ -> pure ()) >>= \case
+    ts <- readTVarIO $ proxySessTs c
+    getProtocolClient g tSess cfg Nothing ts (\_ -> pure ()) >>= \case
       Right ntf -> do
         (nKey, npKey) <- atomically $ C.generateAuthKeyPair a g
         (dhKey, _) <- atomically $ C.generateKeyPair g
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index c255d7f69..afcc5eab2 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -82,7 +82,6 @@ module Simplex.Messaging.Client
     transportClientConfig,
     clientSocksCredentials,
     chooseTransportHost,
-    proxyUsername,
     temporaryClientError,
     smpProxyError,
     textToHostMode,
@@ -118,6 +117,7 @@ import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Base64 as B64
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (find)
@@ -299,7 +299,7 @@ data NetworkConfig = NetworkConfig
   }
   deriving (Eq, Show)
 
-data TransportSessionMode = TSMUser | TSMEntity
+data TransportSessionMode = TSMUser | TSMSession | TSMServer | TSMEntity
   deriving (Eq, Show)
 
 -- SMP proxy mode for sending messages
@@ -349,7 +349,7 @@ defaultNetworkConfig =
       socksMode = SMAlways,
       hostMode = HMOnionViaSocks,
       requiredHostMode = False,
-      sessionMode = TSMUser,
+      sessionMode = TSMSession,
       smpProxyMode = SPMNever,
       smpProxyFallback = SPFAllow,
       tcpConnectTimeout = defaultTcpConnectTimeout,
@@ -371,16 +371,22 @@ transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, t
     useSocksProxy SMOnion = case host of
       THOnionHost _ -> socksProxy'
       _ -> Nothing
-{-# INLINE transportClientConfig #-}
 
-clientSocksCredentials :: NetworkConfig -> ByteString -> Maybe SocksCredentials
-clientSocksCredentials NetworkConfig {socksProxy} sessionUsername = case socksProxy of
+clientSocksCredentials :: ProtocolTypeI (ProtoType msg) => NetworkConfig -> UTCTime -> TransportSession msg -> Maybe SocksCredentials
+clientSocksCredentials NetworkConfig {socksProxy, sessionMode} proxySessTs (userId, srv, entityId_) = case socksProxy of
   Just (SocksProxyWithAuth auth _) -> case auth of
     SocksAuthUsername {username, password} -> Just $ SocksCredentials username password
     SocksAuthNull -> Nothing
     SocksIsolateByAuth -> Just $ SocksCredentials sessionUsername ""
   Nothing -> Nothing
-{-# INLINE clientSocksCredentials #-}
+  where
+    sessionUsername =
+      B64.encode $ C.sha256Hash $
+        bshow userId <> case sessionMode of
+          TSMUser -> ""
+          TSMSession -> ":" <> bshow proxySessTs
+          TSMServer -> ":" <> bshow proxySessTs <> "@" <> strEncode srv
+          TSMEntity -> ":" <> bshow proxySessTs <> "@" <> strEncode srv <> maybe "" ("/" <>) entityId_
 
 -- | protocol client configuration.
 data ProtocolClientConfig v = ProtocolClientConfig
@@ -470,8 +476,8 @@ type TransportSession msg = (UserId, ProtoServer msg, Maybe ByteString)
 --
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
-getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> TransportSession msg -> ProtocolClientConfig v -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
-getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret} msgQ disconnected = do
+getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> TransportSession msg -> ProtocolClientConfig v -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> UTCTime -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
+getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret} msgQ proxySessTs disconnected = do
   case chooseTransportHost networkConfig (host srv) of
     Right useHost ->
       (getCurrentTime >>= mkProtocolClient useHost >>= runClient useTransport useHost)
@@ -510,7 +516,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
     runClient (port', ATransport t) useHost c = do
       cVar <- newEmptyTMVarIO
       let tcConfig = (transportClientConfig networkConfig useHost) {alpn = clientALPN}
-          socksCreds = clientSocksCredentials networkConfig $ proxyUsername transportSession
+          socksCreds = clientSocksCredentials networkConfig proxySessTs transportSession
       tId <-
         runTransportClient tcConfig socksCreds useHost port' (Just $ keyHash srv) (client t c cVar)
           `forkFinally` \_ -> void (atomically . tryPutTMVar cVar $ Left PCENetworkError)
@@ -618,10 +624,6 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
 unexpectedResponse :: Show r => r -> ProtocolClientError err
 unexpectedResponse = PCEUnexpectedResponse . B.pack . take 32 . show
 
-proxyUsername :: TransportSession msg -> ByteString
-proxyUsername (userId, _, entityId_) = C.sha256Hash $ bshow userId <> maybe "" (":" <>) entityId_
-{-# INLINE proxyUsername #-}
-
 -- | Disconnects client from the server and terminates client threads.
 closeProtocolClient :: ProtocolClient v err msg -> IO ()
 closeProtocolClient = mapM_ (deRefWeak >=> mapM_ killThread) . action
diff --git a/src/Simplex/Messaging/Client/Agent.hs b/src/Simplex/Messaging/Client/Agent.hs
index 29c485ebd..f5d1a53cf 100644
--- a/src/Simplex/Messaging/Client/Agent.hs
+++ b/src/Simplex/Messaging/Client/Agent.hs
@@ -95,6 +95,7 @@ defaultSMPClientAgentConfig =
 data SMPClientAgent = SMPClientAgent
   { agentCfg :: SMPClientAgentConfig,
     active :: TVar Bool,
+    startedAt :: UTCTime,
     msgQ :: TBQueue (ServerTransmissionBatch SMPVersion ErrorType BrokerMsg),
     agentQ :: TBQueue SMPClientAgentEvent,
     randomDrg :: TVar ChaChaDRG,
@@ -111,6 +112,7 @@ type OwnServer = Bool
 newSMPClientAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO SMPClientAgent
 newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg = do
   active <- newTVarIO True
+  startedAt <- getCurrentTime
   msgQ <- newTBQueueIO msgQSize
   agentQ <- newTBQueueIO agentQSize
   smpClients <- TM.emptyIO
@@ -123,6 +125,7 @@ newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg
     SMPClientAgent
       { agentCfg,
         active,
+        startedAt,
         msgQ,
         agentQ,
         randomDrg,
@@ -194,8 +197,8 @@ isOwnServer SMPClientAgent {agentCfg} ProtocolServer {host} =
 
 -- | Run an SMP client for SMPClientVar
 connectClient :: SMPClientAgent -> SMPServer -> SMPClientVar -> IO (Either SMPClientError SMPClient)
-connectClient ca@SMPClientAgent {agentCfg, smpClients, smpSessions, msgQ, randomDrg} srv v =
-  getProtocolClient randomDrg (1, srv, Nothing) (smpCfg agentCfg) (Just msgQ) clientDisconnected
+connectClient ca@SMPClientAgent {agentCfg, smpClients, smpSessions, msgQ, randomDrg, startedAt} srv v =
+  getProtocolClient randomDrg (1, srv, Nothing) (smpCfg agentCfg) (Just msgQ) startedAt clientDisconnected
   where
     clientDisconnected :: SMPClient -> IO ()
     clientDisconnected smp = do
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index cad84454f..9ef7e57b2 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -1278,7 +1278,7 @@ transmissionP THandleParams {sessionId, implySessId} = do
       command <- A.takeByteString
       pure RawTransmission {authenticator, authorized = authorized', sessId, corrId, entityId, command}
 
-class (ProtocolEncoding v err msg, ProtocolEncoding v err (ProtoCommand msg), Show err, Show msg) => Protocol v err msg | msg -> v, msg -> err where
+class (ProtocolTypeI (ProtoType msg), ProtocolEncoding v err msg, ProtocolEncoding v err (ProtoCommand msg), Show err, Show msg) => Protocol v err msg | msg -> v, msg -> err where
   type ProtoCommand msg = cmd | cmd -> msg
   type ProtoType msg = (sch :: ProtocolType) | sch -> msg
   protocolClientHandshake :: forall c. Transport c => c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRange v -> ExceptT TransportError IO (THandle v c 'TClient)
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 29725f96a..ca9a27075 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -85,7 +85,7 @@ import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, REQ, SENT)
 import qualified Simplex.Messaging.Agent.Protocol as A
 import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), SQLiteStore (dbNew))
 import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction')
-import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SMPProxyFallback (..), SMPProxyMode (..), TransportSessionMode (TSMEntity, TSMUser), defaultClientConfig)
+import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SMPProxyFallback (..), SMPProxyMode (..), TransportSessionMode (..), defaultClientConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
@@ -3014,7 +3014,7 @@ testDeliveryReceiptsConcurrent t =
 testTwoUsers :: HasCallStack => IO ()
 testTwoUsers = withAgentClients2 $ \a b -> do
   let nc = netCfg initAgentServers
-  sessionMode nc `shouldBe` TSMUser
+  sessionMode nc `shouldBe` TSMSession
   runRight_ $ do
     (aId1, bId1) <- makeConnectionForUsers a 1 b 1
     exchangeGreetings a bId1 b aId1
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 32aa992d3..6fe10b38b 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -22,6 +22,7 @@ import Control.Monad.Trans.Except (ExceptT, runExceptT)
 import Data.ByteString.Char8 (ByteString)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
+import Data.Time.Clock (getCurrentTime)
 import SMPAgentClient
 import SMPClient
 import ServerTests (decryptMsgV3, sendRecv)
@@ -150,12 +151,13 @@ deliverMessagesViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => SMPServer -> S
 deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do
   g <- C.newRandom
   -- set up proxy
-  pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion} Nothing (\_ -> pure ())
+  ts <- getCurrentTime
+  pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion} Nothing ts (\_ -> pure ())
   pc <- either (fail . show) pure pc'
   THAuthClient {} <- maybe (fail "getProtocolClient returned no thAuth") pure $ thAuth $ thParams pc
   -- set up relay
   msgQ <- newTBQueueIO 1024
-  rc' <- getProtocolClient g (2, relayServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion} (Just msgQ) (\_ -> pure ())
+  rc' <- getProtocolClient g (2, relayServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion} (Just msgQ) ts (\_ -> pure ())
   rc <- either (fail . show) pure rc'
   -- prepare receiving queue
   (rPub, rPriv) <- atomically $ C.generateAuthKeyPair alg g
@@ -192,7 +194,8 @@ proxyConnectDeadRelay :: Int -> Int -> SMPServer -> IO ()
 proxyConnectDeadRelay n d proxyServ = do
   g <- C.newRandom
   -- set up proxy
-  pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion} Nothing (\_ -> pure ())
+  ts <- getCurrentTime
+  pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion} Nothing ts (\_ -> pure ())
   pc <- either (fail . show) pure pc'
   THAuthClient {} <- maybe (fail "getProtocolClient returned no thAuth") pure $ thAuth $ thParams pc
   -- get proxy session
diff --git a/tests/XFTPClient.hs b/tests/XFTPClient.hs
index 72c843f32..398b6cd9f 100644
--- a/tests/XFTPClient.hs
+++ b/tests/XFTPClient.hs
@@ -8,6 +8,7 @@ module XFTPClient where
 
 import Control.Concurrent (ThreadId, threadDelay)
 import Data.String (fromString)
+import Data.Time.Clock (getCurrentTime)
 import Network.Socket (ServiceName)
 import SMPClient (serverBracket)
 import Simplex.FileTransfer.Client
@@ -135,7 +136,8 @@ testXFTPClient :: HasCallStack => (HasCallStack => XFTPClient -> IO a) -> IO a
 testXFTPClient = testXFTPClientWith testXFTPClientConfig
 
 testXFTPClientWith :: HasCallStack => XFTPClientConfig -> (HasCallStack => XFTPClient -> IO a) -> IO a
-testXFTPClientWith cfg client =
-  getXFTPClient (1, testXFTPServer, Nothing) cfg (\_ -> pure ()) >>= \case
+testXFTPClientWith cfg client = do
+  ts <- getCurrentTime
+  getXFTPClient (1, testXFTPServer, Nothing) cfg ts (\_ -> pure ()) >>= \case
     Right c -> client c
     Left e -> error $ show e
diff --git a/tests/XFTPServerTests.hs b/tests/XFTPServerTests.hs
index 9b74cf888..cc40ee3f7 100644
--- a/tests/XFTPServerTests.hs
+++ b/tests/XFTPServerTests.hs
@@ -18,6 +18,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.List (isInfixOf)
+import Data.Time.Clock (getCurrentTime)
 import ServerTests (logSize)
 import Simplex.FileTransfer.Client
 import Simplex.FileTransfer.Description (kb)
@@ -220,7 +221,8 @@ testFileChunkExpiration = withXFTPServerCfg testXFTPServerConfig {fileExpiration
 testInactiveClientExpiration :: Expectation
 testInactiveClientExpiration = withXFTPServerCfg testXFTPServerConfig {inactiveClientExpiration} $ \_ -> runRight_ $ do
   disconnected <- newEmptyTMVarIO
-  c <- ExceptT $ getXFTPClient (1, testXFTPServer, Nothing) testXFTPClientConfig (\_ -> atomically $ putTMVar disconnected ())
+  ts <- liftIO getCurrentTime
+  c <- ExceptT $ getXFTPClient (1, testXFTPServer, Nothing) testXFTPClientConfig ts (\_ -> atomically $ putTMVar disconnected ())
   pingXFTP c
   liftIO $ do
     threadDelay 100000

From 7dcac19a671f76dedbe769030742714783946bd3 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 24 Sep 2024 09:22:26 +0100
Subject: [PATCH 116/195] xrcp: session encryption with forward secrecy (#1328)

* xrcp: session encryption with forward secrecy

* update doc

* accept keys as parameters

* docs: counter

* spec corrections
---
 protocol/xrcp.md                     | 34 ++++++++++++++++-----
 src/Simplex/Messaging/Crypto.hs      | 27 +++++++++++++++++
 src/Simplex/Messaging/Crypto/Lazy.hs | 17 ++++++++++-
 src/Simplex/Messaging/Transport.hs   |  7 +++++
 src/Simplex/RemoteControl/Client.hs  | 44 ++++++++++++++++------------
 src/Simplex/RemoteControl/Types.hs   | 15 +++++-----
 tests/RemoteControl.hs               | 25 ++++++++++++++--
 7 files changed, 132 insertions(+), 37 deletions(-)

diff --git a/protocol/xrcp.md b/protocol/xrcp.md
index 2ed2c8d62..c8042f858 100644
--- a/protocol/xrcp.md
+++ b/protocol/xrcp.md
@@ -67,7 +67,7 @@ The session invitation contains this data:
 - CA TLS certificate fingerprint of the controller - this is part of long term identity of the controller established during the first session, and repeated in the subsequent session announcements.
 - Session Ed25519 public key used to verify the announcement and commands - this mitigates the compromise of the long term signature key, as the controller will have to sign each command with this key first.
 - Long-term Ed25519 public key used to verify the announcement and commands - this is part of the long term controller identity.
-- Session X25519 DH key and SNTRUP761 KEM encapsulation key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. DH public key and KEM encapsulation key are sent unencrypted. NaCL crypto_box is used for encryption.
+- Session X25519 DH key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. DH public key and KEM encapsulation key are sent unencrypted. NaCL crypto_box is used for encryption.
 
 Host application decrypts (except the first session) and validates the invitation:
 - Session signature is valid.
@@ -184,7 +184,7 @@ The controller decrypts (including the first session) and validates the received
 The controller should reply with with `ctrlHello` or `ctrlError` response:
 
 ```abnf
-ctrlHello = %s"HELLO " kemCiphertext nonce encrypted(unpaddedSize ctrlHelloJSON helloPad) pad
+ctrlHello = %s"HELLO " kemCiphertext encrypted(unpaddedSize ctrlHelloJSON helloPad) pad
 ; ctrlHelloJSON is encrypted with the hybrid secret,
 ; including both previously agreed DH secret and KEM secret from kemCiphertext
 unpaddedSize = largeLength
@@ -206,6 +206,8 @@ JTD schema for the encrypted part of controller HELLO block `ctrlHelloJSON`:
 }
 ```
 
+Controller `hello` block and all subsequent protocol messages are encrypted with the chain keys derived from the hybrid key (see key exchange below) - that is why conntroller hello block does not include nonce. That provides forward secrecy within the XRCP session. Receiving this `hello` block allows host to compute the same hybrid keys and to derive the same chain keys.
+
 Once the controller replies HELLO to the valid host HELLO block, it should stop accepting new TCP connections.
 
 ### Controller/host session operation
@@ -223,10 +225,12 @@ tlsunique channel binding from TLS session MUST be included in commands (include
 The syntax for encrypted command and response body encoding:
 
 ```abnf
-commandBody = encBody sessSignature idSignature [attachment]
-responseBody = encBody [attachment] ; counter must match command
-encBody = nonce encLength32 encrypted(tlsunique counter body)
-attachment = %x01 nonce encLength32 encrypted(attachment)
+commandBody = counter encBody sessSignature idSignature [attachment]
+responseBody = counter encBody [attachment] ; counter must match command
+; counter is placed outside of encrypted body to allow correlating encryption keys
+; with the chain keys (each command and response are encrypted by different keys)
+encBody = encLength32 encrypted(tlsunique body)
+attachment = %x01 encLength32 encrypted(attachment)
 noAttachment = %x00
 tlsunique = length 1*OCTET
 counter = 8*8 OCTET ; int64
@@ -239,7 +243,7 @@ If the command or response includes attachment, its hash must be included in com
 
 Initial announcement is shared out-of-band (URI with xrcp scheme), and it is not encrypted.
 
-This announcement contains only DH keys, as KEM key is too large to include in QR code, which are used to agree encryption key for host HELLO block. The host HELLO block will contain DH key in plaintext part and KEM encapsulation (public) key in encrypted part, that will be used to determine the shared secret (using SHA256 over concatenated DH shared secret and KEM encapsulated secret) both for controller HELLO response (that contains KEM ciphertext in plaintext part) and subsequent session commands and responses.
+This announcement contains only DH keys, as KEM key is too large to include in QR code, which are used to agree encryption key for host HELLO block. The host HELLO block will contain DH key in plaintext part and KEM encapsulation (public) key in encrypted part, that will be used to determine the shared secret (using SHA3-256 over concatenated DH shared secret and KEM encapsulated secret) to derive keys for controller HELLO response (that contains KEM ciphertext in plaintext part) and subsequent session commands and responses.
 
 During the next session the announcement is sent via encrypted multicast block. The shared key for this announcement and for host HELLO block is determined using the KEM shared secret from the previous session and DH shared secret computed using the host DH key from the previous session and the new controller DH key from the announcement.
 
@@ -273,6 +277,22 @@ If controller fails to store the new host DH key after receiving HELLO block, th
 
 To decrypt a multicast announcement, the host should try to decrypt it using the keys of all known (paired) remote controllers.
 
+Once kemSecret is agreed for the session, it is used to derive two chain keys, to receive and to send messages:
+
+```
+host: sndKey, rcvKey = HKDF(kemSecret, "SimpleXSbChainInit", 64)
+controller: rcvKey, sndKey  = HKDF(kemSecret, "SimpleXSbChainInit", 64)
+```
+
+where HKDF is based on SHA512, with empty salt.
+
+Actual keys and nonces to encrypt and decrypt messages are derived from these chain keys:
+
+```
+to send: (sndKey', sk, nonce) = HKDF(sndKey, "SimpleXSbChain", 88)
+to receive: (rcvKey', sk, nonce) = HKDF(rcvKey, "SimpleXSbChain", 88)
+```
+
 ## Threat model
 
 #### A passive network adversary able to monitor the site-local traffic:
diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index 7aefbd709..05ba861bc 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -152,6 +152,12 @@ module Simplex.Messaging.Crypto
     unsafeSbKey,
     randomSbKey,
 
+    -- * secret_box chains
+    SbChainKey,
+    SbKeyNonce,
+    sbcInit,
+    sbcHkdf,
+
     -- * pseudo-random bytes
     randomBytes,
 
@@ -198,6 +204,7 @@ import qualified Crypto.Cipher.Types as AES
 import qualified Crypto.Cipher.XSalsa as XSalsa
 import qualified Crypto.Error as CE
 import Crypto.Hash (Digest, SHA256 (..), SHA512 (..), hash, hashDigestSize)
+import qualified Crypto.KDF.HKDF as H
 import qualified Crypto.MAC.Poly1305 as Poly1305
 import qualified Crypto.PubKey.Curve25519 as X25519
 import qualified Crypto.PubKey.Curve448 as X448
@@ -1334,6 +1341,26 @@ unsafeSbKey s = either error id $ sbKey s
 randomSbKey :: TVar ChaChaDRG -> STM SbKey
 randomSbKey gVar = SecretBoxKey <$> randomBytes 32 gVar
 
+newtype SbChainKey = SecretBoxChainKey {unSbChainKey :: ByteString}
+  deriving (Eq, Show)
+
+sbcInit :: ByteArrayAccess secret => ByteString -> secret -> (SbChainKey, SbChainKey)
+sbcInit salt secret = (SecretBoxChainKey ck1, SecretBoxChainKey ck2)
+  where
+    prk = H.extract salt secret :: H.PRK SHA512
+    out = H.expand prk ("SimpleXSbChainInit" :: ByteString) 64
+    (ck1, ck2) = B.splitAt 32 out
+
+type SbKeyNonce = (SbKey, CbNonce)
+
+sbcHkdf :: SbChainKey -> (SbKeyNonce, SbChainKey)
+sbcHkdf (SecretBoxChainKey ck) = ((SecretBoxKey sk, CryptoBoxNonce nonce), SecretBoxChainKey ck')
+  where
+    prk = H.extract B.empty ck :: H.PRK SHA512
+    out = H.expand prk ("SimpleXSbChain" :: ByteString) 88 -- = 32 (new chain key) + 32 (secret_box key) + 24 (nonce)
+    (ck', rest) = B.splitAt 32 out
+    (sk, nonce) = B.splitAt 32 rest
+
 xSalsa20 :: ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString)
 xSalsa20 secret nonce msg = (rs, msg')
   where
diff --git a/src/Simplex/Messaging/Crypto/Lazy.hs b/src/Simplex/Messaging/Crypto/Lazy.hs
index c83d93a07..6c0cf9613 100644
--- a/src/Simplex/Messaging/Crypto/Lazy.hs
+++ b/src/Simplex/Messaging/Crypto/Lazy.hs
@@ -17,6 +17,8 @@ module Simplex.Messaging.Crypto.Lazy
     kcbEncryptTailTag,
     sbDecryptTailTag,
     kcbDecryptTailTag,
+    sbEncryptTailTagNoPad,
+    sbDecryptTailTagNoPad,
     fastReplicate,
     secretBox,
     secretBoxTailTag,
@@ -49,7 +51,7 @@ import Data.Composition ((.:.))
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
 import Foreign (sizeOf)
-import Simplex.Messaging.Crypto (CbNonce, CryptoError (..), DhSecret (..), DhSecretX25519, SbKey, pattern CbNonce, pattern SbKey)
+import Simplex.Messaging.Crypto (CbNonce, CryptoError (..), DhSecret (..), DhSecretX25519, SbKey, SbKeyNonce, pattern CbNonce, pattern SbKey)
 import Simplex.Messaging.Crypto.SNTRUP761 (KEMHybridSecret (..))
 import Simplex.Messaging.Encoding
 
@@ -142,6 +144,10 @@ sbEncryptTailTag_ :: ByteArrayAccess key => key -> CbNonce -> LazyByteString ->
 sbEncryptTailTag_ key (CbNonce nonce) msg len paddedLen =
   LB.fromChunks <$> (secretBoxTailTag sbEncryptChunk key nonce =<< pad msg len paddedLen)
 
+sbEncryptTailTagNoPad :: SbKeyNonce -> LazyByteString -> Either CryptoError LazyByteString
+sbEncryptTailTagNoPad (SbKey key, CbNonce nonce) msg =
+  LB.fromChunks <$> secretBoxTailTag sbEncryptChunk key nonce msg
+
 -- | NaCl @secret_box@ decrypt with a symmetric 256-bit key and 192-bit nonce with appended auth tag (more efficient with large files).
 -- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
 sbDecryptTailTag :: SbKey -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
@@ -165,6 +171,15 @@ sbDecryptTailTag_ key (CbNonce nonce) paddedLen packet =
   where
     (c, tag') = LB.splitAt paddedLen packet
 
+sbDecryptTailTagNoPad :: SbKeyNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
+sbDecryptTailTagNoPad (SbKey key, CbNonce nonce) paddedLen packet =
+  result <$> secretBox sbDecryptChunk key nonce c
+  where
+    result (tag :| cs) =
+      let valid = LB.length tag' == 16 && BA.constEq (LB.toStrict tag') tag
+       in (valid, LB.fromChunks cs)
+    (c, tag') = LB.splitAt paddedLen packet
+
 secretBoxTailTag :: ByteArrayAccess key => (SbState -> ByteString -> (ByteString, SbState)) -> key -> ByteString -> LazyByteString -> Either CryptoError [ByteString]
 secretBoxTailTag sbProcess secret nonce msg = run <$> sbInit_ secret nonce
   where
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index e681ec396..bc7cc85dd 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -72,6 +72,7 @@ module Simplex.Messaging.Transport
     THandle (..),
     THandleParams (..),
     THandleAuth (..),
+    TSbChainKeys (..),
     TransportError (..),
     HandshakeError (..),
     smpServerHandshake,
@@ -85,6 +86,7 @@ module Simplex.Messaging.Transport
 where
 
 import Control.Applicative (optional)
+import Control.Concurrent.STM
 import Control.Monad (forM, (<$!>))
 import Control.Monad.Except
 import Control.Monad.Trans.Except (throwE)
@@ -393,6 +395,11 @@ data THandleAuth (p :: TransportPeer) where
     } ->
     THandleAuth 'TServer
 
+data TSbChainKeys = TSbChainKeys
+  { sndKey :: TVar C.SbChainKey,
+    rcvKey :: TVar C.SbChainKey
+  }
+
 -- | TLS-unique channel binding
 type SessionId = ByteString
 
diff --git a/src/Simplex/RemoteControl/Client.hs b/src/Simplex/RemoteControl/Client.hs
index 381397c6e..1c0ef94cc 100644
--- a/src/Simplex/RemoteControl/Client.hs
+++ b/src/Simplex/RemoteControl/Client.hs
@@ -23,6 +23,9 @@ module Simplex.RemoteControl.Client
     rcEncryptBody,
     rcDecryptBody,
     xrcpBlockSize,
+    -- for tests only
+    sendRCPacket,
+    receiveRCPacket,
   ) where
 
 import Control.Applicative ((<|>))
@@ -33,6 +36,7 @@ import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
+import Data.Bitraversable (bimapM)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LB
@@ -43,6 +47,7 @@ import qualified Data.List.NonEmpty as L
 import Data.Maybe (isNothing)
 import qualified Data.Text as T
 import Data.Time.Clock.System (getSystemTime)
+import Data.Tuple (swap)
 import Data.Word (Word16)
 import qualified Data.X509 as X509
 import Data.X509.Validation (Fingerprint (..), getFingerprint)
@@ -57,7 +62,7 @@ import Simplex.Messaging.Crypto.SNTRUP761
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
-import Simplex.Messaging.Transport (TLS (..), cGet, cPut)
+import Simplex.Messaging.Transport (TSbChainKeys (..), TLS (..), cGet, cPut)
 import Simplex.Messaging.Transport.Buffer (peekBuffered)
 import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost (..), defaultTransportClientConfig, runTransportClient)
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
@@ -214,15 +219,16 @@ prepareHostSession
     hostHello@RCHostHello {v, ca, kem = kemPubKey} <- liftEitherWith RCESyntax $ J.eitherDecodeStrict helloBody
     unless (ca == tlsHostFingerprint) $ throwE RCEIdentity
     (kemCiphertext, kemSharedKey) <- liftIO $ sntrup761Enc drg kemPubKey
-    let hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey
+    let KEMHybridSecret hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey
     unless (isCompatible v supportedRCPVRange) $ throwE RCEVersion
-    let keys = HostSessKeys {hybridKey, idPrivKey, sessPrivKey}
+    (sndKey, rcvKey) <- bimapM newTVarIO newTVarIO $ C.sbcInit "" hybridKey
+    let keys = HostSessKeys {chainKeys = TSbChainKeys {sndKey, rcvKey}, idPrivKey, sessPrivKey}
     knownHost' <- updateKnownHost ca dhPubKey
     let ctrlHello = RCCtrlHello {}
     -- TODO send error response if something fails
-    nonce' <- liftIO . atomically $ C.randomCbNonce drg
-    encBody' <- liftEitherWith (const RCEBlockSize) $ kcbEncrypt hybridKey nonce' (LB.toStrict $ J.encode ctrlHello) helloBlockSize
-    let ctrlEncHello = RCCtrlEncHello {kem = kemCiphertext, nonce = nonce', encBody = encBody'}
+    (sk, nonce') <- atomically $ stateTVar sndKey C.sbcHkdf
+    encBody' <- liftEitherWith (const RCEBlockSize) $ C.sbEncrypt sk nonce' (LB.toStrict $ J.encode ctrlHello) helloBlockSize
+    let ctrlEncHello = RCCtrlEncHello {kem = kemCiphertext, encBody = encBody'}
     pure (ctrlEncHello, keys, hostHello, pairing {knownHost = Just knownHost'})
     where
       updateKnownHost :: C.KeyHash -> C.PublicKeyX25519 -> ExceptT RCErrorType IO KnownHostPairing
@@ -349,13 +355,16 @@ prepareCtrlSession
   RCInvitation {skey, dh = dhPubKey}
   sharedKey
   kemPrivKey = \case
-    RCCtrlEncHello {kem = kemCiphertext, nonce, encBody} -> do
+    RCCtrlEncHello {kem = kemCiphertext, encBody} -> do
       kemSharedKey <- liftIO $ sntrup761Dec kemCiphertext kemPrivKey
-      let hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey
-      helloBody <- liftEitherWith (const RCEDecrypt) $ kcbDecrypt hybridKey nonce encBody
+      let KEMHybridSecret hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey
+      -- keys are swapped in controller
+      (sndKey, rcvKey) <- swap <$> bimapM newTVarIO newTVarIO (C.sbcInit "" hybridKey)
+      (sk, nonce) <- atomically $ stateTVar rcvKey C.sbcHkdf
+      helloBody <- liftEitherWith (const RCEDecrypt) $ C.sbDecrypt sk nonce encBody
       logDebug "Decrypted ctrl HELLO"
       RCCtrlHello {} <- liftEitherWith RCESyntax $ J.eitherDecodeStrict helloBody
-      pure CtrlSessKeys {hybridKey, idPubKey, sessPubKey = skey}
+      pure CtrlSessKeys {chainKeys = TSbChainKeys {sndKey, rcvKey}, idPubKey, sessPubKey = skey}
     RCCtrlEncError {nonce, encMessage} -> do
       message <- liftEitherWith (const RCEDecrypt) $ C.cbDecrypt sharedKey nonce encMessage
       throwE $ RCECtrlError $ T.unpack $ safeDecodeUtf8 message
@@ -426,17 +435,14 @@ cancelCtrlClient RCCtrlClient {action, client_ = RCCClient_ {endSession}} = do
 
 -- * Session encryption
 
-rcEncryptBody :: TVar ChaChaDRG -> KEMHybridSecret -> LazyByteString -> ExceptT RCErrorType IO (C.CbNonce, LazyByteString)
-rcEncryptBody drg hybridKey s = do
-  nonce <- atomically $ C.randomCbNonce drg
-  let len = LB.length s
-  ct <- liftEitherWith (const RCEEncrypt) $ LC.kcbEncryptTailTag hybridKey nonce s len (len + 8)
-  pure (nonce, ct)
+rcEncryptBody :: C.SbKeyNonce -> LazyByteString -> ExceptT RCErrorType IO LazyByteString
+rcEncryptBody keyNonce s = do
+  liftEitherWith (const RCEEncrypt) $ LC.sbEncryptTailTagNoPad keyNonce s
 
-rcDecryptBody :: KEMHybridSecret -> C.CbNonce -> LazyByteString -> ExceptT RCErrorType IO LazyByteString
-rcDecryptBody hybridKey nonce ct = do
+rcDecryptBody :: C.SbKeyNonce -> LazyByteString -> ExceptT RCErrorType IO LazyByteString
+rcDecryptBody keyNonce ct = do
   let len = LB.length ct - 16
   when (len < 0) $ throwE RCEDecrypt
-  (ok, s) <- liftEitherWith (const RCEDecrypt) $ LC.kcbDecryptTailTag hybridKey nonce len ct
+  (ok, s) <- liftEitherWith (const RCEDecrypt) $ LC.sbDecryptTailTagNoPad keyNonce len ct
   unless ok $ throwE RCEDecrypt
   pure s
diff --git a/src/Simplex/RemoteControl/Types.hs b/src/Simplex/RemoteControl/Types.hs
index e5d885b1d..666878c30 100644
--- a/src/Simplex/RemoteControl/Types.hs
+++ b/src/Simplex/RemoteControl/Types.hs
@@ -20,12 +20,11 @@ import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Data.Word (Word16)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.SNTRUP761
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
-import Simplex.Messaging.Transport (TLS)
+import Simplex.Messaging.Transport (TLS, TSbChainKeys)
 import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util (safeDecodeUtf8)
 import Simplex.Messaging.Version (VersionRange, VersionScope, mkVersionRange)
@@ -180,7 +179,7 @@ data RCHostSession = RCHostSession
   }
 
 data HostSessKeys = HostSessKeys
-  { hybridKey :: KEMHybridSecret,
+  { chainKeys :: TSbChainKeys,
     idPrivKey :: C.PrivateKeyEd25519,
     sessPrivKey :: C.PrivateKeyEd25519
   }
@@ -193,7 +192,7 @@ data RCCtrlSession = RCCtrlSession
   }
 
 data CtrlSessKeys = CtrlSessKeys
-  { hybridKey :: KEMHybridSecret,
+  { chainKeys :: TSbChainKeys,
     idPubKey :: C.PublicKeyEd25519,
     sessPubKey :: C.PublicKeyEd25519
   }
@@ -213,19 +212,19 @@ instance Encoding RCHostEncHello where
     pure RCHostEncHello {dhPubKey, nonce, encBody}
 
 data RCCtrlEncHello
-  = RCCtrlEncHello {kem :: KEMCiphertext, nonce :: C.CbNonce, encBody :: ByteString}
+  = RCCtrlEncHello {kem :: KEMCiphertext, encBody :: ByteString}
   | RCCtrlEncError {nonce :: C.CbNonce, encMessage :: ByteString}
   deriving (Show)
 
 instance Encoding RCCtrlEncHello where
   smpEncode = \case
-    RCCtrlEncHello {kem, nonce, encBody} -> "HELLO " <> smpEncode (kem, nonce, Tail encBody)
+    RCCtrlEncHello {kem, encBody} -> "HELLO " <> smpEncode (kem, Tail encBody)
     RCCtrlEncError {nonce, encMessage} -> "ERROR " <> smpEncode (nonce, Tail encMessage)
   smpP =
     A.takeTill (== ' ') >>= \case
       "HELLO" -> do
-        (kem, nonce, Tail encBody) <- _smpP
-        pure RCCtrlEncHello {kem, nonce, encBody}
+        (kem, Tail encBody) <- _smpP
+        pure RCCtrlEncHello {kem, encBody}
       "ERROR" -> do
         (nonce, Tail encMessage) <- _smpP
         pure RCCtrlEncError {nonce, encMessage}
diff --git a/tests/RemoteControl.hs b/tests/RemoteControl.hs
index c0a32cd4c..4b6db594b 100644
--- a/tests/RemoteControl.hs
+++ b/tests/RemoteControl.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -8,9 +9,11 @@ import AgentTests.FunctionalAPITests (runRight)
 import Control.Logger.Simple
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
+import Data.ByteString.Lazy.Char8 as LB
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Transport (TSbChainKeys (..))
 import qualified Simplex.RemoteControl.Client as HC (RCHostClient (action))
 import qualified Simplex.RemoteControl.Client as RC
 import Simplex.RemoteControl.Discovery (mkLastLocalHost, preferAddress)
@@ -74,7 +77,16 @@ testNewPairing = do
     logNote "c 3"
     Right (sessId, _tls, r') <- atomically $ takeTMVar r
     logNote "c 4"
-    Right (_rcHostSession, _rcHelloBody, _hp') <- atomically $ takeTMVar r'
+    Right (rcHostSession, _rcHelloBody, _hp') <- atomically $ takeTMVar r'
+    let RCHostSession {tls, sessionKeys = HostSessKeys {chainKeys}} = rcHostSession
+        TSbChainKeys {rcvKey, sndKey} = chainKeys
+    sndKeyNonce <- atomically $ stateTVar sndKey C.sbcHkdf
+    encCmd <- RC.rcEncryptBody sndKeyNonce "command message"
+    RC.sendRCPacket tls $ LB.toStrict encCmd
+    encResp <- RC.receiveRCPacket tls
+    rcvKeyNonce <- atomically $ stateTVar rcvKey C.sbcHkdf
+    resp <- RC.rcDecryptBody rcvKeyNonce $ LB.fromStrict encResp
+    liftIO $ resp `shouldBe` "response message"
     logNote "c 5"
     threadDelay 250000
     logNote "ctrl: ciao"
@@ -93,7 +105,16 @@ testNewPairing = do
     logNote "h 3"
     liftIO $ RC.confirmCtrlSession rcCtrlClient True
     logNote "h 4"
-    Right (_rcCtrlSession, _rcCtrlPairing) <- atomically $ takeTMVar r'
+    Right (rcCtrlSession, _rcCtrlPairing) <- atomically $ takeTMVar r'
+    let RCCtrlSession {tls, sessionKeys = CtrlSessKeys {chainKeys}} = rcCtrlSession
+        TSbChainKeys {rcvKey, sndKey} = chainKeys
+    encCmd <- RC.receiveRCPacket tls
+    rcvKeyNonce <- atomically $ stateTVar rcvKey C.sbcHkdf
+    cmd <- RC.rcDecryptBody rcvKeyNonce $ LB.fromStrict encCmd
+    liftIO $ cmd `shouldBe` "command message"
+    sndKeyNonce <- atomically $ stateTVar sndKey C.sbcHkdf
+    encResp <- RC.rcEncryptBody sndKeyNonce "response message"
+    RC.sendRCPacket tls $ LB.toStrict encResp
     logNote "h 5"
     threadDelay 250000
     logNote "ctrl: adios"

From d0ee505c3a45fd0e7e346988bc2db5be13ffd184 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 24 Sep 2024 12:29:11 +0100
Subject: [PATCH 117/195] rfc: protocol for SMP queue data blobs and short
 links (#1309)

* rfc: protocol for SMP queue data blobs and short links

* update

* private rendezvous
---
 rfcs/2024-06-21-short-links.md        | 124 ++++++++++++++++++++++++++
 rfcs/2024-09-05-queue-storage.md      |  81 +++++++++++++++++
 rfcs/2024-09-09-smp-blobs.md          |  80 +++++++++++++++++
 rfcs/2024-09-10-private-rendezvous.md |  26 ++++++
 4 files changed, 311 insertions(+)
 create mode 100644 rfcs/2024-06-21-short-links.md
 create mode 100644 rfcs/2024-09-05-queue-storage.md
 create mode 100644 rfcs/2024-09-09-smp-blobs.md
 create mode 100644 rfcs/2024-09-10-private-rendezvous.md

diff --git a/rfcs/2024-06-21-short-links.md b/rfcs/2024-06-21-short-links.md
new file mode 100644
index 000000000..df028a8ff
--- /dev/null
+++ b/rfcs/2024-06-21-short-links.md
@@ -0,0 +1,124 @@
+# Short invitation links
+
+## Problem
+
+Long links look scary and unsafe for many users. While this is a perceived problem, rather than a real one, it hurts adoption.
+
+What is worse, long links do not fit in profile descriptions of other social networks where people might want to advertize their contact addresses.
+
+The current link size limitation is also the reason for not including PQ KEM keys into invitation links and addresses, postponing the moment when PQ-resistant encryption kicks in - if we include PQ KEM key into the link, the QR code will not be scannable.
+
+Additionally, if we store short links, they can also include chat preferences and public profile data.
+
+## Solution
+
+MITM-resistant link shortening.
+
+Instead of generating the random address that would resolve into the link - doing so would create the possibility of MITM by the server hosting this link - we can use private key as the link ID that will be passed to the accepting party, and the hash of the public key as ID for the server - the accepting party would present this key itself as ID and it will also be used for server to client encryption (see Protocol below). HKDF will be used to derive symmetric key from private key and used in secret_box together with random nonce (to allow replacing data with the same key but with a different nonce - nonce will be sent to the server too). secret_box construction is authenticated encryption, so it would protect from MITM.
+
+The proposed syntax:
+
+```abnf
+shortConnectionRequest = connectionScheme "/" connReqType "#/" smpServer "/" linkHash
+connReqType = %s"invitation" / %s"contact"
+connectionScheme = (%s"https://" clientAppServer) / %s"simplex:"
+clientAppServer = hostname [ ":" port ]
+  ; client app server, e.g. simplex.chat
+smpServer = serverIdentity "@" srvHosts [":" port] ; no smp:// prefix, no escaping
+srvHosts = <hostname> ["," srvHosts] ; RFC1123, RFC5891
+linkHash = <base64url encoded SHA256 or SHA512 hash of the original link>
+```
+
+If SMP server supports pages, its name can be used as clientAppServer, without repeating it after #, for a shorter link.
+
+Example link:
+
+```
+https://simplex.chat/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im/abcdefghij0123456789abcdefghij0123456789abc=
+```
+
+This link has the length of ~136 characters (256 bits), which is shorter than the full contact address (~310 characters) and much shorter than invitation links (~528 characters) even without post-quantum keys added to them.
+
+This size can be further reduced by
+- use server domain in the link.
+- do not include onion address, as the connection happens via proxy anyway, if it's untrusted server.
+- not pinning server TLS certificate - the downside here is that while the attack that compromises TLS will not be able to substitute the link (because it's hash will not match), it will be able to intercept and to block it.
+- using shorter hash, e.g. SHA128 - reducing the collision resistance.
+
+If the server is known, the client could use it's hash and onion address, otherwise it could trust the proxy to use any existing session with the same hostname or to accept the risk of interception - given that there is no risk of substitution.
+
+With the first two of these "improvements" the link could be ~122 characters:
+
+```
+https://smp8.simplex.im/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@/abcdefghij0123456789abcdefghij0123456789abc
+```
+
+If onion address is preserved the link will be ~184 characters (won't fit in Twitter 160 characters bio):
+
+```
+https://smp8.simplex.im/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion/abcdefghij0123456789abcdefghij0123456789abc
+```
+
+If we implement it, the request to resolve the link would be made via proxied SMP command (to avoid the direct connection between the client and the recipient's server).
+
+Pros:
+- a bit shorter link.
+- possibility to include post-quantum keys into the full link keeping the same shortened link size.
+- possibility to include chat profile of contact or group, and preferences, for a much better connection experience, and to show this information when the link sent in the conversation (clients can resolve them automatically, without connecting - it can be resolved by the sending clients).
+- server will not have access to the link.
+
+Cons:
+- protocol complexity.
+- observers can access the link content, so for 1-time invitation we should only include permissions and not profile.
+
+Pros are a huge improvement of UX of connecting both within and from outside of the app (e.g., link can be resolved even before creating chat profile, as part of the onboarding).
+
+## Protocol
+
+To support short links, the SMP servers would provide a simple key-value store enabled by three additional commands: `WRT`, `CLR` and `READ`
+
+`WRT` command is used to store and to update values in the store. The size of the value is limited by the same size as sent messages (or, possibly, smaller - as connection information size used in confirmation messages) - the clients would use this fixed size irrespective of the content. `WRT` command will be sent with the data blob ID in the transaction entityId field, public authorization key used to authorize `WRT` and `CLR` commands (subsequent WRT commands to the existing key must use the same key), and the data blob.
+
+`CLR` command must use with the same entity ID and must be authorized by the same key.
+
+`READ` command must use the ID which hash would be equal of the ID used to create the data blob, and this ID would also be used as public authorization
+
+## Algorithm to store and to retrieve data blob.
+
+**Store data blob**
+
+- the data blob owner generates X25519 key pair: `(k, pk)`.
+- private key `pk` will be included in the short link shared with the other party (only base64url encoded key bytes, not X509 encoding).
+- `HKDF(pk)` will be used to encrypt the link data with secret_box before storing it on the server.
+- the hash of public key `sha256(k)` will be used as ID by the owner to store and to remove the data blob (`WRT` and `CLR` commands).
+
+**Retrieve data blob**
+
+- the sender uses the public key `k` derived from the private key `pk` included in the link as entity ID to retrieve data blob (the server will compute the ID used by the owner as `sha256(k)` and will be able to look it up). This provides the quality that the traffic of the parties has no shared IDs inside TLS. It also means that unlike message queue creation, the ID to retrieve the blob was never sent to the blob creator, and also is not known to the server in advance (the second part is only an observation, in itself it does not increase security, as server has access to an encrypted blob anyway).
+- note that the sender does not authorize the request to retrieve the blob, as it would not increase security unless a different key is used to authorize, and adding a key would increase link size.
+- server session keys with the sender will be `(sk, spk)`, where `sk` is public key shared with the sender during session handshake, and `spk` is the private key known only to the server.
+- this public key `k` will also be combined with server session key `spk` using `dh(k, spk)` to encrypt the response, so that there is no ciphertext in common in sent and received traffic for these blobs. Correlation ID will be used as a nonce for this encryption.
+- having received the blob, the client can now decrypt it using secret_box with `HKDF(pk)`.
+
+Using the same key as ID for the request, and also to additionally encrypt the response allows to use a single key in the link, without increasing the link size.
+
+## Threat model
+
+**Compromised SMP server**
+
+can:
+- delete link data.
+- hide link selectively from some requests.
+
+cannot:
+- undetectably replace link data.
+- access unencrypted link data, whether it was or was not accessed by the accepting party.
+- observe IP addresses of the users accessing link data.
+
+**Passive observer who observed short link**:
+
+can:
+- access original unencrypted link data
+
+cannot:
+- replace or delete the link data
diff --git a/rfcs/2024-09-05-queue-storage.md b/rfcs/2024-09-05-queue-storage.md
new file mode 100644
index 000000000..9b67cc4cf
--- /dev/null
+++ b/rfcs/2024-09-05-queue-storage.md
@@ -0,0 +1,81 @@
+# Storage considerations for SMP queues
+
+See [Short invitation links](./2024-06-21-short-links.md).
+
+## Problem
+
+1) queue records are created permanently, until the clients delete them.
+
+2) clients only delete queue records based on some user action, pending connections do not expire.
+
+While part 2 should be improved in the client, indefinite storage of queue records becomes a much bigger issue if each of them would result in a permanent storage of 4-16kb blob in server memory, without server-side expiration for short invitation links.
+
+## Possible solutions
+
+1) Add some queue timestamp, e.g. queue creation date, to expire unsecured queues after say 3 weeks.
+
+The problem with this approach is that contact addresses are also unsecured queues, and they should not be expired.
+
+We could set really large expiration time, and require that clients "update" the unsecured queues they need at least every 1-2 years, but it would not solve the problem of storing a large number of blobs in the server memory for unused/abandoned 1-time invitations.
+
+2) Do not store blobs in memory / append-only log, and instead use something like RocksDB. While it may be a correct long term solution, it may be not expedient enough at the current POC stage for this feature. Also, the lack of expiration is wrong in any case and would indefinitely grow server storage.
+
+3) Add flag allowing the server to differentiate permanent queues used as contact addresses, also using different blob sizes for them. In this case, messaging queues will be expired if not secured after 3 weeks, and contact address queues would be expired if not "updated" by the owner within 2 years.
+
+Probably all three solutions need to be used, to avoid creating a non-expiring blob storage in memory, as in case too many of such blobs are created it would not be possible to differentiate between real users and resource exhaustion attacks, and unlike with messages, they won't be expiring too.
+
+Servers already can differentiate messaging queues and contact address queues, if they want to:
+- with the old 4-message handshake, the confirmation message on a normal queue was different, and also KEY command was eventually used.
+- with the fast 2-message handshake, while the confirmation message has the same syntax, and the differences are inside encrypted envelope, the client still uses SKEY command.
+- in both cases, the usual messaging queues are secured, and contact addresses are not, so this difference is visible in the storage as well (although it is not easy to differentiate between abandoned 1-time invitations and contact addresses).
+
+Differentiating these queues can also allow different message retention times - e.g., the queues for contact addresses could have bigger size, but have lower message retention time.
+
+## Proposed solution
+
+1. Add queue updated_at date into queue records. While it adds some metadata, it seems necessary to manage retention and quality of service. It will not include exact time, only date, and the time of creation will be replaced by the time of any update - queue secured, a message is sent, or queue owner subscribes to the queue. To avoid the need to update store log on every message this information can be appended to store log on server termination. Or given that only one update per day is needed it may be ok to make these updates as they happen (temporarily making the sequence and time of these events available in storage).
+
+2. Add flag to indicate the queue usage - messaging queue or queue for contact address connection requests. This would result in different queue size and different retention policy for queue and its messages. We already have "sender can secure flag" which is, effectively, this flag - contact address queues are never secured. So this does not increase stored metadata in any way.
+
+## Possible changes to short links
+
+This is a design considerations and a concept, not a design yet.
+
+Instead of implementing a generic blob storage that can be used as an attack vector, and adds additional failure point (another server storing blob that is necessary to connect to the queue on the current server), but instead adds an extended queue information blobs, most of which could be dropped without the loss of connectivity, so that the attack can be mitigated by deleting these blobs without users losing the ability to connect, as long as the queue and minimal extended information is retained.
+
+So, to make the connection there need to be these elements:
+
+- queue server and queue ID - mandatory part, that can be included in short link
+- SMP key - mandatory part for all queues. We are considering initializing ratchets earlier for contact addresses, and include ratchet keys and pre-keys into queue data as well, but it is out of scope here.
+- Ratchet keys - mandatory part for 1-time invitation that won't fit in short link.
+- PQ key - optional part that can be stored with addresses if ratchet keys are added and with 1-time invitations.
+- App blobs - chat preferences for 1-time invitation links and profile information for contact addresses.
+
+So rather that storing one blob with a large address inside it, not associated with the queue, increasing probability of failure and reducing our ability to mitigate resource exhaustion, we could store extended blobs associated with the queues.
+
+Also, we need the address shared with the sender (party accepting the connection) to be short. We could use a similar approach that was proposed for data blobs, using a single random seed per queues to derive multiple keys and IDs from it. For example:
+
+1. The queue owner:
+  - generates Ed25529 key pair `(sk, spk)` and X25519 key pair `(dhk, dhpk)` to use with the server, same as now sent in NEW command.
+  - generates queue recipient ID (this ID can still be server-generated).
+  - generates X25519 key pair `(k, pk)` to use with the accepting party.
+  - derives from `k`:
+    - sender ID.
+    - symmetric key for authenticated encryption of blobs.
+  - `k` will be used as short link.
+2. All other data from the invitation can be included in queue creation request and be associated with the queue as 1-3 blobs with different priority:
+  - ratchet keys - it will have a small size, so only this blob cannot be removed, while other blobs can be removed in case of resource exhaustion.
+  - PQ keys - optional blob.
+  - conversation preferences and profile - can be removed depending on creation time, e.g. all new blobs can be removed.
+
+The algorithm used to derive key and ID from `k` needs to be cryptographically secure, e.g. it could be some KDF or ChaCha DRG initialized with `k` as seed, TBC.
+
+So, coupling blob storage with messaging queues has these pros/cons:
+
+Cons:
+- no additional layer of privacy - the server used for connection is visible in the link, even after the blobs are removed from the server.
+
+Pros:
+- no additional point of failure in the connection process - the same server will be used to retrieve necessary blobs as for connection.
+- queue blobs of messaging blobs will be automatically removed once the queue is secured or expired, without additional request from the recipient - reducing the storage and the time these blobs are available.
+- queue blobs for contact addresses will be structured and some of the large blobs can be removed in case of resource exhaustion attack (and recreated by the client if needed), with the only downside that PQ handshake will be postponed (which is the case now) and profile will not be available at a point of connection.
diff --git a/rfcs/2024-09-09-smp-blobs.md b/rfcs/2024-09-09-smp-blobs.md
new file mode 100644
index 000000000..be990f09c
--- /dev/null
+++ b/rfcs/2024-09-09-smp-blobs.md
@@ -0,0 +1,80 @@
+# Blob extensions for SMP queues
+
+Evolution of the design for short links, see [here](./2024-06-21-short-links.md) and [here](./2024-09-05-queue-storage.md).
+
+## Problems
+
+Allow storing extended information with SMP queues to improve UX and security of making connections:
+- short invitation links and contact addresses.
+- PQ encryption from the first message.
+- present user profile with chat preferences and welcome message when the public address link is scanned.
+
+## Design
+
+1. Queue creation/update date is already added to server persistence, allowing to expire queues and blobs, depending on their usage.
+2. Add "queue type" metadata to NEW command to indicate whether messaging queue is used as public address or as messaging queue (see previous docs on why it doesn't change threat model). While at the moment it would match sndSecure flag there may be future scenarios when they diverge. Initially only "invitation" and "contact" types will be supported.
+3. Prohibit sndSecure flag for "contact" queues, prohibit securing contact queues.
+4. Add "queue blobs" to NEW command:
+  - blob0: ratchetKeys up to N0 bytes - priority 0, can't be removed by the server, only in "invitation"
+  - blob1: PQ key up to N1 bytes - priority 1, can be removed by the server, only used in "invitation"
+  - blob2: Application data up to N2 bytes - priority 2, can be removed by the server.
+5. Add linkId to NEW command
+6. linkId and blobs will be removed when queue is secured.
+7. Add recipient command to remove/upsert blob2 for contact queues.
+8. Add sender command to retrieve blobs.
+
+## Protocol
+
+### Creating a queue:
+
+The queue owner:
+- generates Ed25529 key pair `(sk, spk)` and X25519 key pair `(dhk, dhpk)` to use with the server, same as now. `sk` and `dhk` will be sent in NEW command.
+- generates X25519 key pair `(k, pk)` to use with the accepting party to encrypt queue messages.
+- derives from `k` using HKDF:
+- symmetric key `bk` for authenticated encryption of blobs.
+- `linkId`, will be sent in NEW command.
+- `k` will be used as short link.
+- sends NEW command.
+
+NEW command syntax:
+
+```abnf
+create = %s"NEW " linkId queueType recipientAuthPublicKey recipientDhPublicKey
+                  basicAuth subscribe sndSecure [ "0" blob0 ] [ "1" blob1 ] [ "2" blob2 ] 
+queueType = %s"I" / %s "C" ; new parameter
+linkId = length *OCTET ; new parameter,
+                        ; can be empty in which case blobs won't be allowed
+blob0 = word16 *OCTET ; new parameter, encrypted ratchet keys,
+                      ; including nonce and auth tag
+blob1 = word16 *OCTET ; new parameter, encrypted PQ key
+blob2 = word16 *OCTET ; new parameter, encrypted application data
+```
+
+SET - command to update queue blobs (recipientId is used as entity ID):
+
+```abnf
+set = %s"SET " linkId [ "2" blob2 ] ; passing empty blob removes it
+linkId ; updated (or the same) linkId, can be empty to remove blobs
+        ; allows to change the address without removing the queue / changing blobs
+        ; (e.g., to avoid losing the messages).
+```
+
+### Sending messages to the queue
+
+GET - command to get queue blobs (linkId is used as entity ID):
+
+```abnf
+get = %s"GET"
+```
+
+Response to GET:
+
+```abnf
+blobs = %s"BLOB" senderId [ "0" blob0 ] [ "1" blob1 ] [ "2" blob2 ]
+```
+
+As blobs are retrieved using a separate linkId, once blobs are removed it will be impossible to find senderId from short link - it is a threat model improvement. Once server storage is compacted, it will be impossible to find queue related to the link even with the access to server data (unless server preserves the data).
+
+### Possible privacy improvement
+
+We could only allow unauthorized GET and authorized SET commands for long-term "contact" queues, and return BLOB in response to SKEY (or require that GET is authorized) - so that only the person who secures the queue will get access to data blobs. This way it ensures that the parties transmitting the invitation links cannot retrieve their content without the sender noticing it.
diff --git a/rfcs/2024-09-10-private-rendezvous.md b/rfcs/2024-09-10-private-rendezvous.md
new file mode 100644
index 000000000..744596ea6
--- /dev/null
+++ b/rfcs/2024-09-10-private-rendezvous.md
@@ -0,0 +1,26 @@
+# Private rendezvous protocol
+
+## Problem
+
+Our current handshake protocol is open to this attack: whoever observes the link exchange, knows on which server connection is being made, and if the traffic on this server is observed, then it can confirm communication between parties. Further, even with the [last proposal](./2024-09-09-smp-blobs.md#possible-privacy-improvement), having real-time access to the server data allows to establish the exact messaging queue that is used to send messages.
+
+## Solution
+
+We could make the initial link exchange more private by making it harder for any observer to discover which server will be used for messaging by hiding this information from the server that hosts the initial link.
+
+Preliminary, the protocol could be the following:
+
+1. Connection initiator stores 224-256 bytes of encrypted connection link on a rendezvous server (link contains server host and linkId on another messaging server, not a rendezvous one).
+
+2. Rendezvous server adds these links to buckets, up to 64 links per bucket. Bucket ID is the timestamp when the bucket was created + a sequential bucket number, in case more than one bucket is created per second.
+
+3. The server responds to the link creator with a bucket ID where this link was added. That bucket ID is its timestamp + a number prevents server "fingerprinting" clients and using say one bucket for each client. If timestamp is different or a bucket number within this timestamp is too large, the client can refuse to use it, depending on the client settings.
+
+4. The initiating party will pass to the accepting party the rendezvous server host, the hash of this bucket ID (bucket link) and the passphrase to derive the key from. The initiating party has an option to pass a link and passphrase via two channels - in which case the link will only contain the bucket ID.
+
+5. The accepting party would then request the bucket via its ID hash (the server would store hashes to be able to look up - hash is used to prevent showing time in the link) and attempt to decrypt all contained links using the provided key.
+The accepting party then will continue the connection via the decrypted link.
+
+This obviously does not protect accepting party from the initiating party, if it can choose rendezvous server it controls. It also does not protect from the malicious rendezvous server that would collaborate with link observers. I think reunion doesn’t protect from it too.
+
+But it does protect connection from whoever observes the link, particularly if this link only contains the bucket and the key is passed separately, via some other channel.

From 856137b763ab0e68fd2ac6e74a85852c5c261476 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 24 Sep 2024 12:29:44 +0100
Subject: [PATCH 118/195] =?UTF-8?q?rf=D1=81:=20efficient=20message=20stora?=
 =?UTF-8?q?ge=20(#1295)?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* rfs: efficient message storage

* typos

* update
---
 rfcs/2021-09-01-smp-message-storage.md | 179 +++++++++++++++++++++++++
 1 file changed, 179 insertions(+)
 create mode 100644 rfcs/2021-09-01-smp-message-storage.md

diff --git a/rfcs/2021-09-01-smp-message-storage.md b/rfcs/2021-09-01-smp-message-storage.md
new file mode 100644
index 000000000..66905f5e5
--- /dev/null
+++ b/rfcs/2021-09-01-smp-message-storage.md
@@ -0,0 +1,179 @@
+# SMP server message storage
+
+## Problem
+
+Currently SMP servers store all queues in server memory. As the traffic grows, so does the number of undelivered messages. What is worse, Haskell is not avoiding heap fragmentation when messages are allocated and then de-allocated - undelivered messages use ByteString and GC cannot move them around, as they use pinned memory.
+
+## Possible solutions
+
+### Solution 1: solve only GC fragmentation problem
+
+Move from ByteString to some other primitive to store messages in memory long term, e.g. ShortByteString, or manage allocation/de-allocation of stored messages manually in some other way.
+
+Pros: the simplest solution that avoids substantial re-engineering of the server.
+
+Cons:
+- not a long term solution, as memory growth still has limits.
+- may be ineffective, as it introduces additional copying of bytes.
+
+### Solution 2: move message storage to hard drive
+
+Use files or RocksDB to store messages.
+
+Pros:
+- much lower memory usage.
+- no message loss in case of abnormal server termination (important until clients have delivery redundancy).
+- this is a long term solution, and at some point it might need to be done anyway.
+
+Cons:
+- substantial re-engineering costs and risks.
+- metadata privacy. Currently we only save undelivered messages when server is restarted, with this approach all messages will be stored for some time. this argument is limited, as hosting providers of VMs can make memory snapshots too, on the other hand they are harder to analyze than files. On another hand, with this approach messages will be stored for a shorter time.
+
+#### RocksDB and other key-value stores
+
+The downside of any key-value stores is that they don't seem to have efficient primitives for sequential delivery. While sequential delivery can be modelled with linked lists, they would require 1 key insert (on send), 3 key updates (1 update to update queue data on send, 1 update of the last message to point to the next, 1 update on delivery or message expiration) and 1 key deletion (on delivery or message expiration) for each delivered message.
+
+This might result in substantial write amplification and compacting costs.
+
+In general, tree structures that are efficient for quick lookups and updates, given approximately fixed value size, are inefficient for modelling queues.
+
+#### Files
+
+The upside of files is that they are well suited for sequential delivery and don't result in the same churn, with careful design, as trees do.
+
+The downside of filesystem is that it does not scale well with the large number of files in a folder, so queues will have to be spread across multiple folders, following tree-like structure.
+
+I could not find an available library that efficiently models sequential delivery in highly concurrent environment.
+
+A possible design could be the following.
+
+##### Queue folder and files
+
+Each message queue is stored in its own folder (see below on folder locations). Folder would contain these files:
+
+- `messages.abcd.log` - the file that is used to read messages from, sequentially
+- `messages.efgh.log` - the optional file that is used to write messages, in case it is different from read file.
+- `queue.log` - append-only file where the last line represents the current queue state
+- `queue.timestamp.log` - previous states of queue.log file
+
+Each line in "queue.log" file has this syntax
+
+```abnf
+queueLogLine =
+    %s"read_file=" base64
+    %s"read_msg=" digits
+    %s"read_byte=" digits
+    %s"write_file=" base64
+    %s"write_msg=" digits
+```
+
+When queue is first requested by the server:
+
+```c
+if queue folder exists:
+    read queue state from last line of queue.log
+    if queue.log contained more than one line: // compaction
+        copy queue.log to queue.timestamp.log
+        write one line queue state to queue.log
+else:
+    create queue folder
+    create messages.abcd.log (abcd is some random string)
+    read_msg = 0
+    read_byte = 0
+    create queue.log with one line: "read_file=abcd read_msg=0 read_byte=0 write_files=abcd write_msg=0"
+open read_file in ReadMode and seek to read_byte position
+nextReadByte = read_byte
+nextReadMsg = read_msg
+open write_file in AppendMode
+```
+
+When message is added to the queue (assumes that queue state is loaded to server memory, if not the previous section will be done first):
+
+```c
+if write_msg > max_queue_messages:
+    return quota error
+else if write_msg = max_queue_messages:
+    add quota_exceeded message to write_file
+    update queue state: write_msg += 1
+    append updated queue state to queue.log
+else ]
+    // It is required that `max_queue_messages < max_file_messages`,
+    // so that we never need more than one additional write file.
+    if write_msg >= max_file_messages: // queue file rotation
+        create messages.efgh.log // efgh is some random string
+        update queue state: write_file=efgh write_msg=0 // read file remains the same as it was
+        append updated queue state to queue.log
+        copy queue.log to queue.timestamp.log
+        // `old` needs to be defined to limit the number and storage duration,
+        // preserving not more than N files, and not more than M days files, "and then some"
+        // (that is if the queue has high churn, we have file from M days before in any case, for any debugging).
+        delete `old` `queue.timestamp.log` files
+        write one line queue state to queue.log // compaction
+
+    add message to write_file
+    update queue state: write_msg += 1
+    append updated queue state to queue.log
+```
+
+The above algorithm assumes `max_queue_messages < than max_file_messages`, so that we never need more than one write file.
+
+When message is delivered, it is simply read from the read queue, queue state does not change yet:
+
+```c
+if nextReadMsg > read_msg:
+    deliver cached message, no need to read it again
+else
+    read message from read_file handle
+    nextReadMsg = read_msg + 1
+    nextReadByte = current position in file
+```
+
+When message delivery is acknowledged, the read queue needs to be advanced, and possibly switched to read from the current write_queue:
+
+```c
+if nextReadByte == read_byte:
+    return error // nothing was delivered
+else if nextReadByte = EOF:
+    // end of file is reached, possibly some other condition,
+    // but it should allow changing max_file_messages on server restart
+    currReadFile = read_file
+    read_file = write_file
+    read_msg = 0
+    read_byte = 0
+    append updated queue state to queue.log
+    delete currReadFile
+else
+    read_msg += 1
+    read_byte = nextReadByte
+    // `seek` should not be necessary, as the handle is already at nextReadByte position here
+    // seek to read_byte
+    append updated queue state to queue.log
+```
+
+The above algorithm delegates the problem of compaction and fragmentation management to file system, that is very optimized for such scenarios.
+
+Also, read and write files will grow to almost a constant size, so the space they used may be re-used.
+
+An important consideration is that writes to queue.log and message.log files and queue state modifications have to be sequential, without concurrency - it can be managed with the usual locks.
+
+##### Queue folders structure
+
+Most Linux systems use EXT4 filesystem where the file lookup time scales linearly to the number of files. While alternatives with logarithmic lookup time exist (XFS), they may be very complex to configure on the existing systems.
+
+So storing all queue folders in one folder won't scale.
+
+To solve this problem we could use recipient queue ID in base64url format not as a folder name, but as a folder path, splitting it to path fragments of some length. The number of fragments can be configurable and migration to a different fragment size can be supported as the number of queues on a given server grows.
+
+Currently, queue ID is 24 bytes random number, thus allowing 2^192 possible queue IDs. If we assume that a server must hold 1b queues, it means that we have ~2^162 possible addresses for each existing queue. 24 bytes in base64 is 32 characters that can be split into say 8 fragments with 4 characters each, so that queue folder path for queue with ID `abcdefghijklmnopqrstuvwxyz012345` would be:
+
+`/var/opt/simplex/messages/abcd/efgh/ijkl/mnop/qrst/uvwx/yz01/2345`
+
+The maximum theoretic number of the folders on the 1st level is 64^4, or 2^24 ~ 16m - this is probably still a large number of subfolders for EXT4. Given that addresses are random, all the possible combinations in the first folder can be used with a large number of queues.
+
+So we could use an unequal split of path, two letters each and the last being long:
+
+`/var/opt/simplex/messages/ab/cd/ef/ghijklmnopqrstuvwxyz012345`
+
+The first three levels in this case can have 4096 subfolders each, and it gives 68b possible subfolders (64^2^3), so the last level will be sparse in case of 1b queues on the server. So we could make it 4 levels with 2 letters to never think about it, accounting for a large variance of the random numbers distribution:
+
+`/var/opt/simplex/messages/ab/cd/ef/gh/ijklmnopqrstuvwxyz012345`

From 4268b90763c58358809a3ea7dd8bc7d78eeb3077 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 24 Sep 2024 12:34:46 +0100
Subject: [PATCH 119/195] 6.0.5.0

---
 CHANGELOG.md    | 6 ++++++
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 3 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 21e752c68..18a42b791 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,9 @@
+# 6.0.5
+
+SMP agent:
+- support generic SOCKS proxy (without isolate-by-auth).
+- reduce max message sizes
+
 # 6.0.4
 
 SMP server:
diff --git a/package.yaml b/package.yaml
index da0ec8a9c..39054ec77 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.4.0
+version: 6.0.5.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index c910e2ea3..33743c8a4 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.4.0
+version:        6.0.5.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 8e7f3f7b271f8a6a4ae495973fb65fbcb31cb37a Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 24 Sep 2024 16:16:52 +0100
Subject: [PATCH 120/195] agent: return full argument with batched results
 (#1332)

---
 src/Simplex/Messaging/Agent/Client.hs | 28 +++++++++++++++------------
 1 file changed, 16 insertions(+), 12 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 82d5d2785..6737a3155 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1419,7 +1419,7 @@ subscribeQueues c qs = do
     checkQueue rq = do
       prohibited <- liftIO $ hasGetLock c rq
       pure $ if prohibited then Left (rq, Left $ CMD PROHIBITED "subscribeQueues") else Right rq
-    subscribeQueues_ :: Env -> TVar (Maybe SessionId) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
+    subscribeQueues_ :: Env -> TVar (Maybe SessionId) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses RcvQueue SMPClientError ())
     subscribeQueues_ env session smp qs' = do
       let (userId, srv, _) = transportSession' smp
       atomically $ incSMPServerStat' c userId srv connSubAttempts $ length qs'
@@ -1450,31 +1450,33 @@ activeClientSession c tSess sessId = sameSess <$> tryReadSessVar tSess (smpClien
       Just (Right (SMPConnectedClient smp _)) -> sessId == sessionId (thParams smp)
       _ -> False
 
-type BatchResponses e r = NonEmpty (RcvQueue, Either e r)
+type BatchResponses q e r = NonEmpty (q, Either e r)
 
-sendTSessionBatches :: forall q r. ByteString -> (q -> RcvQueue) -> (SMPClient -> NonEmpty q -> IO (BatchResponses SMPClientError r)) -> AgentClient -> [q] -> AM' [(RcvQueue, Either AgentErrorType r)]
+-- Please note: this function does not preserve order of results to be the same as the order of arguments,
+-- it includes arguments in the results instead.
+sendTSessionBatches :: forall q r. ByteString -> (q -> RcvQueue) -> (SMPClient -> NonEmpty q -> IO (BatchResponses q SMPClientError r)) -> AgentClient -> [q] -> AM' [(q, Either AgentErrorType r)]
 sendTSessionBatches statCmd toRQ action c qs =
   concatMap L.toList <$> (mapConcurrently sendClientBatch =<< batchQueues)
   where
     batchQueues :: AM' [(SMPTransportSession, NonEmpty q)]
     batchQueues = do
       mode <- getSessionMode c
-      pure . M.assocs $ foldl' (batch mode) M.empty qs
+      pure . M.assocs $ foldr (batch mode) M.empty qs
       where
-        batch mode m q =
+        batch mode q m =
           let tSess = mkSMPTSession (toRQ q) mode
            in M.alter (Just . maybe [q] (q <|)) tSess m
-    sendClientBatch :: (SMPTransportSession, NonEmpty q) -> AM' (BatchResponses AgentErrorType r)
+    sendClientBatch :: (SMPTransportSession, NonEmpty q) -> AM' (BatchResponses q AgentErrorType r)
     sendClientBatch (tSess@(_, srv, _), qs') =
       tryAgentError' (getSMPServerClient c tSess) >>= \case
-        Left e -> pure $ L.map ((,Left e) . toRQ) qs'
+        Left e -> pure $ L.map (,Left e) qs'
         Right (SMPConnectedClient smp _) -> liftIO $ do
           logServer' "-->" c srv (bshow (length qs') <> " queues") statCmd
           L.map agentError <$> action smp qs'
           where
             agentError = second . first $ protocolClientError SMP $ clientServer smp
 
-sendBatch :: (SMPClient -> NonEmpty (SMP.RcvPrivateAuthKey, SMP.RecipientId) -> IO (NonEmpty (Either SMPClientError ()))) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
+sendBatch :: (SMPClient -> NonEmpty (SMP.RcvPrivateAuthKey, SMP.RecipientId) -> IO (NonEmpty (Either SMPClientError ()))) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses RcvQueue SMPClientError ())
 sendBatch smpCmdFunc smp qs = L.zip qs <$> smpCmdFunc smp (L.map queueCreds qs)
   where
     queueCreds RcvQueue {rcvPrivateKey, rcvId} = (rcvPrivateKey, rcvId)
@@ -1603,13 +1605,15 @@ enableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} notifierKey rcvNtf
   withSMPClient c rq "NKEY <nkey>" $ \smp ->
     enableSMPQueueNotifications smp rcvPrivateKey rcvId notifierKey rcvNtfPublicDhKey
 
-enableQueuesNtfs :: AgentClient -> [(RcvQueue, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey)] -> AM' [(RcvQueue, Either AgentErrorType (SMP.NotifierId, SMP.RcvNtfPublicDhKey))]
+type RcvQueueNtf = (RcvQueue, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey)
+
+enableQueuesNtfs :: AgentClient -> [RcvQueueNtf] -> AM' [(RcvQueueNtf, Either AgentErrorType (SMP.NotifierId, SMP.RcvNtfPublicDhKey))]
 enableQueuesNtfs = sendTSessionBatches "NKEY" fst3 enableQueues_
   where
     fst3 (x, _, _) = x
-    enableQueues_ :: SMPClient -> NonEmpty (RcvQueue, SMP.NtfPublicAuthKey, 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.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey) -> (SMP.RcvPrivateAuthKey, SMP.RecipientId, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey)
+    enableQueues_ :: SMPClient -> NonEmpty RcvQueueNtf -> IO (NonEmpty (RcvQueueNtf, Either (ProtocolClientError ErrorType) (SMP.NotifierId, RcvNtfPublicDhKey)))
+    enableQueues_ smp qs' = L.zipWith (,) qs' <$> enableSMPQueuesNtfs smp (L.map queueCreds qs')
+    queueCreds :: RcvQueueNtf -> (SMP.RcvPrivateAuthKey, SMP.RecipientId, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey)
     queueCreds (RcvQueue {rcvPrivateKey, rcvId}, notifierKey, rcvNtfPublicDhKey) = (rcvPrivateKey, rcvId, notifierKey, rcvNtfPublicDhKey)
 
 disableQueueNotifications :: AgentClient -> RcvQueue -> AM ()

From 1f67b403deff984c83231ac9e7d482adb66fe76b Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Wed, 25 Sep 2024 10:55:45 +0100
Subject: [PATCH 121/195] agent: function to get multiple work items (#1330)

---
 src/Simplex/Messaging/Agent/Client.hs       | 28 +++++++++++++++++++-
 src/Simplex/Messaging/Agent/Store/SQLite.hs | 29 ++++++++++++++-------
 2 files changed, 46 insertions(+), 11 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 6737a3155..88d1eeac2 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -115,6 +115,7 @@ module Simplex.Messaging.Agent.Client
     hasWorkToDo,
     hasWorkToDo',
     withWork,
+    withWorkItems,
     agentOperations,
     agentOperationBracket,
     waitUntilActive,
@@ -185,7 +186,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.Either (isRight, partitionEithers)
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (deleteFirstsBy, foldl', partition, (\\))
+import Data.List (deleteFirstsBy, find, foldl', partition, (\\))
 import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
@@ -1813,12 +1814,37 @@ withWork c doWork getWork action =
   withStore' c getWork >>= \case
     Right (Just r) -> action r
     Right Nothing -> noWork
+    -- worker is stopped here (noWork) because the next iteration is likely to produce the same result
     Left e@SEWorkItemError {} -> noWork >> notifyErr (CRITICAL False) e
     Left e -> notifyErr INTERNAL e
   where
     noWork = liftIO $ noWorkToDo doWork
     notifyErr err e = atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
 
+withWorkItems :: AgentClient -> TMVar () -> (DB.Connection -> IO (Either StoreError [Either StoreError a])) -> (NonEmpty a -> AM ()) -> AM ()
+withWorkItems c doWork getWork action = do
+  withStore' c getWork >>= \case
+    Right rs -> do
+      let (errs, items) = partitionEithers rs
+      case L.nonEmpty items of
+        Just items' -> action items'
+        Nothing -> do
+          let criticalErr = find workItemError errs
+          forM_ criticalErr $ \ err -> do
+            notifyErr (CRITICAL False) err
+            when (all workItemError errs) noWork
+      unless (null errs) $ atomically $
+        writeTBQueue (subQ c) ("", "", AEvt SAENone $ ERRS $ map (\e -> ("", INTERNAL $ show e)) errs)
+    Left e
+      | workItemError e -> noWork >> notifyErr (CRITICAL False) e
+      | otherwise -> notifyErr INTERNAL e
+  where
+    workItemError = \case
+      SEWorkItemError {} -> True
+      _ -> False
+    noWork = liftIO $ noWorkToDo doWork
+    notifyErr err e = atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
+
 noWorkToDo :: TMVar () -> IO ()
 noWorkToDo = void . atomically . tryTakeTMVar
 {-# INLINE noWorkToDo #-}
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 55f1ab85e..c331c4d44 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -1063,17 +1063,26 @@ getPendingQueueMsg db connId SndQueue {dbQueueId} =
 
 getWorkItem :: Show i => ByteString -> IO (Maybe i) -> (i -> IO (Either StoreError a)) -> (i -> IO ()) -> IO (Either StoreError (Maybe a))
 getWorkItem itemName getId getItem markFailed =
-  runExceptT $ handleErr "getId" getId >>= mapM tryGetItem
+  runExceptT $ handleWrkErr itemName "getId" getId >>= mapM (tryGetItem itemName getItem markFailed)
+
+getWorkItems :: Show i => ByteString -> IO [i] -> (i -> IO (Either StoreError a)) -> (i -> IO ()) -> IO (Either StoreError [Either StoreError a])
+getWorkItems itemName getIds getItem markFailed =
+  runExceptT $ handleWrkErr itemName "getIds" getIds >>= mapM (tryE . tryGetItem itemName getItem markFailed)
+
+tryGetItem :: Show i => ByteString -> (i -> IO (Either StoreError a)) -> (i -> IO ()) -> i -> ExceptT StoreError IO a
+tryGetItem itemName getItem markFailed itemId = ExceptT (getItem itemId) `catchStoreError` \e -> mark >> throwE e
   where
-    tryGetItem itemId = ExceptT (getItem itemId) `catchStoreErrors` \e -> mark itemId >> throwE e
-    mark itemId = handleErr ("markFailed ID " <> bshow itemId) $ markFailed itemId
-    catchStoreErrors = catchAllErrors (SEInternal . bshow)
-    -- Errors caught by this function will suspend worker as if there is no more work,
-    handleErr :: ByteString -> IO a -> ExceptT StoreError IO a
-    handleErr opName action = ExceptT $ first mkError <$> E.try action
-      where
-        mkError :: E.SomeException -> StoreError
-        mkError e = SEWorkItemError $ itemName <> " " <> opName <> " error: " <> bshow e
+    mark = handleWrkErr itemName ("markFailed ID " <> bshow itemId) $ markFailed itemId
+
+catchStoreError :: ExceptT StoreError IO a -> (StoreError -> ExceptT StoreError IO a) -> ExceptT StoreError IO a
+catchStoreError = catchAllErrors (SEInternal . bshow)
+
+-- Errors caught by this function will suspend worker as if there is no more work,
+handleWrkErr :: ByteString -> ByteString -> IO a -> ExceptT StoreError IO a
+handleWrkErr itemName opName action = ExceptT $ first mkError <$> E.try action
+  where
+    mkError :: E.SomeException -> StoreError
+    mkError e = SEWorkItemError $ itemName <> " " <> opName <> " error: " <> bshow e
 
 updatePendingMsgRIState :: DB.Connection -> ConnId -> InternalId -> RI2State -> IO ()
 updatePendingMsgRIState db connId msgId RI2State {slowInterval, fastInterval} =

From 81fcdf8ac9098d90fc660f3a4b4a41e26da27c6e Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Wed, 25 Sep 2024 15:00:06 +0400
Subject: [PATCH 122/195] ntf: batch smp worker command processing (#1331)

* ntf: refactor smp worker (separate command processing into steps)

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
---
 src/Simplex/Messaging/Agent/Client.hs         |  46 +++--
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |   4 +-
 .../Messaging/Agent/NtfSubSupervisor.hs       | 195 ++++++++++++------
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  28 +--
 4 files changed, 178 insertions(+), 95 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 88d1eeac2..f578358f1 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -56,8 +56,10 @@ module Simplex.Messaging.Agent.Client
     secureQueue,
     secureSndQueue,
     enableQueueNotifications,
+    EnableQueueNtfReq (..),
     enableQueuesNtfs,
     disableQueueNotifications,
+    DisableQueueNtfReq,
     disableQueuesNtfs,
     sendAgentMessage,
     getQueueInfo,
@@ -257,8 +259,8 @@ import Simplex.Messaging.Protocol
     VersionSMPC,
     XFTPServer,
     XFTPServerWithAuth,
-    pattern NoEntity,
     sameSrvAddr',
+    pattern NoEntity,
   )
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.QueueStore.QueueInfo
@@ -1606,24 +1608,39 @@ enableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} notifierKey rcvNtf
   withSMPClient c rq "NKEY <nkey>" $ \smp ->
     enableSMPQueueNotifications smp rcvPrivateKey rcvId notifierKey rcvNtfPublicDhKey
 
-type RcvQueueNtf = (RcvQueue, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey)
+data EnableQueueNtfReq = EnableQueueNtfReq
+  { eqnrNtfSub :: NtfSubscription,
+    eqnrRq :: RcvQueue,
+    eqnrAuthKeyPair :: C.AAuthKeyPair,
+    eqnrRcvKeyPair :: C.KeyPairX25519
+  }
 
-enableQueuesNtfs :: AgentClient -> [RcvQueueNtf] -> AM' [(RcvQueueNtf, Either AgentErrorType (SMP.NotifierId, SMP.RcvNtfPublicDhKey))]
-enableQueuesNtfs = sendTSessionBatches "NKEY" fst3 enableQueues_
+enableQueuesNtfs :: AgentClient -> [EnableQueueNtfReq] -> AM' [(EnableQueueNtfReq, Either AgentErrorType (SMP.NotifierId, SMP.RcvNtfPublicDhKey))]
+enableQueuesNtfs = sendTSessionBatches "NKEY" eqnrRq enableQueues_
   where
-    fst3 (x, _, _) = x
-    enableQueues_ :: SMPClient -> NonEmpty RcvQueueNtf -> IO (NonEmpty (RcvQueueNtf, Either (ProtocolClientError ErrorType) (SMP.NotifierId, RcvNtfPublicDhKey)))
-    enableQueues_ smp qs' = L.zipWith (,) qs' <$> enableSMPQueuesNtfs smp (L.map queueCreds qs')
-    queueCreds :: RcvQueueNtf -> (SMP.RcvPrivateAuthKey, SMP.RecipientId, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey)
-    queueCreds (RcvQueue {rcvPrivateKey, rcvId}, notifierKey, rcvNtfPublicDhKey) = (rcvPrivateKey, rcvId, notifierKey, rcvNtfPublicDhKey)
+    enableQueues_ :: SMPClient -> NonEmpty EnableQueueNtfReq -> IO (NonEmpty (EnableQueueNtfReq, Either (ProtocolClientError ErrorType) (SMP.NotifierId, RcvNtfPublicDhKey)))
+    enableQueues_ smp qs' = L.zip qs' <$> enableSMPQueuesNtfs smp (L.map queueCreds qs')
+    queueCreds :: EnableQueueNtfReq -> (SMP.RcvPrivateAuthKey, SMP.RecipientId, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey)
+    queueCreds EnableQueueNtfReq {eqnrRq, eqnrAuthKeyPair, eqnrRcvKeyPair} =
+      let RcvQueue {rcvPrivateKey, rcvId} = eqnrRq
+          (ntfPublicKey, _) = eqnrAuthKeyPair
+          (rcvNtfPubDhKey, _) = eqnrRcvKeyPair
+       in (rcvPrivateKey, rcvId, ntfPublicKey, rcvNtfPubDhKey)
 
 disableQueueNotifications :: AgentClient -> RcvQueue -> AM ()
 disableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} =
   withSMPClient c rq "NDEL" $ \smp ->
     disableSMPQueueNotifications smp rcvPrivateKey rcvId
 
-disableQueuesNtfs :: AgentClient -> [RcvQueue] -> AM' [(RcvQueue, Either AgentErrorType ())]
-disableQueuesNtfs = sendTSessionBatches "NDEL" id $ sendBatch disableSMPQueuesNtfs
+type DisableQueueNtfReq = (NtfSubscription, RcvQueue)
+
+disableQueuesNtfs :: AgentClient -> [DisableQueueNtfReq] -> AM' [(DisableQueueNtfReq, Either AgentErrorType ())]
+disableQueuesNtfs = sendTSessionBatches "NDEL" snd disableQueues_
+  where
+    disableQueues_ :: SMPClient -> NonEmpty DisableQueueNtfReq -> IO (NonEmpty (DisableQueueNtfReq, Either (ProtocolClientError ErrorType) ()))
+    disableQueues_ smp qs' = L.zip qs' <$> disableSMPQueuesNtfs smp (L.map queueCreds qs')
+    queueCreds :: DisableQueueNtfReq -> (SMP.RcvPrivateAuthKey, SMP.RecipientId)
+    queueCreds (_, RcvQueue {rcvPrivateKey, rcvId}) = (rcvPrivateKey, rcvId)
 
 sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = do
@@ -1830,11 +1847,12 @@ withWorkItems c doWork getWork action = do
         Just items' -> action items'
         Nothing -> do
           let criticalErr = find workItemError errs
-          forM_ criticalErr $ \ err -> do
+          forM_ criticalErr $ \err -> do
             notifyErr (CRITICAL False) err
             when (all workItemError errs) noWork
-      unless (null errs) $ atomically $
-        writeTBQueue (subQ c) ("", "", AEvt SAENone $ ERRS $ map (\e -> ("", INTERNAL $ show e)) errs)
+      unless (null errs) $
+        atomically $
+          writeTBQueue (subQ c) ("", "", AEvt SAENone $ ERRS $ map (\e -> ("", INTERNAL $ show e)) errs)
     Left e
       | workItemError e -> noWork >> notifyErr (CRITICAL False) e
       | otherwise -> notifyErr INTERNAL e
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 0f179c70c..a550394c1 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -150,6 +150,7 @@ data AgentConfig = AgentConfig
     xftpMaxRecipientsPerRequest :: Int,
     deleteErrorCount :: Int,
     ntfCron :: Word16,
+    ntfBatchSize :: Int,
     ntfSubCheckInterval :: NominalDiffTime,
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
@@ -219,6 +220,7 @@ defaultAgentConfig =
       xftpMaxRecipientsPerRequest = 200,
       deleteErrorCount = 10,
       ntfCron = 20, -- minutes
+      ntfBatchSize = 200,
       ntfSubCheckInterval = nominalDay,
       -- CA certificate private key is not needed for initialization
       -- ! we do not generate these
@@ -259,7 +261,7 @@ data NtfSupervisor = NtfSupervisor
     ntfSMPWorkers :: TMap SMPServer Worker
   }
 
-data NtfSupervisorCommand = NSCCreate | NSCSmpDelete | NSCNtfWorker NtfServer | NSCNtfSMPWorker SMPServer | NSCDeleteSub
+data NtfSupervisorCommand = NSCCreate | NSCSmpDelete | NSCDeleteSub
   deriving (Show)
 
 newNtfSubSupervisor :: Natural -> IO NtfSupervisor
diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
index ad1acae5a..9a949eec4 100644
--- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
+++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
@@ -23,6 +23,7 @@ import Control.Logger.Simple (logError, logInfo)
 import Control.Monad
 import Control.Monad.Reader
 import Control.Monad.Trans.Except
+import Crypto.Random (ChaChaDRG)
 import Data.Bifunctor (first)
 import Data.Either (partitionEithers)
 import Data.Foldable (foldr')
@@ -45,6 +46,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol (NtfSubStatus (..), NtfTknStatus (..), SMPQueueNtf (..))
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Protocol (NtfServer, sameSrvAddr)
+import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow, unlessM)
 import System.Random (randomR)
 import UnliftIO
@@ -71,13 +73,16 @@ partitionErrs :: (a -> ConnId) -> [a] -> [Either AgentErrorType b] -> ([(ConnId,
 partitionErrs f xs = partitionEithers . zipWith (\x -> first (f x,)) xs
 {-# INLINE partitionErrs #-}
 
+ntfSubConnId :: NtfSubscription -> ConnId
+ntfSubConnId NtfSubscription {connId} = connId
+
 processNtfCmd :: AgentClient -> (NtfSupervisorCommand, NonEmpty ConnId) -> AM ()
 processNtfCmd c (cmd, connIds) = do
   logInfo $ "processNtfCmd - cmd = " <> tshow cmd
   let connIds' = L.toList connIds
   case cmd of
     NSCCreate -> do
-      (cErrs, rqSubActions) <- lift $ partitionErrs id connIds' <$> (withStoreBatch c $ \db -> map (getQueueSub db) connIds')
+      (cErrs, rqSubActions) <- lift $ partitionErrs id connIds' <$> withStoreBatch c (\db -> map (getQueueSub db) connIds')
       notifyErrs c cErrs
       logInfo $ "processNtfCmd, NSCCreate - length rqSubs = " <> tshow (length rqSubActions)
       let (ns, rs, css, cns) = partitionQueueSubActions rqSubActions
@@ -99,7 +104,7 @@ processNtfCmd c (cmd, connIds) = do
         createNewSubs rqs = do
           withTokenServer $ \ntfServer -> do
             let newSubs = map (rqToNewSub ntfServer) rqs
-            (cErrs, _) <- lift $ partitionErrs ntfSubConnId newSubs <$> (withStoreBatch c $ \db -> map (storeNewSub db) newSubs)
+            (cErrs, _) <- lift $ partitionErrs ntfSubConnId newSubs <$> withStoreBatch c (\db -> map (storeNewSub db) newSubs)
             notifyErrs c cErrs
             kickSMPWorkers rqs
           where
@@ -111,7 +116,7 @@ processNtfCmd c (cmd, connIds) = do
         resetSubs rqSubs = do
           withTokenServer $ \ntfServer -> do
             let subsToReset = map (toResetSub ntfServer) rqSubs
-            (cErrs, _) <- lift $ partitionErrs ntfSubConnId subsToReset <$> (withStoreBatch' c $ \db -> map (storeResetSub db) subsToReset)
+            (cErrs, _) <- lift $ partitionErrs ntfSubConnId subsToReset <$> withStoreBatch' c (\db -> map (storeResetSub db) subsToReset)
             notifyErrs c cErrs
             let rqs = map fst rqSubs
             kickSMPWorkers rqs
@@ -122,7 +127,6 @@ processNtfCmd c (cmd, connIds) = do
                in sub {smpServer, ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
             storeResetSub :: DB.Connection -> NtfSubscription -> IO ()
             storeResetSub db sub = supervisorUpdateNtfSub db sub (NSASMP NSASmpKey)
-        ntfSubConnId NtfSubscription {connId} = connId
         partitionQueueSubActions ::
           [(RcvQueue, Maybe NtfSupervisorSub)] ->
           ( [RcvQueue], -- new subs
@@ -157,9 +161,9 @@ processNtfCmd c (cmd, connIds) = do
                         NSANtf _ -> (ns, rs, css, subNtfServer : cns)
                 reset = (ns, (rq, sub) : rs, css, cns)
     NSCSmpDelete -> do
-      (cErrs, rqs) <- lift $ partitionErrs id connIds' <$> (withStoreBatch c $ \db -> map (getQueue db) connIds')
+      (cErrs, rqs) <- lift $ partitionErrs id connIds' <$> withStoreBatch c (\db -> map (getQueue db) connIds')
       logInfo $ "processNtfCmd, NSCSmpDelete - length rqs = " <> tshow (length rqs)
-      (cErrs', _) <- lift $ partitionErrs qConnId rqs <$> (withStoreBatch' c $ \db -> map (updateAction db) rqs)
+      (cErrs', _) <- lift $ partitionErrs qConnId rqs <$> withStoreBatch' c (\db -> map (updateAction db) rqs)
       notifyErrs c (cErrs <> cErrs')
       kickSMPWorkers rqs
       where
@@ -167,8 +171,6 @@ processNtfCmd c (cmd, connIds) = do
         getQueue db connId = first storeError <$> getPrimaryRcvQueue db connId
         updateAction :: DB.Connection -> RcvQueue -> IO ()
         updateAction db rq = supervisorUpdateNtfAction db (qConnId rq) (NSASMP NSASmpDelete)
-    NSCNtfWorker ntfServer -> lift . void $ getNtfNTFWorker True c ntfServer
-    NSCNtfSMPWorker smpServer -> lift . void $ getNtfSMPWorker True c smpServer
     NSCDeleteSub -> void $ lift $ withStoreBatch' c $ \db -> map (deleteNtfSubscription' db) connIds'
   where
     kickSMPWorkers :: [RcvQueue] -> AM ()
@@ -236,8 +238,7 @@ runNtfWorker c srv Worker {doWork} =
                       NSAuth -> do
                         withStore' c $ \db ->
                           updateNtfSubscription db sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew} (NSASMP NSASmpKey) ts
-                        ns <- asks ntfSupervisor
-                        atomically $ writeTBQueue (ntfSubQ ns) (NSCNtfSMPWorker smpServer, [connId])
+                        lift . void $ getNtfSMPWorker True c smpServer
                       status -> updateSubNextCheck ts status
                     atomically $ incNtfServerStat c userId ntfServer ntfChecked
                   Nothing -> workerInternalError c connId "NSACheck - no subscription ID"
@@ -247,8 +248,7 @@ runNtfWorker c srv Worker {doWork} =
             deleteNtfSub $ do
               let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
               withStore' c $ \db -> updateNtfSubscription db sub' (NSASMP NSASmpDelete) ts
-              ns <- asks ntfSupervisor
-              atomically $ writeTBQueue (ntfSubQ ns) (NSCNtfSMPWorker smpServer, [connId]) -- TODO [batch ntf] loop
+              lift . void $ getNtfSMPWorker True c smpServer
           NSARotate ->
             deleteNtfSub $ do
               withStore' c $ \db -> deleteNtfSubscription db connId
@@ -276,51 +276,102 @@ runNtfWorker c srv Worker {doWork} =
             updateNtfSubscription db sub {ntfSubStatus = toStatus} toAction actionTs'
 
 runNtfSMPWorker :: AgentClient -> SMPServer -> Worker -> AM ()
-runNtfSMPWorker c srv Worker {doWork} = do
-  env <- ask
-  forever $ do
-    waitForWork doWork
-    ExceptT . liftIO . agentOperationBracket c AONtfNetwork throwWhenInactive $
-      runReaderT (runExceptT runNtfSMPOperation) env
+runNtfSMPWorker c srv Worker {doWork} = forever $ do
+  waitForWork doWork
+  ExceptT $ agentOperationBracket c AONtfNetwork throwWhenInactive $ runExceptT runNtfSMPOperation
   where
-    runNtfSMPOperation =
-      withWork c doWork (`getNextNtfSubSMPAction` srv) $
-        \nextSub@(NtfSubscription {connId}, _, _) -> do
-          logInfo $ "runNtfSMPWorker, nextSub " <> tshow nextSub
-          ri <- asks $ reconnectInterval . config
-          withRetryInterval ri $ \_ loop -> do
-            liftIO $ waitWhileSuspended c
-            liftIO $ waitForUserNetwork c
-            processSub nextSub
-              `catchAgentError` retryOnError c "NtfSMPWorker" loop (workerInternalError c connId . show)
-    processSub :: (NtfSubscription, NtfSubSMPAction, NtfActionTs) -> AM ()
-    processSub (sub@NtfSubscription {connId, ntfServer}, smpAction, actionTs) = do
-      ts <- liftIO getCurrentTime
-      unlessM (lift $ rescheduleAction doWork ts actionTs) $
-        case smpAction of
-          NSASmpKey ->
-            lift getNtfToken >>= \case
-              Just NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
-                rq <- withStore c (`getPrimaryRcvQueue` connId)
-                C.AuthAlg a <- asks (rcvAuthAlg . config)
-                g <- asks random
-                (ntfPublicKey, ntfPrivateKey) <- atomically $ C.generateAuthKeyPair a g
-                (rcvNtfPubDhKey, rcvNtfPrivDhKey) <- atomically $ C.generateKeyPair g
-                (notifierId, rcvNtfSrvPubDhKey) <- enableQueueNotifications c rq ntfPublicKey rcvNtfPubDhKey
-                let rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
-                withStore' c $ \db -> do
-                  setRcvQueueNtfCreds db connId $ Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
-                  updateNtfSubscription db sub {ntfQueueId = Just notifierId, ntfSubStatus = NASKey} (NSANtf NSACreate) ts
-                ns <- asks ntfSupervisor
-                atomically $ sendNtfSubCommand ns (NSCNtfWorker ntfServer, [connId])
-              _ -> workerInternalError c connId "NSASmpKey - no active token"
-          NSASmpDelete -> do
-            -- TODO should we remove it after successful removal from the server?
-            rq_ <- withStore' c $ \db -> do
-              setRcvQueueNtfCreds db connId Nothing
-              getPrimaryRcvQueue db connId
-            mapM_ (disableQueueNotifications c) rq_
-            withStore' c $ \db -> deleteNtfSubscription db connId
+    runNtfSMPOperation :: AM ()
+    runNtfSMPOperation = do
+      ntfBatchSize <- asks $ ntfBatchSize . config
+      withWorkItems c doWork (\db -> getNextNtfSubSMPActions db srv ntfBatchSize) $ \nextSubs -> do
+        logInfo $ "runNtfSMPWorker - length nextSubs = " <> tshow (length nextSubs)
+        let (creates, deletes) = splitActions nextSubs
+        retrySubActions creates createNotifierKeys
+        retrySubActions deletes deleteNotifierKeys
+    splitActions :: NonEmpty (NtfSubSMPAction, NtfSubscription) -> ([NtfSubscription], [NtfSubscription])
+    splitActions = foldr addAction ([], [])
+      where
+        addAction action (creates, deletes) = case action of
+          (NSASmpKey, sub) -> (sub : creates, deletes)
+          (NSASmpDelete, sub) -> (creates, sub : deletes)
+    retrySubActions :: [NtfSubscription] -> ([NtfSubscription] -> AM' [NtfSubscription]) -> AM ()
+    retrySubActions subs action = do
+      v <- newTVarIO subs
+      ri <- asks $ reconnectInterval . config
+      withRetryInterval ri $ \_ loop -> do
+        liftIO $ waitWhileSuspended c
+        liftIO $ waitForUserNetwork c
+        subs' <- readTVarIO v
+        retrySubs <- lift $ action subs'
+        unless (null retrySubs) $ do
+          atomically $ writeTVar v retrySubs
+          retryNetworkLoop c loop
+    createNotifierKeys :: [NtfSubscription] -> AM' [NtfSubscription]
+    createNotifierKeys ntfSubs =
+      getNtfToken >>= \case
+        Just NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
+          (errs1, subRqKeys) <- prepareQueueSmpKey ntfSubs
+          rs <- enableQueuesNtfs c subRqKeys
+          let (subRqKeys', errs2, successes) = splitResults rs
+              ntfSubs' = map eqnrNtfSub subRqKeys'
+              errs2' = map (first (qConnId . eqnrRq)) errs2
+          ts <- liftIO getCurrentTime
+          (errs3, srvs) <- partitionErrs (qConnId . eqnrRq . fst) successes <$> withStoreBatch' c (\db -> map (storeNtfSubCreds db ts) successes)
+          mapM_ (getNtfNTFWorker True c) $ S.fromList srvs
+          workerErrors c $ errs1 <> errs2' <> errs3
+          pure ntfSubs'
+        _ -> do
+          let errs = map (\sub -> (ntfSubConnId sub, INTERNAL "NSASmpKey - no active token")) ntfSubs
+          workerErrors c errs
+          pure []
+      where
+        prepareQueueSmpKey :: [NtfSubscription] -> AM' ([(ConnId, AgentErrorType)], [EnableQueueNtfReq])
+        prepareQueueSmpKey subs = do
+          alg <- asks (rcvAuthAlg . config)
+          g <- asks random
+          partitionErrs ntfSubConnId subs <$> withStoreBatch c (\db -> map (getQueue db alg g) subs)
+          where
+            getQueue :: DB.Connection -> C.AuthAlg -> TVar ChaChaDRG -> NtfSubscription -> IO (Either AgentErrorType EnableQueueNtfReq)
+            getQueue db (C.AuthAlg a) g sub = fmap (first storeError) $ runExceptT $ do
+              rq <- ExceptT $ getPrimaryRcvQueue db (ntfSubConnId sub)
+              authKeyPair <- atomically $ C.generateAuthKeyPair a g
+              rcvNtfKeyPair <- atomically $ C.generateKeyPair g
+              pure (EnableQueueNtfReq sub rq authKeyPair rcvNtfKeyPair)
+        storeNtfSubCreds :: DB.Connection -> UTCTime -> (EnableQueueNtfReq, (SMP.NotifierId, SMP.RcvNtfPublicDhKey)) -> IO NtfServer
+        storeNtfSubCreds db ts (EnableQueueNtfReq {eqnrNtfSub, eqnrAuthKeyPair = (ntfPublicKey, ntfPrivateKey), eqnrRcvKeyPair = (_, pk)}, (notifierId, srvPubDhKey)) = do
+          let NtfSubscription {ntfServer} = eqnrNtfSub
+              rcvNtfDhSecret = C.dh' srvPubDhKey pk
+          setRcvQueueNtfCreds db (ntfSubConnId eqnrNtfSub) $ Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
+          updateNtfSubscription db eqnrNtfSub {ntfQueueId = Just notifierId, ntfSubStatus = NASKey} (NSANtf NSACreate) ts
+          pure ntfServer
+    deleteNotifierKeys :: [NtfSubscription] -> AM' [NtfSubscription]
+    deleteNotifierKeys ntfSubs = do
+      (errs1, subRqs) <- partitionErrs ntfSubConnId ntfSubs <$> withStoreBatch c (\db -> map (resetCredsGetQueue db) ntfSubs)
+      rs <- disableQueuesNtfs c subRqs
+      let (subRqs', errs2, successes) = splitResults rs
+          ntfSubs' = map fst subRqs'
+          errs2' = map (first (qConnId . snd)) errs2
+          disabledRqs = map (snd . fst) successes
+      (errs3, _) <- partitionErrs qConnId disabledRqs <$> withStoreBatch' c (\db -> map (deleteSub db) disabledRqs)
+      workerErrors c $ errs1 <> errs2' <> errs3
+      pure ntfSubs'
+      where
+        resetCredsGetQueue :: DB.Connection -> NtfSubscription -> IO (Either AgentErrorType DisableQueueNtfReq)
+        resetCredsGetQueue db sub@NtfSubscription {connId} = fmap (first storeError) $ runExceptT $ do
+          liftIO $ setRcvQueueNtfCreds db connId Nothing
+          rq <- ExceptT $ getPrimaryRcvQueue db connId
+          pure (sub, rq)
+        deleteSub :: DB.Connection -> RcvQueue -> IO ()
+        deleteSub db rq = deleteNtfSubscription db (qConnId rq)
+    --                                                (temporary errs, other errs, successes)
+    splitResults :: [(a, Either AgentErrorType r)] -> ([a], [(a, AgentErrorType)], [(a, r)])
+    splitResults = foldr' addRes ([], [], [])
+      where
+        addRes (a, r_) (as, errs, rs) = case r_ of
+          Right r -> (as, errs, (a, r) : rs)
+          Left e
+            | tempErr e -> (a : as, errs, rs)
+            | otherwise -> (as, (a, e) : errs, rs)
 
 rescheduleAction :: TMVar () -> UTCTime -> UTCTime -> AM' Bool
 rescheduleAction doWork ts actionTs
@@ -335,16 +386,28 @@ rescheduleAction doWork ts actionTs
 retryOnError :: AgentClient -> Text -> AM () -> (AgentErrorType -> AM ()) -> AgentErrorType -> AM ()
 retryOnError c name loop done e = do
   logError $ name <> " error: " <> tshow e
-  case e of
-    BROKER _ NETWORK -> retryLoop
-    BROKER _ TIMEOUT -> retryLoop
-    _ -> done e
-  where
-    retryLoop = do
-      atomically $ endAgentOperation c AONtfNetwork
-      liftIO $ throwWhenInactive c
-      atomically $ beginAgentOperation c AONtfNetwork
-      loop
+  if tempErr e
+    then retryNetworkLoop c loop
+    else done e
+
+tempErr :: AgentErrorType -> Bool
+tempErr = \case
+  BROKER _ NETWORK -> True
+  BROKER _ TIMEOUT -> True
+  _ -> False
+
+retryNetworkLoop :: AgentClient -> AM () -> AM ()
+retryNetworkLoop c loop = do
+  atomically $ endAgentOperation c AONtfNetwork
+  liftIO $ throwWhenInactive c
+  atomically $ beginAgentOperation c AONtfNetwork
+  loop
+
+workerErrors :: AgentClient -> [(ConnId, AgentErrorType)] -> AM' ()
+workerErrors c connErrs =
+  unless (null connErrs) $ do
+    void $ withStoreBatch' c (\db -> map (setNullNtfSubscriptionAction db . fst) connErrs)
+    notifyErrs c connErrs
 
 workerInternalError :: AgentClient -> ConnId -> String -> AM ()
 workerInternalError c connId internalErrStr = do
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index c331c4d44..701e03af4 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -162,7 +162,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     deleteNtfSubscription',
     getNextNtfSubNTFAction,
     markNtfSubActionNtfFailed_, -- exported for tests
-    getNextNtfSubSMPAction,
+    getNextNtfSubSMPActions,
     markNtfSubActionSMPFailed_, -- exported for tests
     getActiveNtfToken,
     getNtfRcvQueue,
@@ -1671,14 +1671,14 @@ markNtfSubActionNtfFailed_ :: DB.Connection -> ConnId -> IO ()
 markNtfSubActionNtfFailed_ db connId =
   DB.execute db "UPDATE ntf_subscriptions SET ntf_failed = 1 where conn_id = ?" (Only connId)
 
-getNextNtfSubSMPAction :: DB.Connection -> SMPServer -> IO (Either StoreError (Maybe (NtfSubscription, NtfSubSMPAction, NtfActionTs)))
-getNextNtfSubSMPAction db smpServer@(SMPServer smpHost smpPort _) =
-  getWorkItem "ntf SMP" getNtfConnId getNtfSubAction (markNtfSubActionSMPFailed_ db)
+getNextNtfSubSMPActions :: DB.Connection -> SMPServer -> Int -> IO (Either StoreError [Either StoreError (NtfSubSMPAction, NtfSubscription)])
+getNextNtfSubSMPActions db smpServer@(SMPServer smpHost smpPort _) ntfBatchSize =
+  getWorkItems "ntf SMP" getNtfConnIds getNtfSubAction (markNtfSubActionSMPFailed_ db)
   where
-    getNtfConnId :: IO (Maybe ConnId)
-    getNtfConnId =
-      maybeFirstRow fromOnly $
-        DB.query
+    getNtfConnIds :: IO [ConnId]
+    getNtfConnIds =
+      map fromOnly
+        <$> DB.query
           db
           [sql|
             SELECT conn_id
@@ -1686,10 +1686,10 @@ getNextNtfSubSMPAction db smpServer@(SMPServer smpHost smpPort _) =
             WHERE smp_host = ? AND smp_port = ? AND ntf_sub_smp_action IS NOT NULL AND ntf_sub_action_ts IS NOT NULL
               AND (smp_failed = 0 OR updated_by_supervisor = 1)
             ORDER BY ntf_sub_action_ts ASC
-            LIMIT 1
+            LIMIT ?
           |]
-          (smpHost, smpPort)
-    getNtfSubAction :: ConnId -> IO (Either StoreError (NtfSubscription, NtfSubSMPAction, NtfActionTs))
+          (smpHost, smpPort, ntfBatchSize)
+    getNtfSubAction :: ConnId -> IO (Either StoreError (NtfSubSMPAction, NtfSubscription))
     getNtfSubAction connId = do
       markUpdatedByWorker db connId
       firstRow ntfSubAction err $
@@ -1697,7 +1697,7 @@ getNextNtfSubSMPAction db smpServer@(SMPServer smpHost smpPort _) =
           db
           [sql|
             SELECT c.user_id, s.ntf_host, s.ntf_port, s.ntf_key_hash,
-              ns.smp_ntf_id, ns.ntf_sub_id, ns.ntf_sub_status, ns.ntf_sub_action_ts, ns.ntf_sub_smp_action
+              ns.smp_ntf_id, ns.ntf_sub_id, ns.ntf_sub_status, ns.ntf_sub_smp_action
             FROM ntf_subscriptions ns
             JOIN connections c USING (conn_id)
             JOIN ntf_servers s USING (ntf_host, ntf_port)
@@ -1706,10 +1706,10 @@ getNextNtfSubSMPAction db smpServer@(SMPServer smpHost smpPort _) =
           (Only connId)
       where
         err = SEInternal $ "ntf subscription " <> bshow connId <> " returned []"
-        ntfSubAction (userId, ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
+        ntfSubAction (userId, ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, action) =
           let ntfServer = NtfServer ntfHost ntfPort ntfKeyHash
               ntfSubscription = NtfSubscription {userId, connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
-           in (ntfSubscription, action, actionTs)
+           in (action, ntfSubscription)
 
 markNtfSubActionSMPFailed_ :: DB.Connection -> ConnId -> IO ()
 markNtfSubActionSMPFailed_ db connId =

From 1afa0206a559cf62915ea5905304a950c498cb61 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Wed, 25 Sep 2024 18:33:45 +0100
Subject: [PATCH 123/195] smp: increase server and default agent queue sizes
 (#1335)

---
 src/Simplex/Messaging/Agent/Env/SQLite.hs | 2 +-
 src/Simplex/Messaging/Server/Main.hs      | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index a550394c1..e54ee64b4 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -194,7 +194,7 @@ defaultAgentConfig =
       rcvAuthAlg = C.AuthAlg C.SEd25519, -- this will stay as Ed25519
       sndAuthAlg = C.AuthAlg C.SEd25519, -- TODO replace with X25519 when switching to v7
       connIdBytes = 12,
-      tbqSize = 64,
+      tbqSize = 128,
       smpCfg = defaultSMPClientConfig {defaultTransport = (show defaultSMPPort, transport @TLS)},
       ntfCfg = defaultNTFClientConfig {defaultTransport = ("443", transport @TLS)},
       xftpCfg = defaultXFTPClientConfig,
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 6d7cbccad..a5106c125 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -256,7 +256,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
           ServerConfig
             { transports = iniTransports ini,
               smpHandshakeTimeout = 120000000,
-              tbqSize = 64,
+              tbqSize = 128,
               msgQueueQuota = 128,
               queueIdBytes = 24,
               msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20

From 41e1b2bd39ac64eb9b636be18f95c018424349fa Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Wed, 25 Sep 2024 21:40:59 +0400
Subject: [PATCH 124/195] ntf: use common function for differentiating
 temporary errors (#1333)

---
 src/Simplex/Messaging/Agent/NtfSubSupervisor.hs | 10 ++--------
 1 file changed, 2 insertions(+), 8 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
index 9a949eec4..96f14dfc3 100644
--- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
+++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
@@ -370,7 +370,7 @@ runNtfSMPWorker c srv Worker {doWork} = forever $ do
         addRes (a, r_) (as, errs, rs) = case r_ of
           Right r -> (as, errs, (a, r) : rs)
           Left e
-            | tempErr e -> (a : as, errs, rs)
+            | temporaryOrHostError e -> (a : as, errs, rs)
             | otherwise -> (as, (a, e) : errs, rs)
 
 rescheduleAction :: TMVar () -> UTCTime -> UTCTime -> AM' Bool
@@ -386,16 +386,10 @@ rescheduleAction doWork ts actionTs
 retryOnError :: AgentClient -> Text -> AM () -> (AgentErrorType -> AM ()) -> AgentErrorType -> AM ()
 retryOnError c name loop done e = do
   logError $ name <> " error: " <> tshow e
-  if tempErr e
+  if temporaryOrHostError e
     then retryNetworkLoop c loop
     else done e
 
-tempErr :: AgentErrorType -> Bool
-tempErr = \case
-  BROKER _ NETWORK -> True
-  BROKER _ TIMEOUT -> True
-  _ -> False
-
 retryNetworkLoop :: AgentClient -> AM () -> AM ()
 retryNetworkLoop c loop = do
   atomically $ endAgentOperation c AONtfNetwork

From 03168b9fbfd8a507a5374ff3375609e705225e29 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Thu, 26 Sep 2024 12:23:31 +0100
Subject: [PATCH 125/195] 6.1.0.1

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index e73b0748c..8699dce63 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.1.0.0
+version: 6.1.0.1
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 6ec1b387a..1ab3e4fe8 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.1.0.0
+version:        6.1.0.1
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 21eee2b548ba930985fefc0505f807077f92406e Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 28 Sep 2024 19:59:53 +0100
Subject: [PATCH 126/195] smp servers: separately account for subscribed
 clients, to disconnect those without subscriptions more effectively (and to
 be able to deliver notifications to subscribed ntf servers) (#1339)

---
 src/Simplex/Messaging/Server.hs         | 132 ++++++++++++++----------
 src/Simplex/Messaging/Server/Env/STM.hs |  26 ++---
 2 files changed, 90 insertions(+), 68 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 969c5399b..599938ab6 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -136,10 +136,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
   expired <- restoreServerMessages
   restoreServerStats expired
   raceAny_
-    ( serverThread s "server subscribedQ" True subscribedQ subscribers pendingENDs subscriptions cancelSub
-        : serverThread s "server deletedQ" False deletedQ  subscribers pendingDELDs subscriptions cancelSub
-        : serverThread s "server ntfSubscribedQ" True ntfSubscribedQ Env.notifiers pendingNtfENDs ntfSubscriptions (\_ -> pure ())
-        : serverThread s "server ntfDeletedQ" False ntfDeletedQ Env.notifiers pendingNtfDELDs ntfSubscriptions (\_ -> pure ())
+    ( serverThread s "server subscribedQ" subscribedQ subscribers subClients pendingSubEvents subscriptions cancelSub
+        : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubClients pendingNtfSubEvents ntfSubscriptions (\_ -> pure ())
         : sendPendingEvtsThread s
         : receiveFromProxyAgent pa
         : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
@@ -165,14 +163,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       forall s.
       Server ->
       String ->
-      Subscribed ->
-      (Server -> TQueue (QueueId, ClientId)) ->
+      (Server -> TQueue (QueueId, ClientId, Subscribed)) ->
       (Server -> TMap QueueId (TVar Client)) ->
-      (Server -> TVar (IM.IntMap (NonEmpty RecipientId))) ->
+      (Server -> TVar (IM.IntMap Client)) ->
+      (Server -> TVar (IM.IntMap (NonEmpty (QueueId, Subscribed)))) ->
       (Client -> TMap QueueId s) ->
       (s -> IO ()) ->
       M ()
-    serverThread s label subscribed subQ subs pendingEvts clientSubs unsub = do
+    serverThread s label subQ subs subClnts pendingEvts clientSubs unsub = do
       labelMyThread label
       cls <- asks clients
       liftIO . forever $
@@ -180,32 +178,40 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           $>>= endPreviousSubscriptions
           >>= mapM_ unsub
       where
-        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, ClientId) -> STM (Maybe (QueueId, Client))
-        updateSubscribers cls (qId, clntId) =
+        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, ClientId, Subscribed) -> STM (Maybe ((QueueId, Subscribed), Client))
+        updateSubscribers cls (qId, clntId, subscribed) =
           -- Client lookup by ID is in the same STM transaction.
           -- In case client disconnects during the transaction,
           -- it will be re-evaluated, and the client won't be stored as subscribed.
-          (readTVar cls >>= updateSub (subs s) . IM.lookup clntId)
+          (readTVar cls >>= updateSub . IM.lookup clntId)
             $>>= clientToBeNotified
           where
-            updateSub ss = \case
+            ss = subs s
+            updateSub = \case
               Just (Just clnt)
-                | subscribed ->
+                | subscribed -> do
+                    modifyTVar' (subClnts s) $ IM.insert clntId clnt -- add client to server's subscribed cients
                     TM.lookup qId ss >>= -- insert subscribed and current client
                       maybe
                         (newTVar clnt >>= \cv -> TM.insert qId cv ss $> Nothing)
                         (\cv -> Just <$> swapTVar cv clnt)
-                | otherwise -> TM.lookupDelete qId ss >>= mapM readTVar
+                | otherwise -> do
+                    removeWhenNoSubs clnt
+                    TM.lookupDelete qId ss >>= mapM readTVar
               -- This case catches Just Nothing - it cannot happen here.
               -- Nothing is there only before client thread is started.
               _ -> TM.lookup qId ss >>= mapM readTVar -- do not insert client if it is already disconnected, but send END to any other client
             clientToBeNotified c'
               | clntId == clientId c' = pure Nothing
-              | otherwise = (\yes -> if yes then Just (qId, c') else Nothing) <$> readTVar (connected c')
-        endPreviousSubscriptions :: (QueueId, Client) -> IO (Maybe s)
-        endPreviousSubscriptions (qId, c) = do
-          atomically $ modifyTVar' (pendingEvts s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
-          atomically $ TM.lookupDelete qId (clientSubs c)
+              | otherwise = (\yes -> if yes then Just ((qId, subscribed), c') else Nothing) <$> readTVar (connected c')
+        endPreviousSubscriptions :: ((QueueId, Subscribed), Client) -> IO (Maybe s)
+        endPreviousSubscriptions (qEvt@(qId, _), c) = do
+          atomically $ modifyTVar' (pendingEvts s) $ IM.alter (Just . maybe [qEvt] (qEvt <|)) (clientId c)
+          atomically $ do
+            sub <- TM.lookupDelete qId (clientSubs c)
+            removeWhenNoSubs c $> sub
+        -- remove client from server's subscribed cients
+        removeWhenNoSubs c = whenM (null <$> readTVar (clientSubs c)) $ modifyTVar' (subClnts s) $ IM.delete (clientId c)
 
     sendPendingEvtsThread :: Server -> M ()
     sendPendingEvtsThread s = do
@@ -213,16 +219,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       cls <- asks clients
       forever $ do
         threadDelay endInt
-        sendPending cls END $ pendingENDs s
-        sendPending cls DELD $ pendingDELDs s
-        sendPending cls END $ pendingNtfENDs s
-        sendPending cls DELD $ pendingNtfDELDs s
+        sendPending cls $ pendingSubEvents s
+        sendPending cls $ pendingNtfSubEvents s
       where
-        sendPending cls evt ref = do
+        sendPending cls ref = do
           ends <- atomically $ swapTVar ref IM.empty
-          unless (null ends) $ forM_ (IM.assocs ends) $ \(cId, qIds) ->
-            mapM_ (queueEvts qIds evt) . join . IM.lookup cId =<< readTVarIO cls
-        queueEvts qIds evt c@Client {connected, sndQ = q} =
+          unless (null ends) $ forM_ (IM.assocs ends) $ \(cId, qEvts) ->
+            mapM_ (queueEvts qEvts) . join . IM.lookup cId =<< readTVarIO cls
+        queueEvts qEvts c@Client {connected, sndQ = q} =
           whenM (readTVarIO connected) $ do
             sent <- atomically $ ifM (isFullTBQueue q) (pure False) (writeTBQueue q ts $> True)
             if sent
@@ -231,14 +235,15 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                 forkClient c ("sendPendingEvtsThread.queueEvts") $
                   atomically (writeTBQueue q ts) >> updateEndStats
           where
-            ts = L.map (CorrId "",,evt) qIds
-            updateEndStats = case evt of
-              END -> do
-                stats <- asks serverStats
-                let len = L.length qIds
-                liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
-                liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
-              _ -> pure ()
+            ts = L.map (\(qId, subscribed) -> (CorrId "", qId, evt subscribed)) qEvts
+            evt True = END
+            evt False = DELD
+            -- this accounts for both END and DELD events
+            updateEndStats = do
+              stats <- asks serverStats
+              let len = L.length qEvts
+              liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
+              liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs or DELDs in the batch
 
     receiveFromProxyAgent :: ProxyAgent -> M ()
     receiveFromProxyAgent ProxyAgent {smpAgent = SMPClientAgent {agentQ}} =
@@ -253,16 +258,16 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
         showServer' = decodeLatin1 . strEncode . host
 
     expireMessagesThread_ :: ServerConfig -> [M ()]
-    expireMessagesThread_ ServerConfig {messageExpiration = Just msgExp} = [expireMessages msgExp]
+    expireMessagesThread_ ServerConfig {messageExpiration = Just msgExp} = [expireMessagesThread msgExp]
     expireMessagesThread_ _ = []
 
-    expireMessages :: ExpirationConfig -> M ()
-    expireMessages expCfg = do
+    expireMessagesThread :: ExpirationConfig -> M ()
+    expireMessagesThread expCfg = do
       ms <- asks msgStore
       quota <- asks $ msgQueueQuota . config
       let interval = checkInterval expCfg * 1000000
       stats <- asks serverStats
-      labelMyThread "expireMessages"
+      labelMyThread "expireMessagesThread"
       forever $ do
         liftIO $ threadDelay' interval
         old <- liftIO $ expireBeforeEpoch expCfg
@@ -564,7 +569,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
 #else
                   hPutStrLn h "Threads: not available on GHC 8.10"
 #endif
-                  Env {clients, server = Server {subscribers, notifiers}} <- unliftIO u ask
+                  Env {clients, server = Server {subscribers, notifiers, subClients, ntfSubClients}} <- unliftIO u ask
                   activeClients <- readTVarIO clients
                   hPutStrLn h $ "Clients: " <> show (IM.size activeClients)
                   when (r == CPRAdmin) $ do
@@ -581,6 +586,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                     hPutStrLn h $ "Ntf subscribed clients queues (via clients, rcvQ, sndQ, msgQ): " <> show ntfClQs
                   putActiveClientsInfo "SMP" subscribers
                   putActiveClientsInfo "Ntf" notifiers
+                  putSubscribedClients "SMP" subClients
+                  putSubscribedClients "Ntf" ntfSubClients
                   where
                     putActiveClientsInfo :: String -> TMap QueueId (TVar Client) -> IO ()
                     putActiveClientsInfo protoName clients = do
@@ -591,6 +598,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                       where
                         countSubClients :: M.Map QueueId (TVar Client) -> IO IS.IntSet
                         countSubClients = foldM (\ !s c -> (`IS.insert` s) . clientId <$> readTVarIO c) IS.empty
+                    putSubscribedClients :: String -> TVar (IM.IntMap Client) -> IO ()
+                    putSubscribedClients protoName subClnts = do
+                      clnts <- readTVarIO subClnts
+                      hPutStrLn h $ protoName <> " subscribed clients count:" <> show (IM.size clnts)
                     countClientSubs :: (Client -> TMap QueueId a) -> Maybe (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap (Maybe Client) -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
                     countClientSubs subSel countSubs_ = foldM addSubs (0, (0, 0, 0, 0), 0, (0, 0, 0))
                       where
@@ -680,11 +691,14 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
       expCfg <- asks $ inactiveClientExpiration . config
       th <- newMVar h -- put TH under a fair lock to interleave messages and command responses
       labelMyThread . B.unpack $ "client $" <> encode sessionId
-      raceAny_ $ [liftIO $ send th c, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c expCfg
-    disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport h (rcvActiveAt c) (sndActiveAt c) expCfg (noSubscriptions c)]
-    disconnectThread_ _ _ = []
-    noSubscriptions c = atomically $ (&&) <$> TM.null (ntfSubscriptions c) <*> (not . hasSubs <$> readTVar (subscriptions c))
-    hasSubs = any $ (\case ServerSub _ -> True; ProhibitSub -> False) . subThread
+      raceAny_ $ [liftIO $ send th c, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c s expCfg
+    disconnectThread_ c s (Just expCfg) = [liftIO $ disconnectTransport h (rcvActiveAt c) (sndActiveAt c) expCfg (noSubscriptions c s)]
+    disconnectThread_ _ _ _ = []
+    noSubscriptions Client {clientId} s = do
+      hasSubs <- IM.member clientId <$> readTVarIO (subClients s)
+      if hasSubs
+        then pure False
+        else not . IM.member clientId <$> readTVarIO (ntfSubClients s)
 
 clientDisconnected :: Client -> M ()
 clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, connected, sessionId, endThreads} = do
@@ -695,10 +709,12 @@ clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, connecte
   subs <- atomically $ swapTVar subscriptions M.empty
   ntfSubs <- atomically $ swapTVar ntfSubscriptions M.empty
   liftIO $ mapM_ cancelSub subs
-  Server {subscribers, notifiers} <- asks server
+  Server {subscribers, notifiers, subClients, ntfSubClients} <- asks server
   liftIO $ updateSubscribers subs subscribers
   liftIO $ updateSubscribers ntfSubs notifiers
   asks clients >>= atomically . (`modifyTVar'` IM.delete clientId)
+  atomically $ modifyTVar' subClients $ IM.delete clientId
+  atomically $ modifyTVar' ntfSubClients $ IM.delete clientId
   tIds <- atomically $ swapTVar endThreads IM.empty
   liftIO $ mapM_ (mapM_ killThread <=< deRefWeak) tIds
   where
@@ -899,7 +915,7 @@ forkClient Client {endThreads, endThreadSeq} label action = do
   mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId
 
 client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
-client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, deletedQ, ntfSubscribedQ, ntfDeletedQ, subscribers, notifiers} = do
+client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers, notifiers} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
   forever $
     atomically (readTBQueue rcvQ)
@@ -1093,7 +1109,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                 Right nId_ -> do
                   withLog $ \s -> logAddNotifier s entId ntfCreds
                   incStat . ntfCreated =<< asks serverStats
-                  forM_ nId_ $ \nId -> atomically $ writeTQueue ntfDeletedQ (nId, clientId)
+                  forM_ nId_ $ \nId -> atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
                   pure $ NID notifierId rcvPublicDhKey
 
         deleteQueueNotifier_ :: QueueStore -> M (Transmission BrokerMsg)
@@ -1102,7 +1118,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           liftIO (deleteQueueNotifier st entId) >>= \case
             Right (Just nId) -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              atomically $ writeTQueue ntfDeletedQ (nId, clientId)
+              atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
               incStat . ntfDeleted =<< asks serverStats
               pure ok
             Right Nothing -> pure ok
@@ -1130,7 +1146,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           where
             newSub :: M Sub
             newSub = time "SUB newSub" . atomically $ do
-              writeTQueue subscribedQ (rId, clientId)
+              writeTQueue subscribedQ (rId, clientId, True)
               sub <- newSubscription NoSub
               TM.insert rId sub subscriptions
               pure sub
@@ -1163,6 +1179,10 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
             newSub = do
               s <- newProhibitedSub
               TM.insert entId s subscriptions
+              -- Here we don't account for this client as subscribed in the server
+              -- and don't notify other subscribed clients.
+              -- This is tracked as "subscription" in the client to prevent these
+              -- clients from being able to subscribe.
               pure s
             getMessage_ :: Sub -> Maybe MsgId -> M (Transmission BrokerMsg)
             getMessage_ s delivered_ = do
@@ -1205,7 +1225,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           pure ok
           where
             newSub = do
-              writeTQueue ntfSubscribedQ (entId, clientId)
+              writeTQueue ntfSubscribedQ (entId, clientId, True)
               TM.insert entId () ntfSubscriptions
 
         acknowledgeMsg :: QueueRec -> MsgId -> M (Transmission BrokerMsg)
@@ -1486,9 +1506,15 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           liftIO (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case
             Right q -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              atomically $ writeTQueue deletedQ (entId, clientId)
+              atomically $ do
+                writeTQueue subscribedQ (entId, clientId, False)
+                -- queue is usually deleted by the same client that is currently subscribed,
+                -- we delete subscription here, so the client with no subscriptions can be disconnected.
+                TM.delete entId subscriptions
               forM_ (notifierId <$> notifier q) $ \nId ->
-                atomically $ writeTQueue ntfDeletedQ (nId, clientId)
+                -- queue is deleted by a different client from the one subscribed to notifications,
+                -- so we don't need to remove subscription from the current client.
+                atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
               updateDeletedStats q
               pure ok
             Left e -> pure $ err e
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 8012f5154..9413ef24e 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -136,16 +136,14 @@ data Env = Env
 type Subscribed = Bool
 
 data Server = Server
-  { subscribedQ :: TQueue (RecipientId, ClientId),
-    deletedQ :: TQueue (RecipientId, ClientId),
+  { subscribedQ :: TQueue (RecipientId, ClientId, Subscribed),
     subscribers :: TMap RecipientId (TVar Client),
-    ntfSubscribedQ :: TQueue (NotifierId, ClientId),
-    ntfDeletedQ :: TQueue (NotifierId, ClientId),
+    ntfSubscribedQ :: TQueue (NotifierId, ClientId, Subscribed),
     notifiers :: TMap NotifierId (TVar Client),
-    pendingENDs :: TVar (IntMap (NonEmpty RecipientId)),
-    pendingDELDs :: TVar (IntMap (NonEmpty RecipientId)),
-    pendingNtfENDs :: TVar (IntMap (NonEmpty NotifierId)),
-    pendingNtfDELDs :: TVar (IntMap (NonEmpty NotifierId)),
+    subClients :: TVar (IntMap Client), -- clients with SMP subscriptions
+    ntfSubClients :: TVar (IntMap Client), -- clients with Ntf subscriptions
+    pendingSubEvents :: TVar (IntMap (NonEmpty (RecipientId, Subscribed))),
+    pendingNtfSubEvents :: TVar (IntMap (NonEmpty (NotifierId, Subscribed))),
     savingLock :: Lock
   }
 
@@ -185,17 +183,15 @@ data Sub = Sub
 newServer :: IO Server
 newServer = do
   subscribedQ <- newTQueueIO
-  deletedQ <- newTQueueIO
   subscribers <- TM.emptyIO
   ntfSubscribedQ <- newTQueueIO
-  ntfDeletedQ <- newTQueueIO
   notifiers <- TM.emptyIO
-  pendingENDs <- newTVarIO IM.empty
-  pendingDELDs <- newTVarIO IM.empty
-  pendingNtfENDs <- newTVarIO IM.empty
-  pendingNtfDELDs <- newTVarIO IM.empty
+  subClients <- newTVarIO IM.empty
+  ntfSubClients <- newTVarIO IM.empty
+  pendingSubEvents <- newTVarIO IM.empty
+  pendingNtfSubEvents <- newTVarIO IM.empty
   savingLock <- atomically createLock
-  return Server {subscribedQ, deletedQ, subscribers, ntfSubscribedQ, ntfDeletedQ, notifiers, pendingENDs, pendingDELDs, pendingNtfENDs, pendingNtfDELDs, savingLock}
+  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, subClients, ntfSubClients, pendingSubEvents, pendingNtfSubEvents, savingLock}
 
 newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
 newClient clientId qSize thVersion sessionId createdAt = do

From 3c18c4b66ac0c1fd968abc5f063215ce7f47c071 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 28 Sep 2024 22:21:08 +0100
Subject: [PATCH 127/195] servers: refactor TLS credentials (#1326)

* servers: refactor TLS credentials

* provide server credentials in SNI hook

* determine TLS server params dynamically, when starting the server

* remove alpn from TransportServerConfig to decide it dynamically where server is started
---
 src/Simplex/FileTransfer/Client.hs            |   4 +-
 src/Simplex/FileTransfer/Server.hs            |  19 ++--
 src/Simplex/FileTransfer/Server/Env.hs        |  17 ++-
 src/Simplex/FileTransfer/Server/Main.hs       |  16 +--
 src/Simplex/Messaging/Notifications/Server.hs |  10 +-
 .../Messaging/Notifications/Server/Env.hs     |  17 ++-
 .../Messaging/Notifications/Server/Main.hs    |  17 +--
 src/Simplex/Messaging/Server.hs               |   6 +-
 src/Simplex/Messaging/Server/CLI.hs           |   6 +-
 src/Simplex/Messaging/Server/Env/STM.hs       |  17 ++-
 src/Simplex/Messaging/Server/Main.hs          |  17 +--
 src/Simplex/Messaging/Transport.hs            |   6 +-
 src/Simplex/Messaging/Transport/Client.hs     |   2 +-
 .../Messaging/Transport/Credentials.hs        |   4 +-
 .../Messaging/Transport/HTTP2/Server.hs       |  20 ++--
 src/Simplex/Messaging/Transport/Server.hs     | 105 ++++++++++--------
 src/Simplex/RemoteControl/Client.hs           |   7 +-
 src/Simplex/RemoteControl/Discovery.hs        |  10 +-
 tests/NtfClient.hs                            |  24 ++--
 tests/SMPClient.hs                            |  12 +-
 tests/XFTPAgent.hs                            |  13 ++-
 tests/XFTPClient.hs                           |  23 ++--
 22 files changed, 193 insertions(+), 179 deletions(-)

diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs
index fde24f8be..f2240ec50 100644
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -53,7 +53,7 @@ import Simplex.Messaging.Protocol
     SenderId,
     pattern NoEntity,
   )
-import Simplex.Messaging.Transport (ALPN, HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), supportedParameters)
+import Simplex.Messaging.Transport (ALPN, HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), defaultSupportedParams)
 import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.Client
@@ -173,7 +173,7 @@ xftpHTTP2Config :: TransportClientConfig -> XFTPClientConfig -> HTTP2ClientConfi
 xftpHTTP2Config transportConfig XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpConnectTimeout}} =
   defaultHTTP2ClientConfig
     { bodyHeadSize = xftpBlockSize,
-      suportedTLSParams = supportedParameters,
+      suportedTLSParams = defaultSupportedParams,
       connTimeout = tcpConnectTimeout,
       transportConfig
     }
diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index 434fcde4d..24ad4815e 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -60,12 +60,12 @@ import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, getRoundedSystemT
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..))
+import Simplex.Messaging.Transport (ALPN, SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..), defaultSupportedParams)
 import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
 import Simplex.Messaging.Transport.HTTP2.Server
-import Simplex.Messaging.Transport.Server (runLocalTCPServer, tlsServerCredentials)
+import Simplex.Messaging.Transport.Server (runLocalTCPServer)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Exit (exitFailure)
@@ -91,32 +91,31 @@ data XFTPTransportRequest = XFTPTransportRequest
 runXFTPServer :: XFTPServerConfig -> IO ()
 runXFTPServer cfg = do
   started <- newEmptyTMVarIO
-  runXFTPServerBlocking started cfg
+  runXFTPServerBlocking started cfg $ Just supportedXFTPhandshakes
 
-runXFTPServerBlocking :: TMVar Bool -> XFTPServerConfig -> IO ()
-runXFTPServerBlocking started cfg = newXFTPServerEnv cfg >>= runReaderT (xftpServer cfg started)
+runXFTPServerBlocking :: TMVar Bool -> XFTPServerConfig -> Maybe [ALPN] -> IO ()
+runXFTPServerBlocking started cfg alpn_ = newXFTPServerEnv cfg >>= runReaderT (xftpServer cfg started alpn_)
 
 data Handshake
   = HandshakeSent C.PrivateKeyX25519
   | HandshakeAccepted (THandleParams XFTPVersion 'TServer)
 
-xftpServer :: XFTPServerConfig -> TMVar Bool -> M ()
-xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration, xftpServerVRange} started = do
+xftpServer :: XFTPServerConfig -> TMVar Bool -> Maybe [ALPN] -> M ()
+xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration, xftpServerVRange} started alpn_ = do
   mapM_ (expireServerFiles Nothing) fileExpiration
   restoreServerStats
   raceAny_ (runServer : expireFilesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg) `finally` stopServer
   where
     runServer :: M ()
     runServer = do
-      serverParams <- asks tlsServerParams
-      let (chain, pk) = tlsServerCredentials serverParams
+      srvCreds@(chain, pk) <- asks tlsServerCreds
       signKey <- liftIO $ case C.x509ToPrivate (pk, []) >>= C.privKey of
         Right pk' -> pure pk'
         Left e -> putStrLn ("servers has no valid key: " <> show e) >> exitFailure
       env <- ask
       sessions <- liftIO TM.emptyIO
       let cleanup sessionId = atomically $ TM.delete sessionId sessions
-      liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize serverParams transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
+      liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize defaultSupportedParams srvCreds alpn_ transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
         reqBody <- getHTTP2Body r xftpBlockSize
         let v = VersionXFTP 1
             thServerVRange = versionToRange v
diff --git a/src/Simplex/FileTransfer/Server/Env.hs b/src/Simplex/FileTransfer/Server/Env.hs
index 1fa399a2a..c967d834c 100644
--- a/src/Simplex/FileTransfer/Server/Env.hs
+++ b/src/Simplex/FileTransfer/Server/Env.hs
@@ -29,7 +29,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (BasicAuth, RcvPublicAuthKey)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (ALPN)
-import Simplex.Messaging.Transport.Server (TransportServerConfig (..), loadFingerprint, loadTLSServerParams)
+import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), loadFingerprint, loadServerCredential)
 import Simplex.Messaging.Util (tshow)
 import System.IO (IOMode (..))
 import UnliftIO.STM
@@ -57,10 +57,7 @@ data XFTPServerConfig = XFTPServerConfig
     fileTimeout :: Int,
     -- | time after which inactive clients can be disconnected and check interval, seconds
     inactiveClientExpiration :: Maybe ExpirationConfig,
-    -- CA certificate private key is not needed for initialization
-    caCertificateFile :: FilePath,
-    privateKeyFile :: FilePath,
-    certificateFile :: FilePath,
+    xftpCredentials :: ServerCredentials,
     -- | XFTP client-server protocol version range
     xftpServerVRange :: VersionRangeXFTP,
     -- stats config - see SMP server config
@@ -85,7 +82,7 @@ data XFTPEnv = XFTPEnv
     storeLog :: Maybe (StoreLog 'WriteMode),
     random :: TVar ChaChaDRG,
     serverIdentity :: C.KeyHash,
-    tlsServerParams :: T.ServerParams,
+    tlsServerCreds :: T.Credential,
     serverStats :: FileServerStats
   }
 
@@ -103,7 +100,7 @@ supportedXFTPhandshakes :: [ALPN]
 supportedXFTPhandshakes = ["xftp/1"]
 
 newXFTPServerEnv :: XFTPServerConfig -> IO XFTPEnv
-newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, caCertificateFile, certificateFile, privateKeyFile, transportConfig} = do
+newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, xftpCredentials} = do
   random <- C.newRandom
   store <- newFileStore
   storeLog <- mapM (`readWriteFileStore` store) storeLogFile
@@ -112,10 +109,10 @@ newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, caCertifi
   forM_ fileSizeQuota $ \quota -> do
     logInfo $ "Total / available storage: " <> tshow quota <> " / " <> tshow (quota - used)
     when (quota < used) $ logInfo "WARNING: storage quota is less than used storage, no files can be uploaded!"
-  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
-  Fingerprint fp <- loadFingerprint caCertificateFile
+  tlsServerCreds <- loadServerCredential xftpCredentials
+  Fingerprint fp <- loadFingerprint xftpCredentials
   serverStats <- newFileServerStats =<< getCurrentTime
-  pure XFTPEnv {config, store, storeLog, random, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}
+  pure XFTPEnv {config, store, storeLog, random, tlsServerCreds, serverIdentity = C.KeyHash fp, serverStats}
 
 countUsedStorage :: M.Map k FileRec -> Int64
 countUsedStorage = M.foldl' (\acc FileRec {fileInfo = FileInfo {size}} -> acc + fromIntegral size) 0
diff --git a/src/Simplex/FileTransfer/Server/Main.hs b/src/Simplex/FileTransfer/Server/Main.hs
index 76b1f157a..1f9246b1c 100644
--- a/src/Simplex/FileTransfer/Server/Main.hs
+++ b/src/Simplex/FileTransfer/Server/Main.hs
@@ -19,7 +19,7 @@ import Options.Applicative
 import Simplex.FileTransfer.Chunks
 import Simplex.FileTransfer.Description (FileSize (..))
 import Simplex.FileTransfer.Server (runXFTPServer)
-import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration, supportedXFTPhandshakes)
+import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration)
 import Simplex.FileTransfer.Transport (supportedFileServerVRange)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
@@ -28,7 +28,7 @@ import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
-import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
+import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
@@ -173,9 +173,12 @@ xftpServerCLI cfgPath logPath = do
                     { ttl = readStrictIni "INACTIVE_CLIENTS" "ttl" ini,
                       checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
                     },
-              caCertificateFile = c caCrtFile,
-              privateKeyFile = c serverKeyFile,
-              certificateFile = c serverCrtFile,
+              xftpCredentials =
+                ServerCredentials
+                  { caCertificateFile = Just $ c caCrtFile,
+                    privateKeyFile = c serverKeyFile,
+                    certificateFile = c serverCrtFile
+                  },
               xftpServerVRange = supportedFileServerVRange,
               logStatsInterval = logStats $> 86400, -- seconds
               logStatsStartTime = 0, -- seconds from 00:00 UTC
@@ -183,8 +186,7 @@ xftpServerCLI cfgPath logPath = do
               serverStatsBackupFile = logStats $> combine logPath "file-server-stats.log",
               transportConfig =
                 defaultTransportServerConfig
-                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini,
-                    alpn = Just supportedXFTPhandshakes
+                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
                   },
               responseDelay = 0
             }
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 2c964f9bf..8b5f2274b 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -50,8 +50,8 @@ import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
 import Simplex.Messaging.Server.Stats
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (ATransport (..), THandle (..), THandleAuth (..), THandleParams (..), TProxy, Transport (..), TransportPeer (..))
-import Simplex.Messaging.Transport.Server (runTransportServer, tlsServerCredentials)
+import Simplex.Messaging.Transport (ATransport (..), THandle (..), THandleAuth (..), THandleParams (..), TProxy, Transport (..), TransportPeer (..), defaultSupportedParams)
+import Simplex.Messaging.Transport.Server (runTransportServer)
 import Simplex.Messaging.Util
 import System.Exit (exitFailure)
 import System.IO (BufferMode (..), hPutStrLn, hSetBuffering)
@@ -82,10 +82,10 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
   where
     runServer :: (ServiceName, ATransport) -> M ()
     runServer (tcpPort, ATransport t) = do
-      serverParams <- asks tlsServerParams
-      serverSignKey <- either fail pure . fromTLSCredentials $ tlsServerCredentials serverParams
+      srvCreds <- asks tlsServerCreds
+      serverSignKey <- either fail pure $ fromTLSCredentials srvCreds
       env <- ask
-      liftIO $ runTransportServer started tcpPort serverParams tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
+      liftIO $ runTransportServer started tcpPort defaultSupportedParams srvCreds (Just supportedNTFHandshakes) tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
     fromTLSCredentials (_, pk) = C.x509ToPrivate (pk, []) >>= C.privKey
 
     runClient :: Transport c => C.APrivateSignKey -> TProxy c -> c -> M ()
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index dc0cb0a73..e99adc884 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -33,7 +33,7 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport, THandleParams, TransportPeer (..))
-import Simplex.Messaging.Transport.Server (TransportServerConfig, alpn, loadFingerprint, loadTLSServerParams)
+import Simplex.Messaging.Transport.Server (ServerCredentials, TransportServerConfig, loadFingerprint, loadServerCredential)
 import System.IO (IOMode (..))
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
@@ -50,10 +50,7 @@ data NtfServerConfig = NtfServerConfig
     subsBatchSize :: Int,
     inactiveClientExpiration :: Maybe ExpirationConfig,
     storeLogFile :: Maybe FilePath,
-    -- CA certificate private key is not needed for initialization
-    caCertificateFile :: FilePath,
-    privateKeyFile :: FilePath,
-    certificateFile :: FilePath,
+    ntfCredentials :: ServerCredentials,
     -- stats config - see SMP server config
     logStatsInterval :: Maybe Int64,
     logStatsStartTime :: Int64,
@@ -77,13 +74,13 @@ data NtfEnv = NtfEnv
     store :: NtfStore,
     storeLog :: Maybe (StoreLog 'WriteMode),
     random :: TVar ChaChaDRG,
-    tlsServerParams :: T.ServerParams,
+    tlsServerCreds :: T.Credential,
     serverIdentity :: C.KeyHash,
     serverStats :: NtfServerStats
   }
 
 newNtfServerEnv :: NtfServerConfig -> IO NtfEnv
-newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsConfig, storeLogFile, caCertificateFile, certificateFile, privateKeyFile, transportConfig} = do
+newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsConfig, storeLogFile, ntfCredentials} = do
   random <- C.newRandom
   store <- newNtfStore
   logInfo "restoring subscriptions..."
@@ -91,10 +88,10 @@ newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsCo
   logInfo "restored subscriptions"
   subscriber <- newNtfSubscriber subQSize smpAgentCfg random
   pushServer <- newNtfPushServer pushQSize apnsConfig
-  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
-  Fingerprint fp <- loadFingerprint caCertificateFile
+  tlsServerCreds <- loadServerCredential ntfCredentials
+  Fingerprint fp <- loadFingerprint ntfCredentials
   serverStats <- newNtfServerStats =<< getCurrentTime
-  pure NtfEnv {config, subscriber, pushServer, store, storeLog, random, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}
+  pure NtfEnv {config, subscriber, pushServer, store, storeLog, random, tlsServerCreds, serverIdentity = C.KeyHash fp, serverStats}
 
 data NtfSubscriber = NtfSubscriber
   { smpSubscribers :: TMap SMPServer SMPSubscriber,
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index d29c88c1e..16f8e430f 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Messaging.Notifications.Server.Main where
 
@@ -22,13 +23,13 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Server (runNtfServer)
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..), defaultInactiveClientExpiration)
 import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientConfig)
-import Simplex.Messaging.Notifications.Transport (supportedNTFHandshakes, supportedServerNTFVRange)
+import Simplex.Messaging.Notifications.Transport (supportedServerNTFVRange)
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
-import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
+import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
 import Simplex.Messaging.Util (tshow)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
@@ -156,9 +157,12 @@ ntfServerCLI cfgPath logPath =
                       checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
                     },
               storeLogFile = enableStoreLog $> storeLogFilePath,
-              caCertificateFile = c caCrtFile,
-              privateKeyFile = c serverKeyFile,
-              certificateFile = c serverCrtFile,
+              ntfCredentials =
+                ServerCredentials
+                  { caCertificateFile = Just $ c caCrtFile,
+                    privateKeyFile = c serverKeyFile,
+                    certificateFile = c serverCrtFile
+                  },
               logStatsInterval = logStats $> 86400, -- seconds
               logStatsStartTime = 0, -- seconds from 00:00 UTC
               serverStatsLogFile = combine logPath "ntf-server-stats.daily.log",
@@ -166,8 +170,7 @@ ntfServerCLI cfgPath logPath =
               ntfServerVRange = supportedServerNTFVRange,
               transportConfig =
                 defaultTransportServerConfig
-                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini,
-                    alpn = Just supportedNTFHandshakes
+                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
                   }
             }
 
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 599938ab6..5a5ae12fd 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -146,11 +146,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
   where
     runServer :: (ServiceName, ATransport) -> M ()
     runServer (tcpPort, ATransport t) = do
-      serverParams <- asks tlsServerParams
+      srvCreds <- asks tlsServerCreds
       ss <- asks sockets
-      serverSignKey <- either fail pure . fromTLSCredentials $ tlsServerCredentials serverParams
+      serverSignKey <- either fail pure $ fromTLSCredentials srvCreds
       env <- ask
-      liftIO $ runTransportServerState ss started tcpPort serverParams tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
+      liftIO $ runTransportServerState ss started tcpPort defaultSupportedParams srvCreds (Just supportedSMPHandshakes) tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
     fromTLSCredentials (_, pk) = C.x509ToPrivate (pk, []) >>= C.privKey
 
     saveServer :: Bool -> M ()
diff --git a/src/Simplex/Messaging/Server/CLI.hs b/src/Simplex/Messaging/Server/CLI.hs
index 0ae228496..f02612274 100644
--- a/src/Simplex/Messaging/Server/CLI.hs
+++ b/src/Simplex/Messaging/Server/CLI.hs
@@ -29,7 +29,7 @@ import Options.Applicative
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI)
 import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..))
-import Simplex.Messaging.Transport.Server (loadFingerprint)
+import Simplex.Messaging.Transport.Server (loadFileFingerprint)
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (eitherToMaybe, whenM)
 import System.Directory (doesDirectoryExist, listDirectory, removeDirectoryRecursive, removePathForcibly)
@@ -139,7 +139,7 @@ createServerX509_ createCA cfgPath x509cfg = do
         )
 
     saveFingerprint = do
-      Fingerprint fp <- loadFingerprint $ c caCrtFile
+      Fingerprint fp <- loadFileFingerprint $ c caCrtFile
       withFile (c fingerprintFile) WriteMode (`B.hPutStrLn` strEncode fp)
       pure fp
 
@@ -268,7 +268,7 @@ settingIsOn section name ini
 checkSavedFingerprint :: FilePath -> X509Config -> IO ByteString
 checkSavedFingerprint cfgPath x509cfg = do
   savedFingerprint <- withFile (c fingerprintFile) ReadMode hGetLine
-  Fingerprint fp <- loadFingerprint (c caCrtFile)
+  Fingerprint fp <- loadFileFingerprint (c caCrtFile)
   when (B.pack savedFingerprint /= strEncode fp) $
     exitError "Stored fingerprint is invalid."
   pure fp
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 9413ef24e..214cecd19 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -41,7 +41,7 @@ import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport, VersionRangeSMP, VersionSMP)
-import Simplex.Messaging.Transport.Server (SocketState, TransportServerConfig, alpn, loadFingerprint, loadTLSServerParams, newSocketState)
+import Simplex.Messaging.Transport.Server (ServerCredentials, SocketState, TransportServerConfig, loadFingerprint, loadServerCredential, newSocketState)
 import System.IO (IOMode (..))
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
@@ -78,10 +78,7 @@ data ServerConfig = ServerConfig
     serverStatsBackupFile :: Maybe FilePath,
     -- | interval between sending pending END events to unsubscribed clients, seconds
     pendingENDInterval :: Int,
-    -- | CA certificate private key is not needed for initialization
-    caCertificateFile :: FilePath,
-    privateKeyFile :: FilePath,
-    certificateFile :: FilePath,
+    smpCredentials :: ServerCredentials,
     -- | SMP client-server protocol version range
     smpServerVRange :: VersionRangeSMP,
     -- | TCP transport config
@@ -125,7 +122,7 @@ data Env = Env
     msgStore :: STMMsgStore,
     random :: TVar ChaChaDRG,
     storeLog :: Maybe (StoreLog 'WriteMode),
-    tlsServerParams :: T.ServerParams,
+    tlsServerCreds :: T.Credential,
     serverStats :: ServerStats,
     sockets :: SocketState,
     clientSeq :: TVar ClientId,
@@ -220,7 +217,7 @@ newProhibitedSub = do
   return Sub {subThread = ProhibitSub, delivered}
 
 newEnv :: ServerConfig -> IO Env
-newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile, storeLogFile, smpAgentCfg, transportConfig, information, messageExpiration} = do
+newEnv config@ServerConfig {smpCredentials, storeLogFile, smpAgentCfg, information, messageExpiration} = do
   server <- newServer
   queueStore <- newQueueStore
   msgStore <- newMsgStore
@@ -229,15 +226,15 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
     forM storeLogFile $ \f -> do
       logInfo $ "restoring queues from file " <> T.pack f
       restoreQueues queueStore f
-  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
-  Fingerprint fp <- loadFingerprint caCertificateFile
+  tlsServerCreds <- loadServerCredential smpCredentials
+  Fingerprint fp <- loadFingerprint smpCredentials
   let serverIdentity = KeyHash fp
   serverStats <- newServerStats =<< getCurrentTime
   sockets <- newSocketState
   clientSeq <- newTVarIO 0
   clients <- newTVarIO mempty
   proxyAgent <- newSMPProxyAgent smpAgentCfg random
-  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerParams, serverStats, sockets, clientSeq, clients, proxyAgent}
+  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
   where
     restoreQueues :: QueueStore -> FilePath -> IO (StoreLog 'WriteMode)
     restoreQueues QueueStore {queues, senders, notifiers} f = do
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index a5106c125..6cee2abd1 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Messaging.Server.Main where
 
@@ -40,9 +41,9 @@ import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defMsgExpirationDays, defaultInactiveClientExpiration, defaultMessageExpiration, defaultProxyClientConcurrency)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
-import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedSMPHandshakes, supportedServerSMPRelayVRange)
+import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedServerSMPRelayVRange)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
-import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
+import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow)
 import Simplex.Messaging.Version (mkVersionRange)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
@@ -260,9 +261,12 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
               msgQueueQuota = 128,
               queueIdBytes = 24,
               msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
-              caCertificateFile = c caCrtFile,
-              privateKeyFile = c serverKeyFile,
-              certificateFile = c serverCrtFile,
+              smpCredentials =
+                ServerCredentials
+                  { caCertificateFile = Just $ c caCrtFile,
+                    privateKeyFile = c serverKeyFile,
+                    certificateFile = c serverCrtFile
+                  },
               storeLogFile = enableStoreLog $> storeLogFilePath,
               storeMsgsFile =
                 let messagesPath = combine logPath "smp-server-messages.log"
@@ -295,8 +299,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
               smpServerVRange = supportedServerSMPRelayVRange,
               transportConfig =
                 defaultTransportServerConfig
-                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini,
-                    alpn = Just supportedSMPHandshakes
+                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
                   },
               controlPort = eitherToMaybe $ T.unpack <$> lookupValue "TRANSPORT" "control_port" ini,
               smpAgentCfg =
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index bc7cc85dd..0a005f046 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -65,7 +65,7 @@ module Simplex.Messaging.Transport
     ALPN,
     connectTLS,
     closeTLS,
-    supportedParameters,
+    defaultSupportedParams,
     withTlsUnique,
 
     -- * SMP transport
@@ -312,8 +312,8 @@ closeTLS ctx =
     `E.finally` T.contextClose ctx
     `catchAll_` pure ()
 
-supportedParameters :: T.Supported
-supportedParameters =
+defaultSupportedParams :: T.Supported
+defaultSupportedParams =
   def
     { T.supportedVersions = [T.TLS13, T.TLS12],
       T.supportedCiphers =
diff --git a/src/Simplex/Messaging/Transport/Client.hs b/src/Simplex/Messaging/Transport/Client.hs
index a23c68dd7..3b80b7f73 100644
--- a/src/Simplex/Messaging/Transport/Client.hs
+++ b/src/Simplex/Messaging/Transport/Client.hs
@@ -142,7 +142,7 @@ clientTransportConfig TransportClientConfig {logTLSErrors} =
 
 -- | Connect to passed TCP host:port and pass handle to the client.
 runTransportClient :: Transport c => TransportClientConfig -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a
-runTransportClient = runTLSTransportClient supportedParameters Nothing
+runTransportClient = runTLSTransportClient defaultSupportedParams Nothing
 
 runTLSTransportClient :: Transport c => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a
 runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials, alpn} socksCreds host port keyHash client = do
diff --git a/src/Simplex/Messaging/Transport/Credentials.hs b/src/Simplex/Messaging/Transport/Credentials.hs
index 90089f9ef..3c82b2f78 100644
--- a/src/Simplex/Messaging/Transport/Credentials.hs
+++ b/src/Simplex/Messaging/Transport/Credentials.hs
@@ -32,8 +32,8 @@ import qualified Time.System as Hourglass
 --   leaf <- genCredentials (Just ca) (0, 1) "Entity" -- session-signing cert
 --   pure $ tlsCredentials (leaf :| [ca])
 -- @
-tlsCredentials :: NonEmpty Credentials -> (C.KeyHash, TLS.Credentials)
-tlsCredentials credentials = (C.KeyHash rootFP, TLS.Credentials [(X509.CertificateChain certs, privateToTls $ snd leafKey)])
+tlsCredentials :: NonEmpty Credentials -> (C.KeyHash, TLS.Credential)
+tlsCredentials credentials = (C.KeyHash rootFP, (X509.CertificateChain certs, privateToTls $ snd leafKey))
   where
     Fingerprint rootFP = getFingerprint root X509.HashSHA256
     leafKey = fst $ L.head credentials
diff --git a/src/Simplex/Messaging/Transport/HTTP2/Server.hs b/src/Simplex/Messaging/Transport/HTTP2/Server.hs
index f8ea1bd1d..7dbed97ef 100644
--- a/src/Simplex/Messaging/Transport/HTTP2/Server.hs
+++ b/src/Simplex/Messaging/Transport/HTTP2/Server.hs
@@ -15,7 +15,7 @@ import Numeric.Natural (Natural)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (ALPN, SessionId, TLS, closeConnection, tlsALPN, tlsUniq)
 import Simplex.Messaging.Transport.HTTP2
-import Simplex.Messaging.Transport.Server (TransportServerConfig (..), loadSupportedTLSServerParams, runTransportServer)
+import Simplex.Messaging.Transport.Server (ServerCredentials, TransportServerConfig (..), loadServerCredential, runTransportServer)
 import Simplex.Messaging.Util (threadDelay')
 import UnliftIO (finally)
 import UnliftIO.Concurrent (forkIO, killThread)
@@ -28,9 +28,7 @@ data HTTP2ServerConfig = HTTP2ServerConfig
     bufferSize :: BufferSize,
     bodyHeadSize :: Int,
     serverSupported :: T.Supported,
-    caCertificateFile :: FilePath,
-    privateKeyFile :: FilePath,
-    certificateFile :: FilePath,
+    https2Credentials :: ServerCredentials,
     transportConfig :: TransportServerConfig
   }
   deriving (Show)
@@ -49,13 +47,13 @@ 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, transportConfig} = do
-  tlsServerParams <- loadSupportedTLSServerParams serverSupported caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
+getHTTP2Server :: HTTP2ServerConfig -> Maybe [ALPN] -> IO HTTP2Server
+getHTTP2Server HTTP2ServerConfig {qSize, http2Port, bufferSize, bodyHeadSize, serverSupported, https2Credentials, transportConfig} alpn_ = do
+  srvCreds <- loadServerCredential https2Credentials
   started <- newEmptyTMVarIO
   reqQ <- newTBQueueIO qSize
   action <- async $
-    runHTTP2Server started http2Port bufferSize tlsServerParams transportConfig Nothing (const $ pure ()) $ \sessionId sessionALPN r sendResponse -> do
+    runHTTP2Server started http2Port bufferSize serverSupported srvCreds alpn_ transportConfig Nothing (const $ pure ()) $ \sessionId sessionALPN r sendResponse -> do
       reqBody <- getHTTP2Body r bodyHeadSize
       atomically $ writeTBQueue reqQ HTTP2Request {sessionId, sessionALPN, request = r, reqBody, sendResponse}
   void . atomically $ takeTMVar started
@@ -64,10 +62,10 @@ getHTTP2Server HTTP2ServerConfig {qSize, http2Port, bufferSize, bodyHeadSize, se
 closeHTTP2Server :: HTTP2Server -> IO ()
 closeHTTP2Server = uninterruptibleCancel . action
 
-runHTTP2Server :: TMVar Bool -> ServiceName -> BufferSize -> T.ServerParams -> TransportServerConfig -> Maybe ExpirationConfig -> (SessionId -> IO ()) -> HTTP2ServerFunc -> IO ()
-runHTTP2Server started port bufferSize serverParams transportConfig expCfg_ clientFinished = runHTTP2ServerWith_ expCfg_ clientFinished bufferSize setup
+runHTTP2Server :: TMVar Bool -> ServiceName -> BufferSize -> T.Supported -> T.Credential -> Maybe [ALPN] -> TransportServerConfig -> Maybe ExpirationConfig -> (SessionId -> IO ()) -> HTTP2ServerFunc -> IO ()
+runHTTP2Server started port bufferSize srvSupported srvCreds alpn_ transportConfig expCfg_ clientFinished = runHTTP2ServerWith_ expCfg_ clientFinished bufferSize setup
   where
-    setup = runTransportServer started port serverParams transportConfig
+    setup = runTransportServer started port srvSupported srvCreds alpn_ transportConfig
 
 runHTTP2ServerWith :: BufferSize -> ((TLS -> IO ()) -> a) -> HTTP2ServerFunc -> a
 runHTTP2ServerWith = runHTTP2ServerWith_ Nothing (\_sessId -> pure ())
diff --git a/src/Simplex/Messaging/Transport/Server.hs b/src/Simplex/Messaging/Transport/Server.hs
index 28d4d354d..5c3be519c 100644
--- a/src/Simplex/Messaging/Transport/Server.hs
+++ b/src/Simplex/Messaging/Transport/Server.hs
@@ -6,6 +6,7 @@
 
 module Simplex.Messaging.Transport.Server
   ( TransportServerConfig (..),
+    ServerCredentials (..),
     defaultTransportServerConfig,
     runTransportServerState,
     SocketState,
@@ -15,11 +16,12 @@ module Simplex.Messaging.Transport.Server
     runLocalTCPServer,
     runTCPServerSocket,
     startTCPServer,
-    loadSupportedTLSServerParams,
-    loadTLSServerParams,
+    loadServerCredential,
+    supportedTLSServerParams,
+    supportedTLSServerParams_,
     loadFingerprint,
+    loadFileFingerprint,
     smpServerHandshake,
-    tlsServerCredentials,
   )
 where
 
@@ -31,7 +33,7 @@ import Data.Default (def)
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IM
 import Data.List (find)
-import Data.Maybe (fromJust, fromMaybe)
+import Data.Maybe (fromJust, fromMaybe, maybeToList)
 import qualified Data.X509 as X
 import Data.X509.Validation (Fingerprint (..))
 import qualified Data.X509.Validation as XV
@@ -52,18 +54,23 @@ import UnliftIO.STM
 data TransportServerConfig = TransportServerConfig
   { logTLSErrors :: Bool,
     tlsSetupTimeout :: Int,
-    transportTimeout :: Int,
-    alpn :: Maybe [ALPN]
+    transportTimeout :: Int
   }
   deriving (Eq, Show)
 
+data ServerCredentials = ServerCredentials
+  { caCertificateFile :: Maybe FilePath, -- CA certificate private key is not needed for initialization
+    privateKeyFile :: FilePath,
+    certificateFile :: FilePath
+  }
+  deriving (Show)
+
 defaultTransportServerConfig :: TransportServerConfig
 defaultTransportServerConfig =
   TransportServerConfig
     { logTLSErrors = True,
       tlsSetupTimeout = 60000000,
-      transportTimeout = 40000000,
-      alpn = Nothing
+      transportTimeout = 40000000
     }
 
 serverTransportConfig :: TransportServerConfig -> TransportConfig
@@ -74,23 +81,29 @@ serverTransportConfig TransportServerConfig {logTLSErrors} =
 -- | 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. Transport c => TMVar Bool -> ServiceName -> T.ServerParams -> TransportServerConfig -> (c -> IO ()) -> IO ()
-runTransportServer started port params cfg server = do
+runTransportServer :: forall c. Transport c => TMVar Bool -> ServiceName -> T.Supported -> T.Credential -> Maybe [ALPN] -> TransportServerConfig -> (c -> IO ()) -> IO ()
+runTransportServer started port srvSupported srvCreds alpn_ cfg server = do
   ss <- newSocketState
-  runTransportServerState ss started port params cfg server
+  runTransportServerState ss started port srvSupported srvCreds alpn_ cfg server
 
-runTransportServerState :: forall c . Transport c => SocketState -> TMVar Bool -> ServiceName -> T.ServerParams -> TransportServerConfig -> (c -> IO ()) -> IO ()
+runTransportServerState :: forall c . Transport c => SocketState -> TMVar Bool -> ServiceName -> T.Supported -> T.Credential -> Maybe [ALPN] -> TransportServerConfig -> (c -> IO ()) -> IO ()
 runTransportServerState ss started port = runTransportServerSocketState ss started (startTCPServer started Nothing port) (transportName (TProxy :: TProxy c))
 
 -- | Run a transport server with provided connection setup and handler.
-runTransportServerSocket :: Transport a => TMVar Bool -> IO Socket -> String -> T.ServerParams -> TransportServerConfig -> (a -> IO ()) -> IO ()
-runTransportServerSocket started getSocket threadLabel serverParams cfg server = do
+runTransportServerSocket :: Transport a => TMVar Bool -> IO Socket -> String -> T.Credential -> T.ServerParams -> TransportServerConfig -> (a -> IO ()) -> IO ()
+runTransportServerSocket started getSocket threadLabel srvCreds srvParams cfg server = do
   ss <- newSocketState
-  runTransportServerSocketState ss started getSocket threadLabel serverParams cfg server
+  runTransportServerSocketState_ ss started getSocket threadLabel srvCreds srvParams cfg server
+
+runTransportServerSocketState :: Transport a => SocketState -> TMVar Bool -> IO Socket -> String -> T.Supported -> (X.CertificateChain, X.PrivKey) -> Maybe [ALPN] -> TransportServerConfig -> (a -> IO ()) -> IO ()
+runTransportServerSocketState ss started getSocket threadLabel srvSupported srvCreds alpn_ =
+  runTransportServerSocketState_ ss started getSocket threadLabel srvCreds srvParams
+  where
+    srvParams = supportedTLSServerParams_ srvSupported srvCreds alpn_
 
 -- | Run a transport server with provided connection setup and handler.
-runTransportServerSocketState :: Transport a => SocketState -> TMVar Bool -> IO Socket -> String -> T.ServerParams -> TransportServerConfig -> (a -> IO ()) -> IO ()
-runTransportServerSocketState ss started getSocket threadLabel serverParams cfg server = do
+runTransportServerSocketState_ :: Transport a => SocketState -> TMVar Bool -> IO Socket -> String -> (X.CertificateChain, X.PrivKey) -> T.ServerParams -> TransportServerConfig -> (a -> IO ()) -> IO ()
+runTransportServerSocketState_ ss started getSocket threadLabel srvCreds srvParams cfg server = do
   labelMyThread $ "transport server for " <> threadLabel
   runTCPServerSocket ss started getSocket $ \conn ->
     E.bracket (setup conn >>= maybe (fail "tls setup timeout") pure) closeConnection server
@@ -98,13 +111,8 @@ runTransportServerSocketState ss started getSocket threadLabel serverParams cfg
     tCfg = serverTransportConfig cfg
     setup conn = timeout (tlsSetupTimeout cfg) $ do
       labelMyThread $ threadLabel <> "/setup"
-      tls <- connectTLS Nothing tCfg serverParams conn
-      getServerConnection tCfg (fst $ tlsServerCredentials serverParams) tls
-
-tlsServerCredentials :: T.ServerParams -> (X.CertificateChain, X.PrivKey)
-tlsServerCredentials serverParams = case T.sharedCredentials $ T.serverShared serverParams of
-  T.Credentials [creds] -> creds
-  _ -> error "server has more than one key"
+      tls <- connectTLS Nothing tCfg srvParams conn
+      getServerConnection tCfg (fst srvCreds) tls
 
 -- | Run TCP server without TLS
 runLocalTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
@@ -176,30 +184,33 @@ startTCPServer started host port = withSocketsDo $ resolve >>= open >>= setStart
       pure sock
     setStarted sock = atomically (tryPutTMVar started True) >> pure sock
 
-loadTLSServerParams :: FilePath -> FilePath -> FilePath -> Maybe [ALPN] -> IO T.ServerParams
-loadTLSServerParams = loadSupportedTLSServerParams supportedParameters
+loadServerCredential :: ServerCredentials -> IO T.Credential
+loadServerCredential ServerCredentials {caCertificateFile, certificateFile, privateKeyFile} =
+  T.credentialLoadX509Chain certificateFile (maybeToList caCertificateFile) privateKeyFile >>= \case
+    Right credential -> pure credential
+    Left _ -> putStrLn "invalid credential" >> exitFailure
 
-loadSupportedTLSServerParams :: T.Supported -> FilePath -> FilePath -> FilePath -> Maybe [ALPN] -> IO T.ServerParams
-loadSupportedTLSServerParams serverSupported caCertificateFile certificateFile privateKeyFile alpn_ = do
-  tlsServerParams <- fromCredential <$> loadServerCredential
-  pure tlsServerParams {T.serverHooks = maybe def alpnHooks alpn_}
-  where
-    loadServerCredential :: IO T.Credential
-    loadServerCredential =
-      T.credentialLoadX509Chain certificateFile [caCertificateFile] privateKeyFile >>= \case
-        Right credential -> pure credential
-        Left _ -> putStrLn "invalid credential" >> exitFailure
-    fromCredential :: T.Credential -> T.ServerParams
-    fromCredential credential =
-      def
-        { T.serverWantClientCert = False,
-          T.serverShared = def {T.sharedCredentials = T.Credentials [credential]},
-          T.serverHooks = def,
-          T.serverSupported = serverSupported
-        }
-    alpnHooks supported = def {T.onALPNClientSuggest = Just $ pure . fromMaybe "" . find (`elem` supported)}
+supportedTLSServerParams :: T.Credential -> Maybe [ALPN] -> T.ServerParams
+supportedTLSServerParams = supportedTLSServerParams_ defaultSupportedParams
 
-loadFingerprint :: FilePath -> IO Fingerprint
-loadFingerprint certificateFile = do
+supportedTLSServerParams_ :: T.Supported -> T.Credential -> Maybe [ALPN] -> T.ServerParams
+supportedTLSServerParams_ serverSupported credential alpn_ =
+  def
+    { T.serverWantClientCert = False,
+      T.serverHooks =
+        def
+          { T.onServerNameIndication = \_ -> pure $ T.Credentials [credential],
+            T.onALPNClientSuggest = (\alpn -> pure . fromMaybe "" . find (`elem` alpn)) <$> alpn_
+          },
+      T.serverSupported = serverSupported
+    }
+
+loadFingerprint :: ServerCredentials -> IO Fingerprint
+loadFingerprint ServerCredentials {caCertificateFile} = case caCertificateFile of
+  Just certificateFile -> loadFileFingerprint certificateFile
+  Nothing -> error "CA file must be used in protocol credentials"
+
+loadFileFingerprint :: FilePath -> IO Fingerprint
+loadFileFingerprint certificateFile = do
   (cert : _) <- SX.readSignedObject certificateFile
   pure $ XV.getFingerprint (cert :: X.SignedExact X.Certificate) X.HashSHA256
diff --git a/src/Simplex/RemoteControl/Client.hs b/src/Simplex/RemoteControl/Client.hs
index 1c0ef94cc..acb86602c 100644
--- a/src/Simplex/RemoteControl/Client.hs
+++ b/src/Simplex/RemoteControl/Client.hs
@@ -190,7 +190,7 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct
               }
       pure $ signInvitation (snd sessKeys) idPrivKey inv
 
-genTLSCredentials :: TVar ChaChaDRG -> C.APrivateSignKey -> C.SignedCertificate -> IO TLS.Credentials
+genTLSCredentials :: TVar ChaChaDRG -> C.APrivateSignKey -> C.SignedCertificate -> IO TLS.Credential
 genTLSCredentials drg caKey caCert = do
   let caCreds = (C.signatureKeyPair caKey, caCert)
   leaf <- genCredentials drg (Just caCreds) (0, 24 * 999999) "localhost" -- session-signing cert
@@ -282,10 +282,7 @@ connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca,
       pure RCCClient_ {confirmSession, endSession}
     runClient :: RCCClient_ -> RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> ExceptT RCErrorType IO ()
     runClient RCCClient_ {confirmSession, endSession} r = do
-      clientCredentials <-
-        liftIO (genTLSCredentials drg caKey caCert) >>= \case
-          TLS.Credentials (creds : _) -> pure $ Just creds
-          _ -> throwE $ RCEInternal "genTLSCredentials must generate credentials"
+      clientCredentials <- liftIO $ Just <$> genTLSCredentials drg caKey caCert
       let clientConfig = defaultTransportClientConfig {clientCredentials}
       ExceptT . runTransportClient clientConfig Nothing host (show port) (Just ca) $ \tls@TLS {tlsBuffer, tlsContext} -> runExceptT $ do
         -- pump socket to detect connection problems
diff --git a/src/Simplex/RemoteControl/Discovery.hs b/src/Simplex/RemoteControl/Discovery.hs
index 8ee76c651..d0a326bba 100644
--- a/src/Simplex/RemoteControl/Discovery.hs
+++ b/src/Simplex/RemoteControl/Discovery.hs
@@ -23,7 +23,7 @@ import Network.Info (IPv4 (..), NetworkInterface (..), getNetworkInterfaces)
 import qualified Network.Socket as N
 import qualified Network.TLS as TLS
 import qualified Network.UDP as UDP
-import Simplex.Messaging.Transport (supportedParameters)
+import Simplex.Messaging.Transport (defaultSupportedParams)
 import qualified Simplex.Messaging.Transport as Transport
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTransportServerSocket, startTCPServer)
@@ -68,7 +68,7 @@ preferAddress RCCtrlAddress {address, interface} addrs =
     matchAddr RCCtrlAddress {address = a} = a == address
     matchIface RCCtrlAddress {interface = i} = i == interface
 
-startTLSServer :: Maybe Word16 -> TMVar (Maybe N.PortNumber) -> TLS.Credentials -> TLS.ServerHooks -> (Transport.TLS -> IO ()) -> IO (Async ())
+startTLSServer :: Maybe Word16 -> TMVar (Maybe N.PortNumber) -> TLS.Credential -> TLS.ServerHooks -> (Transport.TLS -> IO ()) -> IO (Async ())
 startTLSServer port_ startedOnPort credentials hooks server = async . liftIO $ do
   started <- newEmptyTMVarIO
   bracketOnError (startTCPServer started Nothing $ maybe "0" show port_) (\_e -> setPort Nothing) $ \socket ->
@@ -81,14 +81,14 @@ startTLSServer port_ startedOnPort credentials hooks server = async . liftIO $ d
       port <- N.socketPort socket
       logInfo $ "System-assigned port: " <> tshow port
       setPort $ Just port
-      runTransportServerSocket started (pure socket) "RCP TLS" serverParams defaultTransportServerConfig server
+      runTransportServerSocket started (pure socket) "RCP TLS" credentials serverParams defaultTransportServerConfig server
     setPort = void . atomically . tryPutTMVar startedOnPort
     serverParams =
       def
         { TLS.serverWantClientCert = True,
-          TLS.serverShared = def {TLS.sharedCredentials = credentials},
+          TLS.serverShared = def {TLS.sharedCredentials = TLS.Credentials [credentials]},
           TLS.serverHooks = hooks,
-          TLS.serverSupported = supportedParameters
+          TLS.serverSupported = defaultSupportedParams
         }
 
 withSender :: (UDP.UDPSocket -> IO a) -> IO a
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index c263bc016..accaa4d37 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -45,7 +45,6 @@ import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), http2TLSParams)
 import Simplex.Messaging.Transport.HTTP2.Server
 import Simplex.Messaging.Transport.Server
-import qualified Simplex.Messaging.Transport.Server as Server
 import Test.Hspec
 import UnliftIO.Async
 import UnliftIO.Concurrent
@@ -96,17 +95,19 @@ ntfServerCfg =
       subsBatchSize = 900,
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
       storeLogFile = Nothing,
-      -- CA certificate private key is not needed for initialization
-      caCertificateFile = "tests/fixtures/ca.crt",
-      privateKeyFile = "tests/fixtures/server.key",
-      certificateFile = "tests/fixtures/server.crt",
+      ntfCredentials =
+        ServerCredentials
+          { caCertificateFile = Just "tests/fixtures/ca.crt",
+            privateKeyFile = "tests/fixtures/server.key",
+            certificateFile = "tests/fixtures/server.crt"
+          },
       -- stats config
       logStatsInterval = Nothing,
       logStatsStartTime = 0,
       serverStatsLogFile = "tests/ntf-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
       ntfServerVRange = supportedServerNTFVRange,
-      transportConfig = defaultTransportServerConfig {Server.alpn = Just supportedNTFHandshakes}
+      transportConfig = defaultTransportServerConfig
     }
 
 ntfServerCfgVPrev :: NtfServerConfig
@@ -185,9 +186,12 @@ apnsMockServerConfig =
       bufferSize = 16384,
       bodyHeadSize = 16384,
       serverSupported = http2TLSParams,
-      caCertificateFile = "tests/fixtures/ca.crt",
-      privateKeyFile = "tests/fixtures/server.key",
-      certificateFile = "tests/fixtures/server.crt",
+      https2Credentials =
+        ServerCredentials
+          { caCertificateFile = Just "tests/fixtures/ca.crt",
+            privateKeyFile = "tests/fixtures/server.key",
+            certificateFile = "tests/fixtures/server.crt"
+          },
       transportConfig = defaultTransportServerConfig
     }
 
@@ -219,7 +223,7 @@ deriving instance ToJSON APNSErrorResponse
 
 getAPNSMockServer :: HTTP2ServerConfig -> IO APNSMockServer
 getAPNSMockServer config@HTTP2ServerConfig {qSize} = do
-  http2Server <- getHTTP2Server config
+  http2Server <- getHTTP2Server config Nothing
   apnsQ <- newTBQueueIO qSize
   action <- async $ runAPNSMockServer apnsQ http2Server
   pure APNSMockServer {action, apnsQ, http2Server}
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 472f9b6b4..2cf92640f 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -27,7 +27,6 @@ import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
 import qualified Simplex.Messaging.Transport.Client as Client
 import Simplex.Messaging.Transport.Server
-import qualified Simplex.Messaging.Transport.Server as Server
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
 import System.Environment (lookupEnv)
@@ -116,11 +115,14 @@ cfg =
       serverStatsLogFile = "tests/smp-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
       pendingENDInterval = 500000,
-      caCertificateFile = "tests/fixtures/ca.crt",
-      privateKeyFile = "tests/fixtures/server.key",
-      certificateFile = "tests/fixtures/server.crt",
+      smpCredentials =
+        ServerCredentials
+          { caCertificateFile = Just "tests/fixtures/ca.crt",
+            privateKeyFile = "tests/fixtures/server.key",
+            certificateFile = "tests/fixtures/server.crt"
+          },
       smpServerVRange = supportedServerSMPRelayVRange,
-      transportConfig = defaultTransportServerConfig {Server.alpn = Just supportedSMPHandshakes},
+      transportConfig = defaultTransportServerConfig,
       controlPort = Nothing,
       smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 1}, -- seconds
       allowSMPProxy = False,
diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index 9803cb8b9..a425e1bdb 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -24,7 +24,7 @@ import SMPClient (xit'')
 import Simplex.FileTransfer.Client (XFTPClientConfig (..))
 import Simplex.FileTransfer.Description (FileChunk (..), FileDescription (..), FileDescriptionURI (..), ValidFileDescription, fileDescriptionURI, kb, mb, qrSizeLimit, pattern ValidFileDescription)
 import Simplex.FileTransfer.Protocol (FileParty (..))
-import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
+import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), supportedXFTPhandshakes)
 import Simplex.FileTransfer.Transport (XFTPErrorType (AUTH))
 import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
 import Simplex.Messaging.Agent (AgentClient, testProtocolServer, xftpDeleteRcvFile, xftpDeleteSndFileInternal, xftpDeleteSndFileRemote, xftpReceiveFile, xftpSendDescription, xftpSendFile, xftpStartWorkers)
@@ -37,6 +37,7 @@ import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Protocol (BasicAuth, ProtoServerWithAuth (..), ProtocolServer (..), XFTPServerWithAuth)
 import Simplex.Messaging.Server.Expiration (ExpirationConfig (..))
+import Simplex.Messaging.Transport (ALPN)
 import Simplex.Messaging.Util (tshow)
 import System.Directory (doesDirectoryExist, doesFileExist, getFileSize, listDirectory, removeFile)
 import System.FilePath ((</>))
@@ -257,11 +258,11 @@ testXFTPAgentSendReceiveMatrix = do
   where
     oldClient = agentCfg {xftpCfg = (xftpCfg agentCfg) {clientALPN = Nothing}}
     newClient = agentCfg
-    oldServer = testXFTPServerConfig_ Nothing
-    newServer = testXFTPServerConfig
-    run :: HasCallStack => XFTPServerConfig -> AgentConfig -> AgentConfig -> IO ()
-    run server sender receiver =
-      withXFTPServerCfg server $ \_t -> do
+    oldServer = Nothing
+    newServer = Just supportedXFTPhandshakes
+    run :: HasCallStack => Maybe [ALPN] -> AgentConfig -> AgentConfig -> IO ()
+    run alpn sender receiver =
+      withXFTPServerCfgALPN testXFTPServerConfig alpn $ \_t -> do
         filePath <- createRandomFile_ (kb 319 :: Integer) "testfile"
         rfd <- withAgent 1 sender initAgentServers testDB $ \sndr -> do
           (sfId, _, rfd1, _) <- runRight $ testSendCF' sndr (CF.plain filePath) (kb 320)
diff --git a/tests/XFTPClient.hs b/tests/XFTPClient.hs
index 398b6cd9f..bd7b23568 100644
--- a/tests/XFTPClient.hs
+++ b/tests/XFTPClient.hs
@@ -53,9 +53,12 @@ withXFTPServerStoreLogOn :: HasCallStack => (HasCallStack => ThreadId -> IO a) -
 withXFTPServerStoreLogOn = withXFTPServerCfg testXFTPServerConfig {storeLogFile = Just testXFTPLogFile, serverStatsBackupFile = Just testXFTPStatsBackupFile}
 
 withXFTPServerCfg :: HasCallStack => XFTPServerConfig -> (HasCallStack => ThreadId -> IO a) -> IO a
-withXFTPServerCfg cfg =
+withXFTPServerCfg cfg = withXFTPServerCfgALPN cfg $ Just supportedXFTPhandshakes
+
+withXFTPServerCfgALPN :: HasCallStack => XFTPServerConfig -> Maybe [ALPN] -> (HasCallStack => ThreadId -> IO a) -> IO a
+withXFTPServerCfgALPN cfg alpn_ =
   serverBracket
-    (`runXFTPServerBlocking` cfg)
+    (\started -> runXFTPServerBlocking started cfg alpn_)
     (threadDelay 10000)
 
 withXFTPServerThreadOn :: HasCallStack => (HasCallStack => ThreadId -> IO a) -> IO a
@@ -98,10 +101,7 @@ testXFTPStatsBackupFile :: FilePath
 testXFTPStatsBackupFile = "tests/tmp/xftp-server-stats.log"
 
 testXFTPServerConfig :: XFTPServerConfig
-testXFTPServerConfig = testXFTPServerConfig_ (Just supportedXFTPhandshakes)
-
-testXFTPServerConfig_ :: Maybe [ALPN] -> XFTPServerConfig
-testXFTPServerConfig_ alpn =
+testXFTPServerConfig =
   XFTPServerConfig
     { xftpPort = xftpTestPort,
       controlPort = Nothing,
@@ -117,15 +117,18 @@ testXFTPServerConfig_ alpn =
       fileExpiration = Just defaultFileExpiration,
       fileTimeout = 10000000,
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
-      caCertificateFile = "tests/fixtures/ca.crt",
-      privateKeyFile = "tests/fixtures/server.key",
-      certificateFile = "tests/fixtures/server.crt",
+      xftpCredentials =
+        ServerCredentials
+          { caCertificateFile = Just "tests/fixtures/ca.crt",
+            privateKeyFile = "tests/fixtures/server.key",
+            certificateFile = "tests/fixtures/server.crt"
+          },
       xftpServerVRange = supportedFileServerVRange,
       logStatsInterval = Nothing,
       logStatsStartTime = 0,
       serverStatsLogFile = "tests/tmp/xftp-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
-      transportConfig = defaultTransportServerConfig {alpn},
+      transportConfig = defaultTransportServerConfig,
       responseDelay = 0
     }
 

From 2a120dfe57ee84894be3ad98fc014f9b68084922 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 28 Sep 2024 23:15:17 +0100
Subject: [PATCH 128/195] smp server: Allow serving HTTPS and transport on the
 same port (v2) (#1327)

* smp-server: Allow serving HTTPS and transport on the same port

* update rfc

* servers: refactor TLS credentials

* provide server credentials in SNI hook

* determine TLS server params dynamically, when starting the server

* remove alpn from TransportServerConfig to decide it dynamically where server is started

* diff

* combine HTTP and SMP on the shared port

* Update to SockAddr

* Fix params and web.https parser

* Switch fork urls

* WIP: add smpServerTestStatic test

* Update warp-tls repo

* shared connection tests

* cleanup

* Add protocol tests

* rename cert file, enable both ports and web by default

* terminate with message on missing credentials

* test cert file

* client option to use port 443 as default SMP port

* use SNI in non-SMP clients

* supported

* remove TODO

* advice

* fix test build

* Add RSA-4096 check for web creds, fix test

* Remove directory listing from static app

* message

* messages

* update log tests

---------

Co-authored-by: IC Rainbow <aenor.realm@gmail.com>
---
 apps/smp-server/Main.hs                       |   2 +-
 apps/smp-server/web/Static.hs                 |  49 +++++-
 cabal.project                                 |  14 ++
 package.yaml                                  |  21 ++-
 rfcs/2024-09-15-shared-port.md                | 163 ++++++++++++++++++
 simplexmq.cabal                               |  16 +-
 src/Simplex/FileTransfer/Client.hs            |   2 +-
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |   7 +-
 src/Simplex/Messaging/Client.hs               |  36 ++--
 src/Simplex/Messaging/Client/Agent.hs         |   2 +-
 src/Simplex/Messaging/Notifications/Client.hs |   7 +-
 src/Simplex/Messaging/Notifications/Server.hs |   6 +-
 .../Messaging/Notifications/Server/Env.hs     |   4 +-
 src/Simplex/Messaging/Server.hs               |  45 +++--
 src/Simplex/Messaging/Server/CLI.hs           |  18 +-
 src/Simplex/Messaging/Server/Env/STM.hs       |  40 ++++-
 src/Simplex/Messaging/Server/Main.hs          |  73 ++++----
 src/Simplex/Messaging/Transport.hs            |  29 +++-
 src/Simplex/Messaging/Transport/Client.hs     |  18 +-
 .../Messaging/Transport/HTTP2/Client.hs       |   3 +-
 src/Simplex/Messaging/Transport/Server.hs     |  27 +--
 tests/AgentTests/FunctionalAPITests.hs        |   2 +-
 tests/AgentTests/NotificationTests.hs         |   2 +-
 tests/CLITests.hs                             | 100 ++++++++++-
 tests/CoreTests/SOCKSSettings.hs              |   2 +-
 tests/NtfClient.hs                            |   4 +-
 tests/SMPClient.hs                            |   3 +-
 tests/fixtures/web.crt                        |  34 ++++
 tests/fixtures/web.key                        |  52 ++++++
 29 files changed, 655 insertions(+), 126 deletions(-)
 create mode 100644 rfcs/2024-09-15-shared-port.md
 create mode 100644 tests/fixtures/web.crt
 create mode 100644 tests/fixtures/web.key

diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs
index d0de4b4f1..9a9e094ea 100644
--- a/apps/smp-server/Main.hs
+++ b/apps/smp-server/Main.hs
@@ -19,4 +19,4 @@ main = do
   setLogLevel LogDebug
   cfgPath <- getEnvPath "SMP_SERVER_CFG_PATH" defaultCfgPath
   logPath <- getEnvPath "SMP_SERVER_LOG_PATH" defaultLogPath
-  withGlobalLogging logCfg $ smpServerCLI_ Static.generateSite Static.serveStaticFiles cfgPath logPath
+  withGlobalLogging logCfg $ smpServerCLI_ Static.generateSite Static.serveStaticFiles Static.attachStaticFiles cfgPath logPath
diff --git a/apps/smp-server/web/Static.hs b/apps/smp-server/web/Static.hs
index 4d25f2067..266ad663e 100644
--- a/apps/smp-server/web/Static.hs
+++ b/apps/smp-server/web/Static.hs
@@ -8,13 +8,18 @@ import Control.Logger.Simple
 import Control.Monad
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
+import Data.IORef (readIORef)
 import Data.Maybe (fromMaybe)
 import Data.String (fromString)
 import Data.Text.Encoding (encodeUtf8)
-import Network.Wai.Application.Static as S
-import Network.Wai.Handler.Warp as W
-import qualified Network.Wai.Handler.WarpTLS as W
+import Network.Socket (getPeerName)
+import Network.Wai (Application)
+import qualified Network.Wai.Application.Static as S
+import qualified Network.Wai.Handler.Warp as W
+import qualified Network.Wai.Handler.Warp.Internal as WI
+import qualified Network.Wai.Handler.WarpTLS as WT
 import Simplex.Messaging.Encoding.String (strEncode)
+import Simplex.Messaging.Server (AttachHTTP)
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..))
 import Simplex.Messaging.Transport.Client (TransportHost (..))
@@ -23,6 +28,7 @@ import Static.Embedded as E
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath
 import UnliftIO.Concurrent (forkFinally)
+import UnliftIO.Exception (bracket, finally)
 
 serveStaticFiles :: EmbeddedWebParams -> IO ()
 serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams} = do
@@ -31,9 +37,42 @@ serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams}
     W.runSettings (mkSettings port) (S.staticApp $ S.defaultFileServerSettings webStaticPath)
   forM_ webHttpsParams $ \WebHttpsParams {port, cert, key} -> flip forkFinally (\e -> logError $ "HTTPS server crashed: " <> tshow e) $ do
     logInfo $ "Serving static site on port " <> tshow port <> " (TLS)"
-    W.runTLS (W.tlsSettings cert key) (mkSettings port) (S.staticApp $ S.defaultFileServerSettings webStaticPath)
+    WT.runTLS (WT.tlsSettings cert key) (mkSettings port) app
   where
-    mkSettings port = setPort port defaultSettings
+    app = staticFiles webStaticPath
+    mkSettings port = W.setPort port W.defaultSettings
+
+-- | Prepare context and prepare HTTP handler for TLS connections that already passed TLS.handshake and ALPN check.
+attachStaticFiles :: FilePath -> (AttachHTTP -> IO ()) -> IO ()
+attachStaticFiles path action =
+  -- Initialize global internal state for http server.
+  WI.withII settings $ \ii -> do
+    action $ \socket cxt -> do
+      -- Initialize internal per-connection resources.
+      addr <- getPeerName socket
+      withConnection addr cxt $ \(conn, transport) ->
+        withTimeout ii conn $ \th ->
+          -- Run Warp connection handler to process HTTP requests for static files.
+          WI.serveConnection conn ii th addr transport settings app
+  where
+    app = staticFiles path
+    settings = W.defaultSettings
+    -- from warp-tls
+    withConnection socket cxt = bracket (WT.attachConn socket cxt) (terminate . fst)
+    -- from warp
+    withTimeout ii conn =
+      bracket
+        (WI.registerKillThread (WI.timeoutManager ii) (WI.connClose conn))
+        WI.cancel
+    -- shared clean up
+    terminate conn = WI.connClose conn `finally` (readIORef (WI.connWriteBuffer conn) >>= WI.bufFree)
+
+staticFiles :: FilePath -> Application
+staticFiles root = S.staticApp settings
+  where
+    settings = (S.defaultFileServerSettings root)
+      { S.ssListing = Nothing
+      }
 
 generateSite :: ServerInformation -> Maybe TransportHost -> FilePath -> IO ()
 generateSite si onionHost sitePath = do
diff --git a/cabal.project b/cabal.project
index 43afe30ea..1a4745ffc 100644
--- a/cabal.project
+++ b/cabal.project
@@ -28,3 +28,17 @@ source-repository-package
     type: git
     location: https://github.com/simplex-chat/sqlcipher-simple.git
     tag: a46bd361a19376c5211f1058908fc0ae6bf42446
+
+-- waiting for published warp-tls-3.4.7
+source-repository-package
+    type: git
+    location: https://github.com/yesodweb/wai.git
+    tag: ec5e017d896a78e787a5acea62b37a4e677dec2e
+    subdir: warp-tls
+
+-- backported fork due http-5.0
+source-repository-package
+    type: git
+    location: https://github.com/simplex-chat/wai.git
+    tag: 2f6e5aa5f05ba9140ac99e195ee647b4f7d926b0
+    subdir: warp
diff --git a/package.yaml b/package.yaml
index 8699dce63..ce1c8efd4 100644
--- a/package.yaml
+++ b/package.yaml
@@ -123,9 +123,10 @@ executables:
     dependencies:
       - file-embed
       - simplexmq
+      - wai
       - wai-app-static
-      - warp
-      - warp-tls
+      - warp ==3.3.30 # the last one before http2-5.0
+      - warp-tls ==3.4.7 # extra internals exposed
     ghc-options:
       - -threaded
       - -rtsopts
@@ -159,19 +160,29 @@ executables:
 
 tests:
   simplexmq-test:
-    source-dirs: tests
+    source-dirs:
+    - tests
+    - apps/smp-server/web
     main: Test.hs
     dependencies:
-      - simplexmq
       - deepseq == 1.4.*
+      - file-embed
       - generic-random == 1.5.*
       - hspec == 2.11.*
       - hspec-core == 2.11.*
+      - http-client
+      - http-client-tls
       - HUnit == 1.6.*
+      - main-tester == 0.2.*
       - QuickCheck == 2.14.*
       - silently == 1.2.*
-      - main-tester == 0.2.*
+      - simplexmq
       - timeit == 2.0.*
+      - unordered-containers
+      - wai
+      - wai-app-static
+      - warp
+      - warp-tls
     ghc-options:
       - -threaded
       - -rtsopts
diff --git a/rfcs/2024-09-15-shared-port.md b/rfcs/2024-09-15-shared-port.md
new file mode 100644
index 000000000..67f55b3ca
--- /dev/null
+++ b/rfcs/2024-09-15-shared-port.md
@@ -0,0 +1,163 @@
+# Sharing protocol ports with HTTPS
+
+Some networks block all ports other than web ports, including port 5223 used for SMP protocol by default. Running SMP servers on a common web port 443 would allow them to work on more networks. The servers would need to provide an HTTPS page for browsers (and probes).
+
+## Problem
+
+Browsers and tools rely on system CA bundles instead of certificate pinning.
+The crypto parameters used by HTTPS are different from what the protocols use.
+Public certificate providers like LetsEncrypt can only sign specific types of keys and Ed25519 isn't one of them.
+
+This means a server should distinguish browser and protocol clients and adjust its behavior to match.
+
+## Solution
+
+`tls` package has a server hook that allows producing a different set of `TLS.Credentials` according to a client-provided "Server Name Indication" extension.
+
+Since LE certificates are only handed out to domain names, TLS client will be sending the SNI.
+However client transports are constructed over connected sockets and the SNI wouldn't be present unless explicitly requested.
+When a client sends SNI, then it's a browser and a web credentials should be used.
+Otherwise it's a protocol client to be offered the self-signed ca, cert and key.
+
+When a transport colocated with a HTTPS, its ALPN list should be extended with `h2 http/1.1`.
+The browsers will send it, and it should be checked before running transport client.
+If HTTP ALPN is detected, then the client connection is served with HTTP `Application` instead (the same "server information" page).
+
+If some client connects to server IP, doesn't send SNI and doesn't send ALPN, it will look like a pre-handshake client.
+In that case a server will send its handshake first.
+This can be mitigated by delaying its handshake and letting the probe to issue its HTTP request.
+
+## Implementation plan
+
+An unmodified client should be able to use protocols on port 443 right away.
+
+The switchover happens inside `runTransportServerState` before `runClient`:
+
+```haskell
+runServer (tcpPort, ATransport t) = do
+  -- ...
+  runTransportServerState_ ss started tcpPort serverParams tCfg $ \socket h -> do -- expose raw socket for warp-tls internals to attach
+    negotiated <- getSessionALPN
+    if allowHTTP t && isHTTP negotiated -- only attempt the switch for the TLS transport
+      then runHTTP socket (tlsContext h)-- ... collect data and produce values needed to run WAI Application
+      else runClient serverSignKey t h `runReaderT` env -- performs serverHandshake etc as usual
+```
+
+The web app and server live outside, so `runHttp` has to be provided by the `runSMPServer` caller.
+Additonally, Warp is using its `InternalInfo` object that's scoped to `withII` bracket.
+
+```haskell
+  runServer ini = do
+    -- ...
+
+    runWebServer ini ServerInformation {config, information} $ if sharedHttps then Nothing else webHttpsParams -- suppress serving https
+    if sharedHttps
+      then withRunHTTP staticFilesPath \attachStatic -> runSMPServer cfg (Just attachStatic) -- provide wrapped application runner
+      else runSMPServer cfg Nothing
+```
+
+### Upstream
+
+The implementation relies on a few modification to upstream code:
+- `warp-tls`: The library provides `httpOverTls`, but it wants to do handshake itself.
+  Since we have to do the handshake to switch on ALPN, the setup function has to be split.
+  This is a resonable change that may be upstreamed and nothing blocks us from using the recent version.
+- `warp`: Only the re-export of `serveConnection` is needed.
+  Unfortunately the most recent `warp` version can't be used right away due to dependency cascade around `http-5` and `auto-update-2`.
+  So a fork containing the backported re-export has to be used until the dependencies are refreshed.
+
+
+### TLS.ServerParams
+
+When a server has port sharing enabled, a new set of TLS params is loaded and combined with transport params:
+
+```haskell
+newEnv config = do
+  -- ...
+  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
+  sharedServerParams <- forM ((,) <$> sharedHttpsCredentials config <*> alpn transportConfig) $ \((chain, key), alpn) ->
+    let ca = Nothing -- It is possible to provide CA certificate, but it is typical for web server to use combined certificate chains
+    loadHTTPSServerParams tlsServerParams ca chain key alpn
+```
+
+`loadHTTPSServerParams` extends params with:
+1. `onALPNClientSuggest` hook gets `["h2", "http/1.1"]` added to the ALPN list which is now required.
+2. `onServerNameIndication` hook added, which upon detecting client SNI prepends the web credentials.
+3. `sharedCredentials = T.Credentials []` should be done to prevent transport credentials confusing browsers.
+    But that aborts key exchange somewhere in tls internals, so disabled for now.
+    As a workaround, another set of dummy credentials can be provided in the hope that any sane browser would reject them.
+    Like, RC4 ciphers, "impossible" digest combination, etc.
+
+### supportedParameters
+
+TLS certificate chains provided by LetsEncrypt use ECDSA/P256 and that requires extending `supportedParameters` with things disabled in transports:
+
+```haskell
+    browserCiphers =
+      [ TE.cipher_TLS13_AES128CCM8_SHA256
+      , TE.cipher_ECDHE_ECDSA_AES128CCM8_SHA256
+      , TE.cipher_ECDHE_ECDSA_AES256CCM8_SHA256
+      ]
+    browserGroups =
+      [ T.P256
+      ]
+    browserSigs =
+      [ (T.HashSHA256, T.SignatureECDSA),
+        (T.HashSHA384, T.SignatureECDSA)
+      ]
+```
+
+This may not be enough for other certificate providers.
+
+## Configuration
+
+> XXX: This is for the current implementation and should be updated.
+
+Web certificate chain is picked up from the WEB section:
+
+```ini
+[TRANSPORT]
+port: 443
+
+[WEB]
+https: 443
+cert: /etc/opt/simplex/web.cert
+key: /etc/opt/simplex/web.key
+
+# Alternatively, with a proper access configuration, the paths can point to the LE creds directly:
+# cert: /etc/letsencrypt/live/smp.hostname.tld/fullchain.pem
+# key: /etc/letsencrypt/live/smp.hostname.tld/privkey.pem
+```
+
+When `TRANSPORT.port` matches `WEB.https` the transport server becomes shared.
+
+Perhaps a more desirable option would be explicit configuration resulting in additional transported to run:
+
+```ini
+[TRANSPORT]
+port: 5223 ; pure protocol transport
+# control_port: 5224
+shared_port: 443 ; variant 1: register in TRANSPORT
+
+[WEB]
+https: 443
+cert: /etc/opt/simplex/web.cert
+key: /etc/opt/simplex/web.key
+# transport: on ; variant 2:
+```
+
+## Caveats
+
+Serving static files and the protocols togother may pose a problem for those who currently use dedicated web servers as they should switch to embedded http handlers.
+
+As before, using embedded HTTP server is increasing attack surface.
+
+Users who want to run everything on a single host will have to add and extra IP address and bind servers to specific IPs instead of 0.0.0.0.
+An amalgamated server binary can be provided that would contain both SMP and XFTP servers, where transport will dispatch connections by handshake ALPN.
+
+## Alternative: Use transports routable with reverse-proxies
+
+An "industrial" reverse proxy may do the ALPN routing, serving HTTP by itself and delegating `smp` and `xftp` to protocol servers.
+Same with the `websockets`.
+
+Since this in effect does TLS termination, the protocol servers will have to rely on credentials from protocol handshakes.
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 1ab3e4fe8..5590dd6a4 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -419,9 +419,10 @@ executable smp-server
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
+    , wai
     , wai-app-static
-    , warp
-    , warp-tls
+    , warp ==3.3.30
+    , warp-tls ==3.4.7
     , websockets ==0.12.*
     , yaml ==0.11.*
     , zstd ==0.1.3.*
@@ -627,9 +628,12 @@ test-suite simplexmq-test
       XFTPCLI
       XFTPClient
       XFTPServerTests
+      Static
+      Static.Embedded
       Paths_simplexmq
   hs-source-dirs:
       tests
+      apps/smp-server/web
   default-extensions:
       StrictData
   ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts -with-rtsopts=-A64M -with-rtsopts=-N1
@@ -657,12 +661,15 @@ test-suite simplexmq-test
     , deepseq ==1.4.*
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
+    , file-embed
     , filepath ==1.4.*
     , generic-random ==1.5.*
     , hashable ==1.4.*
     , hourglass ==0.2.*
     , hspec ==2.11.*
     , hspec-core ==2.11.*
+    , http-client
+    , http-client-tls
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
     , ini ==0.4.1
@@ -692,6 +699,11 @@ test-suite simplexmq-test
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
+    , unordered-containers
+    , wai
+    , wai-app-static
+    , warp
+    , warp-tls
     , websockets ==0.12.*
     , yaml ==0.11.*
     , zstd ==0.1.3.*
diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs
index f2240ec50..22b111a26 100644
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -104,7 +104,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
   let socksCreds = clientSocksCredentials xftpNetworkConfig proxySessTs transportSession
       ProtocolServer _ host port keyHash = srv
   useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
-  let tcConfig = (transportClientConfig xftpNetworkConfig useHost) {alpn = clientALPN}
+  let tcConfig = (transportClientConfig xftpNetworkConfig useHost True) {alpn = clientALPN}
       http2Config = xftpHTTP2Config tcConfig config
   clientVar <- newTVarIO Nothing
   let usePort = if null port then "443" else port
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index e54ee64b4..99a241d2e 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -74,8 +74,7 @@ import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth, ProtocolServer, ProtocolType (..), ProtocolTypeI, VersionRangeSMPC, XFTPServer, supportedSMPClientVRange)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (SMPVersion, TLS, Transport (..))
-import Simplex.Messaging.Transport.Client (defaultSMPPort)
+import Simplex.Messaging.Transport (SMPVersion)
 import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors')
 import System.Mem.Weak (Weak)
 import System.Random (StdGen, newStdGen)
@@ -195,8 +194,8 @@ defaultAgentConfig =
       sndAuthAlg = C.AuthAlg C.SEd25519, -- TODO replace with X25519 when switching to v7
       connIdBytes = 12,
       tbqSize = 128,
-      smpCfg = defaultSMPClientConfig {defaultTransport = (show defaultSMPPort, transport @TLS)},
-      ntfCfg = defaultNTFClientConfig {defaultTransport = ("443", transport @TLS)},
+      smpCfg = defaultSMPClientConfig,
+      ntfCfg = defaultNTFClientConfig,
       xftpCfg = defaultXFTPClientConfig,
       reconnectInterval = defaultReconnectInterval,
       messageRetryInterval = defaultMessageRetryInterval,
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index afcc5eab2..461bb9ee8 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -141,7 +141,7 @@ import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Transport.Client (SocksAuth (..), SocksProxyWithAuth (..), TransportClientConfig (..), TransportHost (..), defaultTcpConnectTimeout, runTransportClient)
+import Simplex.Messaging.Transport.Client (SocksAuth (..), SocksProxyWithAuth (..), TransportClientConfig (..), TransportHost (..), defaultSMPPort, defaultTcpConnectTimeout, runTransportClient)
 import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, diffToMicroseconds, ifM, liftEitherWith, raceAny_, threadDelay', tshow, whenM)
@@ -281,6 +281,8 @@ data NetworkConfig = NetworkConfig
     smpProxyMode :: SMPProxyMode,
     -- | Fallback to direct connection when destination SMP relay does not support SMP proxy protocol extensions
     smpProxyFallback :: SMPProxyFallback,
+    -- | use web port 443 for SMP protocol
+    smpWebPort :: Bool,
     -- | timeout for the initial client TCP/TLS connection (microseconds)
     tcpConnectTimeout :: Int,
     -- | timeout of protocol commands (microseconds)
@@ -352,6 +354,7 @@ defaultNetworkConfig =
       sessionMode = TSMSession,
       smpProxyMode = SPMNever,
       smpProxyFallback = SPFAllow,
+      smpWebPort = False,
       tcpConnectTimeout = defaultTcpConnectTimeout,
       tcpTimeout = 15_000_000,
       tcpTimeoutPerKb = 5_000,
@@ -362,9 +365,9 @@ defaultNetworkConfig =
       logTLSErrors = False
     }
 
-transportClientConfig :: NetworkConfig -> TransportHost -> TransportClientConfig
-transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} host =
-  TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, alpn = Nothing}
+transportClientConfig :: NetworkConfig -> TransportHost -> Bool -> TransportClientConfig
+transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} host useSNI =
+  TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, alpn = Nothing, useSNI}
   where
     socksProxy' = (\(SocksProxyWithAuth _ proxy) -> proxy) <$> socksProxy
     useSocksProxy SMAlways = socksProxy'
@@ -400,24 +403,29 @@ data ProtocolClientConfig v = ProtocolClientConfig
     -- | client-server protocol version range
     serverVRange :: VersionRange v,
     -- | agree shared session secret (used in SMP proxy for additional encryption layer)
-    agreeSecret :: Bool
+    agreeSecret :: Bool,
+    -- | send SNI to server, False for SMP
+    useSNI :: Bool
   }
 
 -- | Default protocol client configuration.
-defaultClientConfig :: Maybe [ALPN] -> VersionRange v -> ProtocolClientConfig v
-defaultClientConfig clientALPN serverVRange =
+defaultClientConfig :: Maybe [ALPN] -> Bool -> VersionRange v -> ProtocolClientConfig v
+defaultClientConfig clientALPN useSNI serverVRange =
   ProtocolClientConfig
     { qSize = 64,
       defaultTransport = ("443", transport @TLS),
       networkConfig = defaultNetworkConfig,
       clientALPN,
       serverVRange,
-      agreeSecret = False
+      agreeSecret = False,
+      useSNI
     }
 {-# INLINE defaultClientConfig #-}
 
 defaultSMPClientConfig :: ProtocolClientConfig SMPVersion
-defaultSMPClientConfig = defaultClientConfig (Just supportedSMPHandshakes) supportedClientSMPRelayVRange
+defaultSMPClientConfig =
+  (defaultClientConfig (Just supportedSMPHandshakes) False supportedClientSMPRelayVRange)
+    {defaultTransport = (show defaultSMPPort, transport @TLS)}
 {-# INLINE defaultSMPClientConfig #-}
 
 data Request err msg = Request
@@ -477,14 +485,14 @@ type TransportSession msg = (UserId, ProtoServer msg, Maybe ByteString)
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
 getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> TransportSession msg -> ProtocolClientConfig v -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> UTCTime -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
-getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret} msgQ proxySessTs disconnected = do
+getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret, useSNI} msgQ proxySessTs disconnected = do
   case chooseTransportHost networkConfig (host srv) of
     Right useHost ->
       (getCurrentTime >>= mkProtocolClient useHost >>= runClient useTransport useHost)
         `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
     Left e -> pure $ Left e
   where
-    NetworkConfig {tcpConnectTimeout, tcpTimeout, smpPingInterval} = networkConfig
+    NetworkConfig {smpWebPort, tcpConnectTimeout, tcpTimeout, smpPingInterval} = networkConfig
     mkProtocolClient :: TransportHost -> UTCTime -> IO (PClient v err msg)
     mkProtocolClient transportHost ts = do
       connected <- newTVarIO False
@@ -515,7 +523,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
     runClient :: (ServiceName, ATransport) -> TransportHost -> PClient v err msg -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
     runClient (port', ATransport t) useHost c = do
       cVar <- newEmptyTMVarIO
-      let tcConfig = (transportClientConfig networkConfig useHost) {alpn = clientALPN}
+      let tcConfig = (transportClientConfig networkConfig useHost useSNI) {alpn = clientALPN}
           socksCreds = clientSocksCredentials networkConfig proxySessTs transportSession
       tId <-
         runTransportClient tcConfig socksCreds useHost port' (Just $ keyHash srv) (client t c cVar)
@@ -528,7 +536,9 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
 
     useTransport :: (ServiceName, ATransport)
     useTransport = case port srv of
-      "" -> defaultTransport cfg
+      "" -> case protocolTypeI @(ProtoType msg) of
+        SPSMP | smpWebPort -> ("443", transport @TLS)
+        _ -> defaultTransport cfg
       "80" -> ("80", transport @WS)
       p -> (p, transport @TLS)
 
diff --git a/src/Simplex/Messaging/Client/Agent.hs b/src/Simplex/Messaging/Client/Agent.hs
index f5d1a53cf..378b470a3 100644
--- a/src/Simplex/Messaging/Client/Agent.hs
+++ b/src/Simplex/Messaging/Client/Agent.hs
@@ -76,7 +76,7 @@ data SMPClientAgentConfig = SMPClientAgentConfig
 defaultSMPClientAgentConfig :: SMPClientAgentConfig
 defaultSMPClientAgentConfig =
   SMPClientAgentConfig
-    { smpCfg = defaultSMPClientConfig {defaultTransport = ("5223", transport @TLS)},
+    { smpCfg = defaultSMPClientConfig,
       reconnectInterval =
         RetryInterval
           { initialInterval = second,
diff --git a/src/Simplex/Messaging/Notifications/Client.hs b/src/Simplex/Messaging/Notifications/Client.hs
index 72f0c15a8..f2c07741f 100644
--- a/src/Simplex/Messaging/Notifications/Client.hs
+++ b/src/Simplex/Messaging/Notifications/Client.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Simplex.Messaging.Notifications.Client where
 
@@ -13,13 +14,17 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Transport (NTFVersion, supportedClientNTFVRange, supportedNTFHandshakes)
 import Simplex.Messaging.Protocol (ErrorType, pattern NoEntity)
+import Simplex.Messaging.Transport (TLS, Transport (..))
 
 type NtfClient = ProtocolClient NTFVersion ErrorType NtfResponse
 
 type NtfClientError = ProtocolClientError ErrorType
 
 defaultNTFClientConfig :: ProtocolClientConfig NTFVersion
-defaultNTFClientConfig = defaultClientConfig (Just supportedNTFHandshakes) supportedClientNTFVRange
+defaultNTFClientConfig =
+  (defaultClientConfig (Just supportedNTFHandshakes) True supportedClientNTFVRange)
+    {defaultTransport = ("443", transport @TLS)}
+{-# INLINE defaultNTFClientConfig #-}
 
 ntfRegisterToken :: NtfClient -> C.APrivateAuthKey -> NewNtfEntity 'Token -> ExceptT NtfClientError IO (NtfTokenId, C.PublicKeyX25519)
 ntfRegisterToken c pKey newTkn =
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 8b5f2274b..ab7c69f04 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -51,7 +51,7 @@ import Simplex.Messaging.Server
 import Simplex.Messaging.Server.Stats
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport (..), THandle (..), THandleAuth (..), THandleParams (..), TProxy, Transport (..), TransportPeer (..), defaultSupportedParams)
-import Simplex.Messaging.Transport.Server (runTransportServer)
+import Simplex.Messaging.Transport.Server (AddHTTP, runTransportServer)
 import Simplex.Messaging.Util
 import System.Exit (exitFailure)
 import System.IO (BufferMode (..), hPutStrLn, hSetBuffering)
@@ -80,8 +80,8 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
   resubscribe s
   raceAny_ (ntfSubscriber s : ntfPush ps : map runServer transports <> serverStatsThread_ cfg) `finally` stopServer
   where
-    runServer :: (ServiceName, ATransport) -> M ()
-    runServer (tcpPort, ATransport t) = do
+    runServer :: (ServiceName, ATransport, AddHTTP) -> M ()
+    runServer (tcpPort, ATransport t, _addHTTP) = do
       srvCreds <- asks tlsServerCreds
       serverSignKey <- either fail pure $ fromTLSCredentials srvCreds
       env <- ask
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index e99adc884..c1e0981dc 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -33,13 +33,13 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport, THandleParams, TransportPeer (..))
-import Simplex.Messaging.Transport.Server (ServerCredentials, TransportServerConfig, loadFingerprint, loadServerCredential)
+import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials, TransportServerConfig, loadFingerprint, loadServerCredential)
 import System.IO (IOMode (..))
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
 
 data NtfServerConfig = NtfServerConfig
-  { transports :: [(ServiceName, ATransport)],
+  { transports :: [(ServiceName, ATransport, AddHTTP)],
     subIdBytes :: Int,
     regCodeBytes :: Int,
     clientQSize :: Natural,
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 5a5ae12fd..bf96b6deb 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -34,6 +34,7 @@ module Simplex.Messaging.Server
     verifyCmdAuthorization,
     dummyVerifyCmd,
     randomId,
+    AttachHTTP,
   )
 where
 
@@ -68,10 +69,12 @@ import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Type.Equality
+import Data.Typeable (cast)
 import GHC.IORef (atomicSwapIORef)
 import GHC.Stats (getRTSStats)
 import GHC.TypeLits (KnownNat)
 import Network.Socket (ServiceName, Socket, socketToHandle)
+import qualified Network.TLS as TLS
 import Numeric.Natural (Natural)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Client (ProtocolClient (thParams), ProtocolClientError (..), SMPClient, SMPClientError, forwardSMPTransmission, smpProxyError, temporaryClientError)
@@ -115,22 +118,23 @@ import GHC.Conc.Sync (threadLabel)
 -- | Runs an SMP server using passed configuration.
 --
 -- See a full server here: https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-server/Main.hs
-runSMPServer :: ServerConfig -> IO ()
-runSMPServer cfg = do
+runSMPServer :: ServerConfig -> Maybe AttachHTTP -> IO ()
+runSMPServer cfg attachHTTP_ = do
   started <- newEmptyTMVarIO
-  runSMPServerBlocking started cfg
+  runSMPServerBlocking started cfg attachHTTP_
 
 -- | Runs an SMP server using passed configuration with signalling.
 --
 -- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
 -- and when it is disconnected from the TCP socket once the server thread is killed (False).
-runSMPServerBlocking :: TMVar Bool -> ServerConfig -> IO ()
-runSMPServerBlocking started cfg = newEnv cfg >>= runReaderT (smpServer started cfg)
+runSMPServerBlocking :: TMVar Bool -> ServerConfig -> Maybe AttachHTTP -> IO ()
+runSMPServerBlocking started cfg attachHTTP_ = newEnv cfg >>= runReaderT (smpServer started cfg attachHTTP_)
 
 type M a = ReaderT Env IO a
+type AttachHTTP = Socket -> TLS.Context -> IO ()
 
-smpServer :: TMVar Bool -> ServerConfig -> M ()
-smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
+smpServer :: TMVar Bool -> ServerConfig -> Maybe AttachHTTP -> M ()
+smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHTTP_ = do
   s <- asks server
   pa <- asks proxyAgent
   expired <- restoreServerMessages
@@ -144,13 +148,26 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
     )
     `finally` withLock' (savingLock s) "final" (saveServer False >> closeServer)
   where
-    runServer :: (ServiceName, ATransport) -> M ()
-    runServer (tcpPort, ATransport t) = do
-      srvCreds <- asks tlsServerCreds
+    runServer :: (ServiceName, ATransport, AddHTTP) -> M ()
+    runServer (tcpPort, ATransport t, addHTTP) = do
+      smpCreds <- asks tlsServerCreds
+      httpCreds_ <- asks httpServerCreds
       ss <- asks sockets
-      serverSignKey <- either fail pure $ fromTLSCredentials srvCreds
+      serverSignKey <- either fail pure $ fromTLSCredentials smpCreds
       env <- ask
-      liftIO $ runTransportServerState ss started tcpPort defaultSupportedParams srvCreds (Just supportedSMPHandshakes) tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
+      liftIO $ case (httpCreds_, attachHTTP_) of
+        (Just httpCreds, Just attachHTTP) | addHTTP ->
+          runTransportServerState_ ss started tcpPort defaultSupportedParamsHTTPS chooseCreds (Just combinedALPNs) tCfg $ \s h ->
+            case cast h of
+              Just TLS {tlsContext} | maybe False (`elem` httpALPN) (getSessionALPN h) -> labelMyThread "https client" >> attachHTTP s tlsContext
+              _ -> runClient serverSignKey t h `runReaderT` env
+          where
+            chooseCreds = maybe smpCreds (\_host -> httpCreds)
+            combinedALPNs = supportedSMPHandshakes <> httpALPN
+            httpALPN :: [ALPN]
+            httpALPN = ["h2", "http/1.1"]
+        _ ->
+          runTransportServerState ss started tcpPort defaultSupportedParams smpCreds (Just supportedSMPHandshakes) tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
     fromTLSCredentials (_, pk) = C.x509ToPrivate (pk, []) >>= C.privKey
 
     saveServer :: Bool -> M ()
@@ -803,7 +820,7 @@ send th c@Client {sndQ, msgQ, sessionId} = do
           -- replace MSG response with OK, accumulating MSG in a separate list.
           MSG {} -> ((CorrId "", entId, cmd) : msgs, (corrId, entId, OK))
           _ -> (msgs, t)
-        
+
 sendMsg :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO ()
 sendMsg th c@Client {msgQ, sessionId} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " sendMsg"
@@ -1211,7 +1228,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           when (Just t /= updatedAt) $ do
             withLog $ \s -> logUpdateQueueTime s rId t
             st <- asks queueStore
-            liftIO $ updateQueueTime st rId t 
+            liftIO $ updateQueueTime st rId t
 
         subscribeNotifications :: M (Transmission BrokerMsg)
         subscribeNotifications = do
diff --git a/src/Simplex/Messaging/Server/CLI.hs b/src/Simplex/Messaging/Server/CLI.hs
index f02612274..30e5a0b58 100644
--- a/src/Simplex/Messaging/Server/CLI.hs
+++ b/src/Simplex/Messaging/Server/CLI.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -29,7 +30,7 @@ import Options.Applicative
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI)
 import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..))
-import Simplex.Messaging.Transport.Server (loadFileFingerprint)
+import Simplex.Messaging.Transport.Server (AddHTTP, loadFileFingerprint)
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (eitherToMaybe, whenM)
 import System.Directory (doesDirectoryExist, listDirectory, removeDirectoryRecursive, removePathForcibly)
@@ -275,7 +276,7 @@ checkSavedFingerprint cfgPath x509cfg = do
   where
     c = combine cfgPath . ($ x509cfg)
 
-iniTransports :: Ini -> [(String, ATransport)]
+iniTransports :: Ini -> [(ServiceName, ATransport, AddHTTP)]
 iniTransports ini =
   let smpPorts = ports $ strictIni "TRANSPORT" "port" ini
       ws = strictIni "TRANSPORT" "websockets" ini
@@ -283,17 +284,22 @@ iniTransports ini =
         | ws == "off" = []
         | ws == "on" = ["80"]
         | otherwise = ports ws \\ smpPorts
-   in map (,transport @TLS) smpPorts <> map (,transport @WS) wsPorts
+   in ts (transport @TLS) smpPorts <> ts (transport @WS) wsPorts
   where
+    ts :: ATransport -> [ServiceName] -> [(ServiceName, ATransport, AddHTTP)]
+    ts t = map (\port -> (port, t, webPort == Just port))
+    webPort = T.unpack <$> eitherToMaybe (lookupValue "WEB" "https" ini)
     ports = map T.unpack . T.splitOn ","
 
-printServerConfig :: [(ServiceName, ATransport)] -> Maybe FilePath -> IO ()
+printServerConfig :: [(ServiceName, ATransport, AddHTTP)] -> Maybe FilePath -> IO ()
 printServerConfig transports logFile = do
   putStrLn $ case logFile of
     Just f -> "Store log: " <> f
     _ -> "Store log disabled."
-  forM_ transports $ \(p, ATransport t) ->
-    putStrLn $ "Listening on port " <> p <> " (" <> transportName t <> ")..."
+  forM_ transports $ \(p, ATransport t, addHTTP) -> do
+    let descr = p <> " (" <> transportName t <> ")..."
+    putStrLn $ "Serving SMP protocol on port " <> descr
+    when addHTTP $ putStrLn $ "Serving static site on port " <> descr
 
 deleteDirIfExists :: FilePath -> IO ()
 deleteDirIfExists path = whenM (doesDirectoryExist path) $ removeDirectoryRecursive path
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 214cecd19..05ed7da53 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -10,11 +11,13 @@ module Simplex.Messaging.Server.Env.STM where
 import Control.Concurrent (ThreadId)
 import Control.Logger.Simple
 import Control.Monad
+import qualified Crypto.PubKey.RSA as RSA
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IM
+import Data.List (intercalate)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -22,6 +25,7 @@ import Data.Maybe (isJust, isNothing)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime)
+import qualified Data.X509 as X
 import Data.X509.Validation (Fingerprint (..))
 import Network.Socket (ServiceName)
 import qualified Network.TLS as T
@@ -41,13 +45,15 @@ import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport, VersionRangeSMP, VersionSMP)
-import Simplex.Messaging.Transport.Server (ServerCredentials, SocketState, TransportServerConfig, loadFingerprint, loadServerCredential, newSocketState)
+import Simplex.Messaging.Transport.Server
+import System.Directory (doesFileExist)
+import System.Exit (exitFailure)
 import System.IO (IOMode (..))
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
 
 data ServerConfig = ServerConfig
-  { transports :: [(ServiceName, ATransport)],
+  { transports :: [(ServiceName, ATransport, AddHTTP)],
     smpHandshakeTimeout :: Int,
     tbqSize :: Natural,
     msgQueueQuota :: Int,
@@ -79,6 +85,7 @@ data ServerConfig = ServerConfig
     -- | interval between sending pending END events to unsubscribed clients, seconds
     pendingENDInterval :: Int,
     smpCredentials :: ServerCredentials,
+    httpCredentials :: Maybe ServerCredentials,
     -- | SMP client-server protocol version range
     smpServerVRange :: VersionRangeSMP,
     -- | TCP transport config
@@ -123,6 +130,7 @@ data Env = Env
     random :: TVar ChaChaDRG,
     storeLog :: Maybe (StoreLog 'WriteMode),
     tlsServerCreds :: T.Credential,
+    httpServerCreds :: Maybe T.Credential,
     serverStats :: ServerStats,
     sockets :: SocketState,
     clientSeq :: TVar ClientId,
@@ -217,7 +225,7 @@ newProhibitedSub = do
   return Sub {subThread = ProhibitSub, delivered}
 
 newEnv :: ServerConfig -> IO Env
-newEnv config@ServerConfig {smpCredentials, storeLogFile, smpAgentCfg, information, messageExpiration} = do
+newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAgentCfg, information, messageExpiration} = do
   server <- newServer
   queueStore <- newQueueStore
   msgStore <- newMsgStore
@@ -226,7 +234,9 @@ newEnv config@ServerConfig {smpCredentials, storeLogFile, smpAgentCfg, informati
     forM storeLogFile $ \f -> do
       logInfo $ "restoring queues from file " <> T.pack f
       restoreQueues queueStore f
-  tlsServerCreds <- loadServerCredential smpCredentials
+  tlsServerCreds <- getCredentials "SMP" smpCredentials
+  httpServerCreds <- mapM (getCredentials "HTTPS") httpCredentials
+  mapM_ checkHTTPSCredentials httpServerCreds
   Fingerprint fp <- loadFingerprint smpCredentials
   let serverIdentity = KeyHash fp
   serverStats <- newServerStats =<< getCurrentTime
@@ -234,8 +244,28 @@ newEnv config@ServerConfig {smpCredentials, storeLogFile, smpAgentCfg, informati
   clientSeq <- newTVarIO 0
   clients <- newTVarIO mempty
   proxyAgent <- newSMPProxyAgent smpAgentCfg random
-  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
+  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerCreds, httpServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
   where
+    getCredentials protocol creds = do
+      files <- missingCreds
+      unless (null files) $ do
+        putStrLn $ "Error: no " <> protocol <> " credentials: " <> intercalate ", " files
+        when (protocol == "HTTPS") $ putStrLn letsEncrypt
+        exitFailure
+      loadServerCredential creds
+      where
+        missingfile f = (\y -> [f | not y]) <$> doesFileExist f
+        missingCreds = do
+          let files = maybe id (:) (caCertificateFile creds) [certificateFile creds, privateKeyFile creds]
+           in concat <$> mapM missingfile files
+    checkHTTPSCredentials (X.CertificateChain cc, _k) =
+      -- LetsEncrypt provides ECDSA with insecure curve p256 (https://safecurves.cr.yp.to)
+      case map (X.signedObject . X.getSigned) cc of
+        X.Certificate {X.certPubKey = X.PubKeyRSA rsa} : _ca | RSA.public_size rsa >= 512 -> pure ()
+        _ -> do
+          putStrLn $ "Error: unsupported HTTPS credentials, required 4096-bit RSA\n" <> letsEncrypt
+          exitFailure
+    letsEncrypt = "Use Let's Encrypt to generate: certbot certonly --standalone -d yourdomainname --key-type rsa --rsa-key-size 4096"
     restoreQueues :: QueueStore -> FilePath -> IO (StoreLog 'WriteMode)
     restoreQueues QueueStore {queues, senders, notifiers} f = do
       (qs, s) <- readWriteStoreLog f
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 6cee2abd1..bcd96c170 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -36,7 +36,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
-import Simplex.Messaging.Server (runSMPServer)
+import Simplex.Messaging.Server (AttachHTTP, runSMPServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defMsgExpirationDays, defaultInactiveClientExpiration, defaultMessageExpiration, defaultProxyClientConcurrency)
 import Simplex.Messaging.Server.Expiration
@@ -52,10 +52,16 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)
 
 smpServerCLI :: FilePath -> FilePath -> IO ()
-smpServerCLI = smpServerCLI_ (\_ _ _ -> pure ()) (\_ -> pure ())
+smpServerCLI = smpServerCLI_ (\_ _ _ -> pure ()) (\_ -> pure ()) (\_ -> error "attachStaticFiles not available")
 
-smpServerCLI_ :: (ServerInformation -> Maybe TransportHost -> FilePath -> IO ()) -> (EmbeddedWebParams -> IO ()) -> FilePath -> FilePath -> IO ()
-smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
+smpServerCLI_ ::
+  (ServerInformation -> Maybe TransportHost -> FilePath -> IO ()) ->
+  (EmbeddedWebParams -> IO ()) ->
+  (FilePath -> (AttachHTTP -> IO ()) -> IO ()) ->
+  FilePath ->
+  FilePath ->
+  IO ()
+smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
   getCliCommand' (cliCommandP cfgPath logPath iniFile) serverVersion >>= \case
     Init opts ->
       doesFileExist iniFile >>= \case
@@ -77,10 +83,10 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
   where
     iniFile = combine cfgPath "smp-server.ini"
     serverVersion = "SMP server v" <> simplexMQVersion
-    defaultServerPort = "5223"
+    defaultServerPorts = "5223,443"
     executableName = "smp-server"
     storeLogFilePath = combine logPath "smp-server-store.log"
-    httpsCertFile = combine cfgPath "web.cert"
+    httpsCertFile = combine cfgPath "web.crt"
     httpsKeyFile = combine cfgPath "web.key"
     defaultStaticPath = combine logPath "www"
     initializeServer opts@InitOptions {ip, fqdn, sourceCode = src', webStaticPath = sp', disableWeb = noWeb', scripted}
@@ -96,7 +102,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
           host' <- withPrompt ("Enter server FQDN or IP address for certificate (" <> host <> "): ") getLine
           sourceCode' <- withPrompt ("Enter server source code URI (" <> maybe simplexmqSource T.unpack src' <> "): ") getServerSourceCode
           staticPath' <- withPrompt ("Enter path to store generated static site with server information (" <> fromMaybe defaultStaticPath sp' <> "): ") getLine
-          enableWeb <- onOffPrompt "Enable built-in web server for static site" (not noWeb')
           initialize
             opts
               { enableStoreLog,
@@ -105,7 +110,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
                 password,
                 sourceCode = (T.pack <$> sourceCode') <|> src',
                 webStaticPath = if null staticPath' then sp' else Just staticPath',
-                disableWeb = not enableWeb
+                disableWeb = noWeb'
               }
       where
         serverPassword =
@@ -172,7 +177,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
                    \# Host is only used to print server address on start.\n\
                    \# You can specify multiple server ports.\n"
                 <> ("host: " <> T.pack host <> "\n")
-                <> ("port: " <> T.pack defaultServerPort <> "\n")
+                <> ("port: " <> T.pack defaultServerPorts <> "\n")
                 <> "log_tls_errors: off\n\n\
                    \# Use `websockets: 443` to run websockets server in addition to plain TLS.\n\
                    \websockets: off\n\
@@ -205,19 +210,21 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
                 <> "# Run an embedded server on this port\n\
                    \# Onion sites can use any port and register it in the hidden service config.\n\
                    \# Running on a port 80 may require setting process capabilities.\n"
-                <> ((if disableWeb then "# " else "") <> "http: 8000\n\n")
+                <> (webDisabled <> "http: 8000\n\n")
                 <> "# You can run an embedded TLS web server too if you provide port and cert and key files.\n\
-                   \# Not required for running relay on onion address.\n\
-                   \# https: 443\n"
-                <> ("# cert: " <> T.pack httpsCertFile <> "\n")
-                <> ("# key: " <> T.pack httpsKeyFile <> "\n")
+                   \# Not required for running relay on onion address.\n"
+                <> (webDisabled <> "https: 443\n")
+                <> (webDisabled <> "cert: " <> T.pack httpsCertFile <> "\n")
+                <> (webDisabled <> "key: " <> T.pack httpsKeyFile <> "\n")
+              where
+                webDisabled = if disableWeb then "# " else ""
     runServer ini = do
       hSetBuffering stdout LineBuffering
       hSetBuffering stderr LineBuffering
       fp <- checkSavedFingerprint cfgPath defaultX509Config
       let host = either (const "<hostnames>") T.unpack $ lookupValue "TRANSPORT" "host" ini
           port = T.unpack $ strictIni "TRANSPORT" "port" ini
-          cfg@ServerConfig {information, transports, storeLogFile, newQueueBasicAuth, messageExpiration, inactiveClientExpiration} = serverConfig
+          cfg@ServerConfig {information, storeLogFile, newQueueBasicAuth, messageExpiration, inactiveClientExpiration} = serverConfig
           sourceCode' = (\ServerPublicInfo {sourceCode} -> sourceCode) <$> information
           srv = ProtoServerWithAuth (SMPServer [THDomainName host] (if port == "5223" then "" else port) (C.KeyHash fp)) newQueueBasicAuth
       printServiceInfo serverVersion srv
@@ -247,15 +254,25 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
                 newQueuesAllowed = allowNewQueues cfg,
                 basicAuthEnabled = isJust newQueueBasicAuth
               }
-      runWebServer ini ServerInformation {config, information}
-      runSMPServer cfg
+      case webStaticPath' of
+        Just path | sharedHTTP -> do
+          runWebServer path Nothing ServerInformation {config, information}
+          attachStaticFiles path $ \attachHTTP -> runSMPServer cfg $ Just attachHTTP
+        Just path -> do
+          runWebServer path webHttpsParams' ServerInformation {config, information}
+          runSMPServer cfg Nothing
+        Nothing -> do
+          logWarn "No server static path set"
+          runSMPServer cfg Nothing
       where
         enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
         logStats = settingIsOn "STORE_LOG" "log_stats" ini
         c = combine cfgPath . ($ defaultX509Config)
+        transports = iniTransports ini
+        sharedHTTP = any (\(_, _, addHTTP) -> addHTTP) transports
         serverConfig =
           ServerConfig
-            { transports = iniTransports ini,
+            { transports,
               smpHandshakeTimeout = 120000000,
               tbqSize = 128,
               msgQueueQuota = 128,
@@ -267,6 +284,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
                     privateKeyFile = c serverKeyFile,
                     certificateFile = c serverCrtFile
                   },
+              httpCredentials = (\WebHttpsParams {key, cert} -> ServerCredentials {caCertificateFile = Nothing, privateKeyFile = key, certificateFile = cert}) <$> webHttpsParams',
               storeLogFile = enableStoreLog $> storeLogFilePath,
               storeMsgsFile =
                 let messagesPath = combine logPath "smp-server-messages.log"
@@ -325,26 +343,23 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
             }
         textToOwnServers :: Text -> [ByteString]
         textToOwnServers = map encodeUtf8 . T.words
-
-    runWebServer ini si =
-      case eitherToMaybe $ T.unpack <$> lookupValue "WEB" "static_path" ini of
-        Nothing -> logWarn "No server static path set"
-        Just webStaticPath -> do
+        runWebServer webStaticPath webHttpsParams si = do
           let onionHost =
                 either (const Nothing) (find isOnion) $
                   strDecode @(L.NonEmpty TransportHost) . encodeUtf8 =<< lookupValue "TRANSPORT" "host" ini
               webHttpPort = eitherToMaybe $ read . T.unpack <$> lookupValue "WEB" "http" ini
-              webHttpsParams =
-                eitherToMaybe $ do
-                  port <- read . T.unpack <$> lookupValue "WEB" "https" ini
-                  cert <- T.unpack <$> lookupValue "WEB" "cert" ini
-                  key <- T.unpack <$> lookupValue "WEB" "key" ini
-                  pure WebHttpsParams {port, cert, key}
           generateSite si onionHost webStaticPath
           when (isJust webHttpPort || isJust webHttpsParams) $
             serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams}
           where
             isOnion = \case THOnionHost _ -> True; _ -> False
+        webHttpsParams' =
+          eitherToMaybe $ do
+            port <- read . T.unpack <$> lookupValue "WEB" "https" ini
+            cert <- T.unpack <$> lookupValue "WEB" "cert" ini
+            key <- T.unpack <$> lookupValue "WEB" "key" ini
+            pure WebHttpsParams {port, cert, key}
+        webStaticPath' = eitherToMaybe $ T.unpack <$> lookupValue "WEB" "static_path" ini
 
 data EmbeddedWebParams = EmbeddedWebParams
   { webStaticPath :: FilePath,
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index 0a005f046..da00fe231 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -66,6 +66,7 @@ module Simplex.Messaging.Transport
     connectTLS,
     closeTLS,
     defaultSupportedParams,
+    defaultSupportedParamsHTTPS,
     withTlsUnique,
 
     -- * SMP transport
@@ -100,6 +101,7 @@ import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Default (def)
 import Data.Functor (($>))
+import Data.Typeable (Typeable)
 import Data.Version (showVersion)
 import Data.Word (Word16)
 import qualified Data.X509 as X
@@ -214,7 +216,7 @@ data TransportConfig = TransportConfig
     transportTimeout :: Maybe Int
   }
 
-class Transport c where
+class Typeable c => Transport c where
   transport :: ATransport
   transport = ATransport (TProxy @c)
 
@@ -321,8 +323,29 @@ defaultSupportedParams =
           TE.cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256 -- for TLS12
         ],
       T.supportedHashSignatures = [(T.HashIntrinsic, T.SignatureEd448), (T.HashIntrinsic, T.SignatureEd25519)],
-      T.supportedSecureRenegotiation = False,
-      T.supportedGroups = [T.X448, T.X25519]
+      T.supportedGroups = [T.X448, T.X25519],
+      T.supportedSecureRenegotiation = False
+    }
+
+-- | A selection of extra parameters to accomodate browser chains
+defaultSupportedParamsHTTPS :: T.Supported
+defaultSupportedParamsHTTPS =
+  defaultSupportedParams
+    { T.supportedCiphers = TE.ciphersuite_strong,
+      T.supportedGroups = [T.X25519, T.X448, T.FFDHE4096, T.FFDHE6144, T.FFDHE8192, T.P521],
+      T.supportedHashSignatures =
+        [ (T.HashIntrinsic, T.SignatureEd448),
+          (T.HashIntrinsic, T.SignatureEd25519),
+          (T.HashSHA256, T.SignatureECDSA),
+          (T.HashSHA384, T.SignatureECDSA),
+          (T.HashSHA512, T.SignatureECDSA),
+          (T.HashIntrinsic, T.SignatureRSApssRSAeSHA512),
+          (T.HashIntrinsic, T.SignatureRSApssRSAeSHA384),
+          (T.HashIntrinsic, T.SignatureRSApssRSAeSHA256),
+          (T.HashSHA512, T.SignatureRSA),
+          (T.HashSHA384, T.SignatureRSA),
+          (T.HashSHA256, T.SignatureRSA)
+        ]
     }
 
 instance Transport TLS where
diff --git a/src/Simplex/Messaging/Transport/Client.hs b/src/Simplex/Messaging/Transport/Client.hs
index 3b80b7f73..074a85dad 100644
--- a/src/Simplex/Messaging/Transport/Client.hs
+++ b/src/Simplex/Messaging/Transport/Client.hs
@@ -125,7 +125,8 @@ data TransportClientConfig = TransportClientConfig
     tcpKeepAlive :: Maybe KeepAliveOpts,
     logTLSErrors :: Bool,
     clientCredentials :: Maybe (X.CertificateChain, T.PrivKey),
-    alpn :: Maybe [ALPN]
+    alpn :: Maybe [ALPN],
+    useSNI :: Bool
   }
   deriving (Eq, Show)
 
@@ -134,7 +135,7 @@ defaultTcpConnectTimeout :: Int
 defaultTcpConnectTimeout = 25_000_000
 
 defaultTransportClientConfig :: TransportClientConfig
-defaultTransportClientConfig = TransportClientConfig Nothing defaultTcpConnectTimeout (Just defaultKeepAliveOpts) True Nothing Nothing
+defaultTransportClientConfig = TransportClientConfig Nothing defaultTcpConnectTimeout (Just defaultKeepAliveOpts) True Nothing Nothing True
 
 clientTransportConfig :: TransportClientConfig -> TransportConfig
 clientTransportConfig TransportClientConfig {logTLSErrors} =
@@ -145,10 +146,10 @@ runTransportClient :: Transport c => TransportClientConfig -> Maybe SocksCredent
 runTransportClient = runTLSTransportClient defaultSupportedParams Nothing
 
 runTLSTransportClient :: Transport c => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a
-runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials, alpn} socksCreds host port keyHash client = do
+runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials, alpn, useSNI} socksCreds host port keyHash client = do
   serverCert <- newEmptyTMVarIO
   let hostName = B.unpack $ strEncode host
-      clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash clientCredentials alpn serverCert
+      clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash clientCredentials alpn useSNI serverCert
       connectTCP = case socksProxy of
         Just proxy -> connectSocksClient proxy socksCreds (hostAddr host)
         _ -> connectTCPClient hostName
@@ -238,7 +239,7 @@ instance StrEncoding SocksProxy where
       socksAddr port = \case
         THIPv4 addr -> pure $ SockAddrInet port $ tupleToHostAddress addr
         THIPv6 addr -> pure $ SockAddrInet6 port 0 addr 0
-        _ -> fail "SOCKS5 host should be IPv4 or IPv6 address"          
+        _ -> fail "SOCKS5 host should be IPv4 or IPv6 address"
 
 instance StrEncoding SocksProxyWithAuth where
   strEncode (SocksProxyWithAuth auth proxy) = strEncode auth <> strEncode proxy
@@ -263,10 +264,11 @@ instance StrEncoding SocksAuth where
         password <- A.takeTill (== '@') <* A.char '@'
         pure SocksAuthUsername {username, password}
 
-mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe (X.CertificateChain, T.PrivKey) -> Maybe [ALPN] -> TMVar X.CertificateChain -> T.ClientParams
-mkTLSClientParams supported caStore_ host port cafp_ clientCreds_ alpn_ serverCerts =
+mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe (X.CertificateChain, T.PrivKey) -> Maybe [ALPN] -> Bool -> TMVar X.CertificateChain -> T.ClientParams
+mkTLSClientParams supported caStore_ host port cafp_ clientCreds_ alpn_ sni serverCerts =
   (T.defaultParamsClient host p)
-    { T.clientShared = def {T.sharedCAStore = fromMaybe (T.sharedCAStore def) caStore_},
+    { T.clientUseServerNameIndication = sni,
+      T.clientShared = def {T.sharedCAStore = fromMaybe (T.sharedCAStore def) caStore_},
       T.clientHooks =
         def
           { T.onServerCertificate = onServerCert,
diff --git a/src/Simplex/Messaging/Transport/HTTP2/Client.hs b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
index 53f229f06..b5e05d20d 100644
--- a/src/Simplex/Messaging/Transport/HTTP2/Client.hs
+++ b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
@@ -78,7 +78,8 @@ defaultHTTP2ClientConfig =
             tcpKeepAlive = Nothing,
             logTLSErrors = True,
             clientCredentials = Nothing,
-            alpn = Nothing
+            alpn = Nothing,
+            useSNI = True
           },
       bufferSize = defaultHTTP2BufferSize,
       bodyHeadSize = 16384,
diff --git a/src/Simplex/Messaging/Transport/Server.hs b/src/Simplex/Messaging/Transport/Server.hs
index 5c3be519c..fe4bd5879 100644
--- a/src/Simplex/Messaging/Transport/Server.hs
+++ b/src/Simplex/Messaging/Transport/Server.hs
@@ -7,8 +7,10 @@
 module Simplex.Messaging.Transport.Server
   ( TransportServerConfig (..),
     ServerCredentials (..),
+    AddHTTP,
     defaultTransportServerConfig,
     runTransportServerState,
+    runTransportServerState_,
     SocketState,
     newSocketState,
     runTransportServer,
@@ -65,6 +67,8 @@ data ServerCredentials = ServerCredentials
   }
   deriving (Show)
 
+type AddHTTP = Bool
+
 defaultTransportServerConfig :: TransportServerConfig
 defaultTransportServerConfig =
   TransportServerConfig
@@ -87,32 +91,35 @@ runTransportServer started port srvSupported srvCreds alpn_ cfg server = do
   runTransportServerState ss started port srvSupported srvCreds alpn_ cfg server
 
 runTransportServerState :: forall c . Transport c => SocketState -> TMVar Bool -> ServiceName -> T.Supported -> T.Credential -> Maybe [ALPN] -> TransportServerConfig -> (c -> IO ()) -> IO ()
-runTransportServerState ss started port = runTransportServerSocketState ss started (startTCPServer started Nothing port) (transportName (TProxy :: TProxy c))
+runTransportServerState ss started port srvSupported srvCreds alpn_ cfg server = runTransportServerState_ ss started port srvSupported (const srvCreds) alpn_ cfg (const server)
+
+runTransportServerState_ :: forall c . Transport c => SocketState -> TMVar Bool -> ServiceName -> T.Supported -> (Maybe HostName -> T.Credential) -> Maybe [ALPN] -> TransportServerConfig -> (Socket -> c -> IO ()) -> IO ()
+runTransportServerState_ ss started port = runTransportServerSocketState ss started (startTCPServer started Nothing port) (transportName (TProxy :: TProxy c))
 
 -- | Run a transport server with provided connection setup and handler.
 runTransportServerSocket :: Transport a => TMVar Bool -> IO Socket -> String -> T.Credential -> T.ServerParams -> TransportServerConfig -> (a -> IO ()) -> IO ()
 runTransportServerSocket started getSocket threadLabel srvCreds srvParams cfg server = do
   ss <- newSocketState
-  runTransportServerSocketState_ ss started getSocket threadLabel srvCreds srvParams cfg server
+  runTransportServerSocketState_ ss started getSocket threadLabel (const srvCreds) srvParams cfg (const server)
 
-runTransportServerSocketState :: Transport a => SocketState -> TMVar Bool -> IO Socket -> String -> T.Supported -> (X.CertificateChain, X.PrivKey) -> Maybe [ALPN] -> TransportServerConfig -> (a -> IO ()) -> IO ()
+runTransportServerSocketState :: Transport a => SocketState -> TMVar Bool -> IO Socket -> String -> T.Supported -> (Maybe HostName -> T.Credential) -> Maybe [ALPN] -> TransportServerConfig -> (Socket -> a -> IO ()) -> IO ()
 runTransportServerSocketState ss started getSocket threadLabel srvSupported srvCreds alpn_ =
   runTransportServerSocketState_ ss started getSocket threadLabel srvCreds srvParams
   where
     srvParams = supportedTLSServerParams_ srvSupported srvCreds alpn_
 
 -- | Run a transport server with provided connection setup and handler.
-runTransportServerSocketState_ :: Transport a => SocketState -> TMVar Bool -> IO Socket -> String -> (X.CertificateChain, X.PrivKey) -> T.ServerParams -> TransportServerConfig -> (a -> IO ()) -> IO ()
+runTransportServerSocketState_ :: Transport a => SocketState -> TMVar Bool -> IO Socket -> String -> (Maybe HostName -> (X.CertificateChain, X.PrivKey)) -> T.ServerParams -> TransportServerConfig -> (Socket -> a -> IO ()) -> IO ()
 runTransportServerSocketState_ ss started getSocket threadLabel srvCreds srvParams cfg server = do
   labelMyThread $ "transport server for " <> threadLabel
   runTCPServerSocket ss started getSocket $ \conn ->
-    E.bracket (setup conn >>= maybe (fail "tls setup timeout") pure) closeConnection server
+    E.bracket (setup conn >>= maybe (fail "tls setup timeout") pure) closeConnection (server conn)
   where
     tCfg = serverTransportConfig cfg
     setup conn = timeout (tlsSetupTimeout cfg) $ do
       labelMyThread $ threadLabel <> "/setup"
       tls <- connectTLS Nothing tCfg srvParams conn
-      getServerConnection tCfg (fst srvCreds) tls
+      getServerConnection tCfg (fst $ srvCreds Nothing) tls
 
 -- | Run TCP server without TLS
 runLocalTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
@@ -191,15 +198,15 @@ loadServerCredential ServerCredentials {caCertificateFile, certificateFile, priv
     Left _ -> putStrLn "invalid credential" >> exitFailure
 
 supportedTLSServerParams :: T.Credential -> Maybe [ALPN] -> T.ServerParams
-supportedTLSServerParams = supportedTLSServerParams_ defaultSupportedParams
+supportedTLSServerParams = supportedTLSServerParams_ defaultSupportedParams . const
 
-supportedTLSServerParams_ :: T.Supported -> T.Credential -> Maybe [ALPN] -> T.ServerParams
-supportedTLSServerParams_ serverSupported credential alpn_ =
+supportedTLSServerParams_ :: T.Supported -> (Maybe HostName -> T.Credential) -> Maybe [ALPN] -> T.ServerParams
+supportedTLSServerParams_ serverSupported creds alpn_ =
   def
     { T.serverWantClientCert = False,
       T.serverHooks =
         def
-          { T.onServerNameIndication = \_ -> pure $ T.Credentials [credential],
+          { T.onServerNameIndication = \host_ -> pure $ T.Credentials [creds host_],
             T.onALPNClientSuggest = (\alpn -> pure . fromMaybe "" . find (`elem` alpn)) <$> alpn_
           },
       T.serverSupported = serverSupported
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index ca9a27075..199b1a36a 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -2869,7 +2869,7 @@ testCreateQueueAuth srvVersion clnt1 clnt2 sqSecured baseId = do
     getClient clientId (clntAuth, clntVersion) db =
       let servers = initAgentServers {smp = userServers' [ProtoServerWithAuth testSMPServer clntAuth]}
           alpn_ = if clntVersion >= authCmdsSMPVersion then Just supportedSMPHandshakes else Nothing
-          smpCfg = defaultClientConfig alpn_ $ V.mkVersionRange (prevVersion basicAuthSMPVersion) clntVersion
+          smpCfg = defaultClientConfig alpn_ False $ V.mkVersionRange (prevVersion basicAuthSMPVersion) clntVersion
           sndAuthAlg = if srvVersion >= authCmdsSMPVersion && clntVersion >= authCmdsSMPVersion then C.AuthAlg C.SX25519 else C.AuthAlg C.SEd25519
        in getSMPAgentClient' clientId agentCfg {smpCfg, sndAuthAlg} servers db
 
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index a25564a0b..40071873c 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -178,7 +178,7 @@ runNtfTestCfg :: HasCallStack => ATransport -> AgentMsgId -> ServerConfig -> Ntf
 runNtfTestCfg t baseId smpCfg ntfCfg aCfg bCfg runTest = do
   withSmpServerConfigOn t smpCfg testPort $ \_ ->
     withAPNSMockServer $ \apns ->
-      withNtfServerCfg ntfCfg {transports = [(ntfTestPort, t)]} $ \_ ->
+      withNtfServerCfg ntfCfg {transports = [(ntfTestPort, t, False)]} $ \_ ->
         withAgentClientsCfg2 aCfg bCfg $ runTest apns baseId
   threadDelay 100000
 
diff --git a/tests/CLITests.hs b/tests/CLITests.hs
index 1310665ee..e8417fc8b 100644
--- a/tests/CLITests.hs
+++ b/tests/CLITests.hs
@@ -3,15 +3,31 @@
 
 module CLITests where
 
-import Data.Ini (lookupValue, readIniFile)
+import AgentTests.FunctionalAPITests (runRight_)
+import Control.Logger.Simple
+import Control.Monad
+import qualified Crypto.PubKey.RSA as RSA
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.HashMap.Strict as HM
+import Data.Ini (Ini (..), lookupValue, readIniFile, writeIniFile)
 import Data.List (isPrefixOf)
+import qualified Data.Text as T
 import qualified Data.X509 as X
 import qualified Data.X509.File as XF
+import Data.X509.Validation (Fingerprint (..))
+import qualified Network.HTTP.Client as H1
+import qualified Network.HTTP2.Client as H2
 import Simplex.FileTransfer.Server.Main (xftpServerCLI)
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Server.Main
-import Simplex.Messaging.Server.Main
-import Simplex.Messaging.Transport (simplexMQVersion)
+import Simplex.Messaging.Server.Main (smpServerCLI, smpServerCLI_)
+import Simplex.Messaging.Transport (TLS (..), defaultSupportedParams, defaultSupportedParamsHTTPS, simplexMQVersion, supportedClientSMPRelayVRange)
+import Simplex.Messaging.Transport.Client (TransportClientConfig (..), defaultTransportClientConfig, runTLSTransportClient, smpClientHandshake)
+import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
+import qualified Simplex.Messaging.Transport.HTTP2.Client as HC
+import Simplex.Messaging.Transport.Server (loadFileFingerprint)
 import Simplex.Messaging.Util (catchAll_)
+import qualified Static
 import System.Directory (doesFileExist)
 import System.Environment (withArgs)
 import System.FilePath ((</>))
@@ -19,6 +35,10 @@ import System.IO.Silently (capture_)
 import System.Timeout (timeout)
 import Test.Hspec
 import Test.Main (withStdin)
+import UnliftIO (catchAny)
+import UnliftIO.Async (async, cancel)
+import UnliftIO.Concurrent (threadDelay)
+import UnliftIO.Exception (bracket)
 
 cfgPath :: FilePath
 cfgPath = "tests/tmp/cli/etc/opt/simplex"
@@ -26,6 +46,9 @@ cfgPath = "tests/tmp/cli/etc/opt/simplex"
 logPath :: FilePath
 logPath = "tests/tmp/cli/etc/var/simplex"
 
+webPath :: FilePath
+webPath = "tests/tmp/cli/var/www"
+
 ntfCfgPath :: FilePath
 ntfCfgPath = "tests/tmp/cli/etc/opt/simplex-notifications"
 
@@ -46,6 +69,7 @@ cliTests = do
       it "with store log, random password (default)" $ smpServerTest True True
       it "no store log, no password" $ smpServerTest False False
       it "with store log, no password" $ smpServerTest True False
+      it "static files" smpServerTestStatic
   describe "Ntf server CLI" $ do
     it "should initialize, start and delete the server (no store log)" $ ntfServerTest False
     it "should initialize, start and delete the server (with store log)" $ ntfServerTest True
@@ -61,7 +85,7 @@ smpServerTest storeLog basicAuth = do
   Right ini <- readIniFile $ cfgPath <> "/smp-server.ini"
   lookupValue "STORE_LOG" "enable" ini `shouldBe` Right (if storeLog then "on" else "off")
   lookupValue "STORE_LOG" "log_stats" ini `shouldBe` Right "off"
-  lookupValue "TRANSPORT" "port" ini `shouldBe` Right "5223"
+  lookupValue "TRANSPORT" "port" ini `shouldBe` Right "5223,443"
   lookupValue "TRANSPORT" "websockets" ini `shouldBe` Right "off"
   lookupValue "AUTH" "new_queues" ini `shouldBe` Right "on"
   lookupValue "INACTIVE_CLIENTS" "disconnect" ini `shouldBe` Right "off"
@@ -70,7 +94,7 @@ smpServerTest storeLog basicAuth = do
   r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` smpServerCLI cfgPath logPath) `catchAll_` pure (Just ()))
   r `shouldContain` ["SMP server v" <> simplexMQVersion]
   r `shouldContain` (if storeLog then ["Store log: " <> logPath <> "/smp-server-store.log"] else ["Store log disabled."])
-  r `shouldContain` ["Listening on port 5223 (TLS)..."]
+  r `shouldContain` ["Serving SMP protocol on port 5223 (TLS)...", "Serving SMP protocol on port 443 (TLS)...", "Serving static site on port 443 (TLS)..."]
   r `shouldContain` ["not expiring inactive clients"]
   r `shouldContain` (if basicAuth then ["creating new queues requires password"] else ["creating new queues allowed"])
   -- cert
@@ -94,6 +118,70 @@ smpServerTest storeLog basicAuth = do
     >>= (`shouldSatisfy` ("WARNING: deleting the server will make all queues inaccessible" `isPrefixOf`))
   doesFileExist (cfgPath <> "/ca.key") `shouldReturn` False
 
+smpServerTestStatic :: HasCallStack => IO ()
+smpServerTestStatic = do
+  let iniFile = cfgPath <> "/smp-server.ini"
+  capture_ (withArgs ["init", "-y", "--no-password", "--web-path", webPath] $ smpServerCLI cfgPath logPath)
+    >>= (`shouldSatisfy` (("Server initialized, please provide additional server information in " <> iniFile) `isPrefixOf`))
+  doesFileExist (cfgPath <> "/ca.key") `shouldReturn` True
+  Right ini <- readIniFile iniFile
+  lookupValue "WEB" "static_path" ini `shouldBe` Right (T.pack webPath)
+  let transport = [("host", "localhost"), ("port", "5223"), ("log_tls_errors", "off"), ("websockets", "off")]
+      web = [("http", "8000"), ("https", "5223"), ("cert", "tests/fixtures/web.crt"), ("key", "tests/fixtures/web.key"), ("static_path", T.pack webPath)]
+      ini' = ini {iniSections = HM.insert "TRANSPORT" transport $ HM.insert "WEB" web (iniSections ini)}
+  writeIniFile iniFile ini'
+
+  Right ini_ <- readIniFile iniFile
+  lookupValue "WEB" "https" ini_ `shouldBe` Right "5223"
+
+  let smpServerCLI' = smpServerCLI_ Static.generateSite Static.serveStaticFiles Static.attachStaticFiles
+  let server = capture_ (withArgs ["start"] $ smpServerCLI' cfgPath logPath `catchAny` print)
+  bracket (async server) cancel $ \_t -> do
+    threadDelay 1000000
+    html <- BL.readFile $ webPath <> "/index.html"
+
+    -- "external" CA signing HTTP credentials
+    Fingerprint fpHTTP <- loadFileFingerprint "tests/fixtures/ca.crt"
+    let caHTTP = C.KeyHash fpHTTP
+    manager <- H1.newManager H1.defaultManagerSettings
+    H1.responseBody <$> H1.httpLbs "http://127.0.0.1:8000" manager `shouldReturn` html
+    logDebug "Plain HTTP works"
+
+    threadDelay 2000000
+
+    let cfgHttp = defaultTransportClientConfig {alpn = Just ["h2"], useSNI = True}
+    runTLSTransportClient defaultSupportedParamsHTTPS Nothing cfgHttp Nothing "localhost" "5223" (Just caHTTP) $ \tls -> do
+      tlsALPN tls `shouldBe` Just "h2"
+      case getCerts tls of
+        X.Certificate {X.certPubKey = X.PubKeyRSA rsa} : _ca -> RSA.public_size rsa `shouldBe` 512
+        leaf : _ -> error $ "Unexpected leaf cert: " <> show leaf
+        [] -> error "Empty chain"
+
+      let h2cfg = HC.defaultHTTP2ClientConfig {HC.bodyHeadSize = 1024 * 1024}
+      h2 <- either (error . show) pure =<< HC.attachHTTP2Client h2cfg "localhost" "5223" mempty 65536 tls
+      let req = H2.requestNoBody "GET" "/" []
+      HC.HTTP2Response {HC.respBody = HTTP2Body {bodyHead = shsBody}} <- either (error . show) pure =<< HC.sendRequest h2 req (Just 1000000)
+      BL.fromStrict shsBody `shouldBe` html
+    logDebug "Combined HTTPS works"
+
+    -- "local" CA signing SMP credentials
+    Fingerprint fpSMP <- loadFileFingerprint (cfgPath <> "/ca.crt")
+    let caSMP = C.KeyHash fpSMP
+    let cfgSmp = defaultTransportClientConfig {alpn = Just ["smp/1"], useSNI = False}
+    runTLSTransportClient defaultSupportedParams Nothing cfgSmp Nothing "localhost" "5223" (Just caSMP) $ \tls -> do
+      tlsALPN tls `shouldBe` Just "smp/1"
+      case getCerts tls of
+        X.Certificate {X.certPubKey = X.PubKeyEd25519 _k} : _ca -> print _ca -- pure ()
+        leaf : _ -> error $ "Unexpected leaf cert: " <> show leaf
+        [] -> error "Empty chain"
+      runRight_ . void $ smpClientHandshake tls Nothing caSMP supportedClientSMPRelayVRange
+    logDebug "Combined SMP works"
+  where
+    getCerts :: TLS -> [X.Certificate]
+    getCerts tls =
+      let X.CertificateChain cc = tlsServerCerts tls
+       in map (X.signedObject . X.getSigned) cc
+
 ntfServerTest :: Bool -> IO ()
 ntfServerTest storeLog = do
   capture_ (withArgs (["init"] <> ["-l" | storeLog]) $ ntfServerCLI ntfCfgPath ntfLogPath)
@@ -107,7 +195,7 @@ ntfServerTest storeLog = do
   r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` ntfServerCLI ntfCfgPath ntfLogPath) `catchAll_` pure (Just ()))
   r `shouldContain` ["SMP notifications server v" <> simplexMQVersion]
   r `shouldContain` (if storeLog then ["Store log: " <> ntfLogPath <> "/ntf-server-store.log"] else ["Store log disabled."])
-  r `shouldContain` ["Listening on port 443 (TLS)..."]
+  r `shouldContain` ["Serving SMP protocol on port 443 (TLS)..."]
   capture_ (withStdin "Y" . withArgs ["delete"] $ ntfServerCLI ntfCfgPath ntfLogPath)
     >>= (`shouldSatisfy` ("WARNING: deleting the server will make all queues inaccessible" `isPrefixOf`))
   doesFileExist (cfgPath <> "/ca.key") `shouldReturn` False
diff --git a/tests/CoreTests/SOCKSSettings.hs b/tests/CoreTests/SOCKSSettings.hs
index 385208fd4..78e4ae187 100644
--- a/tests/CoreTests/SOCKSSettings.hs
+++ b/tests/CoreTests/SOCKSSettings.hs
@@ -90,7 +90,7 @@ testSocksMode = do
   where
     transportSocks proxy socksMode = transportSocksCfg defaultNetworkConfig {socksProxy = proxy, socksMode}
     transportSocksCfg cfg host =
-      let TransportClientConfig {socksProxy} = transportClientConfig cfg host
+      let TransportClientConfig {socksProxy} = transportClientConfig cfg host True
        in socksProxy
 
 testSocksProxyEncoding :: Spec
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index accaa4d37..87ff797f0 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -122,10 +122,10 @@ ntfServerCfgVPrev =
     serverVRange' = serverVRange smpCfg'
 
 withNtfServerStoreLog :: ATransport -> (ThreadId -> IO a) -> IO a
-withNtfServerStoreLog t = withNtfServerCfg ntfServerCfg {storeLogFile = Just ntfTestStoreLogFile, transports = [(ntfTestPort, t)]}
+withNtfServerStoreLog t = withNtfServerCfg ntfServerCfg {storeLogFile = Just ntfTestStoreLogFile, transports = [(ntfTestPort, t, False)]}
 
 withNtfServerThreadOn :: ATransport -> ServiceName -> (ThreadId -> IO a) -> IO a
-withNtfServerThreadOn t port' = withNtfServerCfg ntfServerCfg {transports = [(port', t)]}
+withNtfServerThreadOn t port' = withNtfServerCfg ntfServerCfg {transports = [(port', t, False)]}
 
 withNtfServerCfg :: HasCallStack => NtfServerConfig -> (ThreadId -> IO a) -> IO a
 withNtfServerCfg cfg@NtfServerConfig {transports} =
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 2cf92640f..970be7174 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -121,6 +121,7 @@ cfg =
             privateKeyFile = "tests/fixtures/server.key",
             certificateFile = "tests/fixtures/server.crt"
           },
+      httpCredentials = Nothing,
       smpServerVRange = supportedServerSMPRelayVRange,
       transportConfig = defaultTransportServerConfig,
       controlPort = Nothing,
@@ -166,7 +167,7 @@ withSmpServerStoreLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just tes
 withSmpServerConfigOn :: HasCallStack => ATransport -> ServerConfig -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withSmpServerConfigOn t cfg' port' =
   serverBracket
-    (\started -> runSMPServerBlocking started cfg' {transports = [(port', t)]})
+    (\started -> runSMPServerBlocking started cfg' {transports = [(port', t, False)]} Nothing)
     (threadDelay 10000)
 
 withSmpServerThreadOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
diff --git a/tests/fixtures/web.crt b/tests/fixtures/web.crt
new file mode 100644
index 000000000..4de287b1e
--- /dev/null
+++ b/tests/fixtures/web.crt
@@ -0,0 +1,34 @@
+-----BEGIN CERTIFICATE-----
+MIIDnTCCAx2gAwIBAgIUFhZZsKj9uBgGnUrr+Cf3XFf7t6IwBQYDK2VxMCoxFjAU
+BgNVBAMMDVNNUCBzZXJ2ZXIgQ0ExEDAOBgNVBAoMB1NpbXBsZVgwIBcNMjQwOTI2
+MTIyNTEyWhgPNDc2MjA4MjMxMjI1MTJaMBQxEjAQBgNVBAMMCWxvY2FsaG9zdDCC
+AiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBALB59b8oyxP5YtXI1kemBzJU
+Pt0xLN/Tmzdul283DhbNCJV+eUn4fNz+PjiRS/F2vZLb3WXInPi3bc57hw2Yu94o
+7MXH5DTWkaubNq0bV0Koi17zZBSCOOq+MbPN7bUT1sOwOHadLh3IWTfkz9EufowD
+ivpymNKWbeAHMXlXsBJnHfHuM05MWlP87PTHd3D7YQmmgbISgEGG4GchWBqnnCxx
+gOOa09f/n+gWJFbN3hkbVZKMEpT5gu9WWsgv9BDhJzcBSw13MMz0sByxYKzhwQBJ
+ikFz+16AttZ0ccoDaWwajZzK8+yfFv9T3b8kWmioHi2dw2vBgSove78liUqYCsOU
+Bt5MNk3P037KgSJPdp6azsF3bMKmPssEhT9vHMPgSkiBfmBlJ7dTTRd9dh/cLKIO
+AMzu4O+pEodIOJDXTARBE6VX1qoEZQuft5+ljVy4i9ySpmHnkxLocF40rKV1G0c5
+LnVNTtr5GokC9sfIXZPZw0EEpk3eAseNWccwuyRfHQfL6yjcDig2IdLvLVcm9JyA
+2P5QpP15EoA3Ow9uX8HmBbSFe1F35rqcNwY0lhDXEboSA/X4xDLnu4aVhNPiUnRq
+NXqVlgz5ybRAUHd8fDBwK8fT5VhvuEnCja7+8hVc33gK56vu+28ZMkN2Y4z0GNQd
+iamPUZJlUcCJzNI2cz27AgMBAAGjbzBtMAkGA1UdEwQCMAAwCwYDVR0PBAQDAgPI
+MBMGA1UdJQQMMAoGCCsGAQUFBwMBMB0GA1UdDgQWBBSWiPT6Nl13/CTjaHCkHp17
+GWoyvzAfBgNVHSMEGDAWgBQcUJvR7mm26yxMQfCsWgbnwMmJVDAFBgMrZXEDcwDC
+DTbvSA61ydoRA8mTHFW1EYL+xfQjo0aH56N1Aqn47DzLGQZjP/fxoW929+Jwoiz0
+UgUtUAeFjgA9wfvDv7mMm/K4wqyiZzFuWVZdQV6AUwBJK0hN5qlXpvJzMKLrj3Ap
+dRELAgLJvC2e/xVc3dXSFwA=
+-----END CERTIFICATE-----
+-----BEGIN CERTIFICATE-----
+MIIBtjCCATagAwIBAgIUe2PryrWo0xXX9vcA3WfbCzcdmgAwBQYDK2VxMCoxFjAU
+BgNVBAMMDVNNUCBzZXJ2ZXIgQ0ExEDAOBgNVBAoMB1NpbXBsZVgwIBcNMjIwMTEx
+MTExNjM5WhgPNDc1OTEyMDgxMTE2MzlaMCoxFjAUBgNVBAMMDVNNUCBzZXJ2ZXIg
+Q0ExEDAOBgNVBAoMB1NpbXBsZVgwQzAFBgMrZXEDOgCAcvFwVicR+RLZpiEWPFNR
+XYTbf+mFcX1NHIyPQDugFwOCgqJAW1fsjYgFhtQJSMH/lc1N7clfm4CjUzBRMB0G
+A1UdDgQWBBQcUJvR7mm26yxMQfCsWgbnwMmJVDAfBgNVHSMEGDAWgBQcUJvR7mm2
+6yxMQfCsWgbnwMmJVDAPBgNVHRMBAf8EBTADAQH/MAUGAytlcQNzAAAP/hMPNxyW
+fyJi+iJViodU+C/aklnvHtjh5P3AbiVCSUfY6+PEdvkC8Ov0pBAYpYi5ukSNNVXl
+ABVRlipB+vOcLQStNyaZ7kXzQ2IO/0btmIidh+G6SP8I4aytYIYYcV5pEUZpG1L1
+57g8P29SDv81AA==
+-----END CERTIFICATE-----
diff --git a/tests/fixtures/web.key b/tests/fixtures/web.key
new file mode 100644
index 000000000..249d8b8b6
--- /dev/null
+++ b/tests/fixtures/web.key
@@ -0,0 +1,52 @@
+-----BEGIN PRIVATE KEY-----
+MIIJQwIBADANBgkqhkiG9w0BAQEFAASCCS0wggkpAgEAAoICAQCwefW/KMsT+WLV
+yNZHpgcyVD7dMSzf05s3bpdvNw4WzQiVfnlJ+Hzc/j44kUvxdr2S291lyJz4t23O
+e4cNmLveKOzFx+Q01pGrmzatG1dCqIte82QUgjjqvjGzze21E9bDsDh2nS4dyFk3
+5M/RLn6MA4r6cpjSlm3gBzF5V7ASZx3x7jNOTFpT/Oz0x3dw+2EJpoGyEoBBhuBn
+IVgap5wscYDjmtPX/5/oFiRWzd4ZG1WSjBKU+YLvVlrIL/QQ4Sc3AUsNdzDM9LAc
+sWCs4cEASYpBc/tegLbWdHHKA2lsGo2cyvPsnxb/U92/JFpoqB4tncNrwYEqL3u/
+JYlKmArDlAbeTDZNz9N+yoEiT3aems7Bd2zCpj7LBIU/bxzD4EpIgX5gZSe3U00X
+fXYf3CyiDgDM7uDvqRKHSDiQ10wEQROlV9aqBGULn7efpY1cuIvckqZh55MS6HBe
+NKyldRtHOS51TU7a+RqJAvbHyF2T2cNBBKZN3gLHjVnHMLskXx0Hy+so3A4oNiHS
+7y1XJvScgNj+UKT9eRKANzsPbl/B5gW0hXtRd+a6nDcGNJYQ1xG6EgP1+MQy57uG
+lYTT4lJ0ajV6lZYM+cm0QFB3fHwwcCvH0+VYb7hJwo2u/vIVXN94Cuer7vtvGTJD
+dmOM9BjUHYmpj1GSZVHAiczSNnM9uwIDAQABAoICAAIOOHg0nO85RMTNItpjgeYY
+P0HGvIAk63rX4dqss9lhbQBie9B4HPzIjjEfMv13qj5VBtimllYNTXrEuSUzeCi6
+E7vyTpo+qv/YEHtUadb/2tzfe1BxjdyX0vfz+CtXbAeefH1O6mGrI/Uuo3Xmpc9p
+jJSmpg/DBl53Amm6xWLk6rq7dcNiWrfZS0T9xYFQmx7RlZwmct/ZqR56Zrw942ff
+Hkts9psniyeiHBr2cnpRrEJry69T0q6JIeP+5doWewCqzPl+9rMyKiT6RV3uJKpu
+Z7ZavthNl6Xj+FTDHdcGJ0v5Bg/llQ8Qb6f/FsLImM6IgBwlj4AXXMiP1SboolEo
+TDgt4DE0sd7o5ZU+5gjI2E9l1JLk68Rh64YIY1pr7CDURkWYwGyR3Bs9mG3RVKZr
+ANl08YeqtTH8LnqASJyKq6+xthDSCRbEP6uFM/Y5jjjbCWXELtaWqRYo1esHjPU2
+OfVI8tE13+ewLhjCUvarf9TA4Edkut7celuNgPsm58+cA5FSQiuuGrR6RoeOCYEd
+a9knZQriLebcHT8ifh1SfbuElhSMiSTUReEXzOEjs9+/kZ8BEQWWmspGVq/RiOoj
+jtPrDE11wqRjjK2SjLwFQ0NlHo+sUGxH7IJMVOHONcaFde87KTggjFr2HJgOtkYe
+zii/I6bVCH6IxKZ3jBqlAoIBAQD085iZEgp1uoXqnlNgL49qy8a2Zev5B3mQjS61
+1+LYurIKm2TnWFdUyrqOyY9EQ5mj7LbtntcIseW5gNPqHF9F8UQ3NfU1uXiKpBGF
+dLi/NGPPOoeep4GOOo7+TFluwPQILB7UPoLrU+cNcNt6V5FMKkRaANb/nxxPdWWS
+UPpCU2zoRNoeGEvXU3yPlhMJcCWYc6wP6YXClqrUsUmcX0x1MPY54ad18jxjR1P9
+msemV98tqI9/utjuL0sOIZKlfR225Bj3RQ6u1dPqwPaWVcXH+I4za/SYnJ8Ivrz4
+hokIHUPHbC1C/+wfVQhLU5Z9fT061IHKwmVX1NRC0aYdxm0tAoIBAQC4b7IiEcRW
+BgmBRM4/BgKCHoqZwEojZozYTBzsEQinRY5spfEow+ONUFYubnr4rDOHVTUMHStm
+GEvRfZyGMU7Xp0BkbVyMrrUCGhOLtIL7qLsN1ZryUGuZzFO0u7Q8lvYRKiuHtq1v
+QVqFzOVut+Wa0e//RCStrGlex6ZXpGrHf6EISc2jeDeLTcVcQkLY6pQoMtMFkjJi
+7l671AUA5ISqCiJv9DbL2XItZGw1N9zXXy4tLJGr4gOyX0+JE9FFyTUaC5Yeu8FO
+0qxop1hW/ekEYISMJtEvigphAhv5hShEUp5+ZqNcnUxj5FejFDfBi6sHT9vmcNwA
+RoYkzuvtpzeHAoIBACp0mitVvChhltpubKcMN0BcZ2mvyrGUARbz0XfFHlVQLpG2
+E0whvKk+pg0flExRpyyJV79hu4WPR/DaCmDWYBEAW0Fygbi5F9J3022dKHRDgVUm
+oOD3yXW8YpJi61FN8j4EX6eL2ictmKt0tyXCTbW00boD0T/m9QI0p9EvZeDfEs5D
+OMbkkSiWGM3ORihpnqqIyfbME9oBQUSyIb8PqXHadaLcoKjJvnu6ni0jiZ0kN9Nz
+FsQdv4GxAsJFQWSbhe3wJP+eoYfeGefjYBn4bdpWE1eIS5Gz+8CJRrmQn+mfIONM
+tZ+aOfPISjK8HyZK8bTjpkddYDFT+yJFshQRE1UCggEBAJC7rllIAf/Tqv/TY9pX
+N/6uQuvW1xcisaJHUGb8EwNY9SRTsITh/B74DTlQn5WnZKRt/DvuZBExPcY+wWcZ
+KJrY+BIXNAp+SzNEDVSTqjoctfVsS7Sd4WKG0qVAq3bkrGLZ6eENPNrSuVvIZ79T
+9o1g8+ooqnPTmbi0Cdg7AURe5pqfeA0xGL1roVX99YFNzEgjYi+8A2hZUOQqxGZn
+7aeWXmHmjl233P68EKJOnTIx0gXHNOVibq46Vyrl71LJS6+NqheiFVdqwbs6n3tc
+s9AogbuN9phMxkpMInHTyb6b6x6cItRZ6Al3tkIWao6qsOMDCziyFiLtNPWLn98W
+Wt8CggEBAPNpzv2HT1BkDOvWzPxKtKZg9dDRoPi12N2jVLoGqnrHf8r3+oqOYcHs
+zsi1QgXsGoTHFGJZZ9Op5FSlcffTKiIb9IJESfkSjp7njSvYeiKyTkYzlb/N42qy
+qgIph91xrT35NEMJQIvHX0wEFaJZ2BDdVRXgUo6cwhBJp5JjwQTwZ3msqCVC6wBk
+iJGL46LAE7/6YalcwlvBxMudW+NrZ8TRnzEOBMzgHf5K8e6sGfhllspCG0HmzyBX
+euEfBjGykCmlNTs55/p/4aXBY8ydJQK7o8aBlEgL3EYqoDTyq8kSar6O35rnXpP8
+mPykG5ZK8mWK1XSXXze7YGNUW1TjtmY=
+-----END PRIVATE KEY-----

From e12710fa555390c3f0051509daa9f90c4c2486a1 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 29 Sep 2024 18:46:38 +0100
Subject: [PATCH 129/195] smp server: show version on server page (#1341)

---
 apps/smp-server/static/index.html | 4 ++++
 apps/smp-server/web/Static.hs     | 4 +++-
 2 files changed, 7 insertions(+), 1 deletion(-)

diff --git a/apps/smp-server/static/index.html b/apps/smp-server/static/index.html
index e276ff596..de7ac9e46 100644
--- a/apps/smp-server/static/index.html
+++ b/apps/smp-server/static/index.html
@@ -221,6 +221,10 @@
               Public information
             </h2>
             <table id="public-info">
+              <tr class="text-grey-black dark:text-white text-base">
+                <td>Server version:</td>
+                <td>${version}</td>
+              </tr>
               <tr class="text-grey-black dark:text-white text-base">
                 <td>Source code:</td>
                 <td><a href="${sourceCode}" target="_blank">${sourceCode}</a></td>
diff --git a/apps/smp-server/web/Static.hs b/apps/smp-server/web/Static.hs
index 266ad663e..510034a4a 100644
--- a/apps/smp-server/web/Static.hs
+++ b/apps/smp-server/web/Static.hs
@@ -7,7 +7,7 @@ module Static where
 import Control.Logger.Simple
 import Control.Monad
 import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as B
 import Data.IORef (readIORef)
 import Data.Maybe (fromMaybe)
 import Data.String (fromString)
@@ -22,6 +22,7 @@ import Simplex.Messaging.Encoding.String (strEncode)
 import Simplex.Messaging.Server (AttachHTTP)
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..))
+import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util (tshow)
 import Static.Embedded as E
@@ -117,6 +118,7 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
       where
         basic =
           [ ("sourceCode", Just . encodeUtf8 $ sourceCode spi),
+            ("version", Just $ B.pack simplexMQVersion),
             ("website", encodeUtf8 <$> website spi)
           ]
         conds ServerConditions {conditions, amendments} =

From 0739f7b702877a8beffd0d92129813fa72c40984 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 29 Sep 2024 18:50:16 +0100
Subject: [PATCH 130/195] smp server: persist notifications to avoid losing
 them when ntf server is offline (#1336)

* ntf server: types for storing notifications

* fix tests

* remove comments

* batch NMSGs test

* fix test

* thread to expire notifications

* persist notifications on restart

* optimize

* refactor

* remove reverse

* control port stats
---
 simplexmq.cabal                               |   1 +
 src/Simplex/Messaging/Notifications/Server.hs |   5 +-
 src/Simplex/Messaging/Server.hs               | 171 +++++++---
 src/Simplex/Messaging/Server/Env/STM.hs       |  20 +-
 src/Simplex/Messaging/Server/Main.hs          |  24 +-
 src/Simplex/Messaging/Server/NtfStore.hs      |  77 +++++
 src/Simplex/Messaging/Server/Stats.hs         |  20 ++
 src/Simplex/Messaging/TMap.hs                 |   5 +
 tests/AgentTests/NotificationTests.hs         | 305 +++++++++---------
 tests/CoreTests/BatchingTests.hs              | 240 ++++++++------
 tests/NtfClient.hs                            |  54 ++--
 tests/NtfServerTests.hs                       |  18 +-
 tests/SMPClient.hs                            |  19 +-
 tests/SMPProxyTests.hs                        |   8 +-
 tests/ServerTests.hs                          |   6 +-
 15 files changed, 624 insertions(+), 349 deletions(-)
 create mode 100644 src/Simplex/Messaging/Server/NtfStore.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 5590dd6a4..51da92aef 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -173,6 +173,7 @@ library
       Simplex.Messaging.Server.Main
       Simplex.Messaging.Server.MsgStore
       Simplex.Messaging.Server.MsgStore.STM
+      Simplex.Messaging.Server.NtfStore
       Simplex.Messaging.Server.QueueStore
       Simplex.Messaging.Server.QueueStore.QueueInfo
       Simplex.Messaging.Server.QueueStore.STM
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index ab7c69f04..acc7d57c6 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -219,9 +219,8 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
               NtfPushServer {pushQ} <- asks pushServer
               stats <- asks serverStats
               liftIO $ updatePeriodStats (activeSubs stats) ntfId
-              atomically $
-                findNtfSubscriptionToken st smpQueue
-                  >>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage (PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| [])))
+              atomically (findNtfSubscriptionToken st smpQueue)
+                >>= mapM_ (\tkn -> atomically (writeTBQueue pushQ (tkn, PNMessage (PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| []))))
               incNtfStat ntfReceived
             Right SMP.END ->
               whenM (atomically $ activeClientSession' ca sessionId srv) $
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index bf96b6deb..54fef3ab3 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -58,7 +58,7 @@ import Data.IORef
 import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
-import Data.List (intercalate, mapAccumR)
+import Data.List (foldl', intercalate, mapAccumR)
 import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
@@ -88,6 +88,7 @@ import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
 import Simplex.Messaging.Server.MsgStore.STM
+import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.Server.QueueStore.STM as QS
@@ -137,13 +138,16 @@ smpServer :: TMVar Bool -> ServerConfig -> Maybe AttachHTTP -> M ()
 smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHTTP_ = do
   s <- asks server
   pa <- asks proxyAgent
-  expired <- restoreServerMessages
-  restoreServerStats expired
+  expiredMsgs <- restoreServerMessages
+  expiredNtfs <- restoreServerNtfs
+  restoreServerStats expiredMsgs expiredNtfs
   raceAny_
     ( serverThread s "server subscribedQ" subscribedQ subscribers subClients pendingSubEvents subscriptions cancelSub
         : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubClients pendingNtfSubEvents ntfSubscriptions (\_ -> pure ())
+        : deliverNtfsThread s
         : sendPendingEvtsThread s
         : receiveFromProxyAgent pa
+        : expireNtfsThread cfg
         : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
     )
     `finally` withLock' (savingLock s) "final" (saveServer False >> closeServer)
@@ -171,7 +175,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
     fromTLSCredentials (_, pk) = C.x509ToPrivate (pk, []) >>= C.privKey
 
     saveServer :: Bool -> M ()
-    saveServer keepMsgs = withLog closeStoreLog >> saveServerMessages keepMsgs >> saveServerStats
+    saveServer keepMsgs = withLog closeStoreLog >> saveServerMessages keepMsgs >> saveServerNtfs >> saveServerStats
 
     closeServer :: M ()
     closeServer = asks (smpAgent . proxyAgent) >>= liftIO . closeSMPClientAgent
@@ -230,6 +234,31 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
         -- remove client from server's subscribed cients
         removeWhenNoSubs c = whenM (null <$> readTVar (clientSubs c)) $ modifyTVar' (subClnts s) $ IM.delete (clientId c)
 
+    deliverNtfsThread :: Server -> M ()
+    deliverNtfsThread Server {ntfSubClients} = do
+      ntfInt <- asks $ ntfDeliveryInterval . config
+      ns <- asks ntfStore
+      stats <- asks serverStats
+      liftIO $ forever $ do
+        threadDelay ntfInt
+        readTVarIO ntfSubClients >>= mapM_ (deliverNtfs ns stats)
+      where
+        deliverNtfs ns stats Client {clientId, ntfSubscriptions, sndQ, connected} = whenM currentClient $
+          readTVarIO ntfSubscriptions >>= \subs -> do
+            ts_ <- foldM addNtfs [] (M.keys subs)
+            mapM_ (atomically . writeTBQueue sndQ) $ L.nonEmpty ts_
+            updateNtfStats $ length ts_
+          where
+            currentClient = (&&) <$> readTVarIO connected <*> (IM.member clientId <$> readTVarIO ntfSubClients)
+            addNtfs :: [Transmission BrokerMsg] -> NotifierId -> IO [Transmission BrokerMsg]
+            addNtfs acc nId =
+              (foldl' (\acc' ntf -> nmsg nId ntf : acc') acc) -- reverses, to order by time
+                <$> flushNtfs ns nId
+            nmsg nId MsgNtf {ntfNonce, ntfEncMeta} = (CorrId "", nId, NMSG ntfNonce ntfEncMeta)
+            updateNtfStats len = when (len > 0) $ liftIO $ do
+              atomicModifyIORef'_ (msgNtfs stats) (+ len)
+              atomicModifyIORef'_ (msgNtfsB stats) (+ (len `div` 80 + 1)) -- up to 80 NMSG in the batch
+
     sendPendingEvtsThread :: Server -> M ()
     sendPendingEvtsThread s = do
       endInt <- asks $ pendingENDInterval . config
@@ -259,8 +288,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
             updateEndStats = do
               stats <- asks serverStats
               let len = L.length qEvts
-              liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
-              liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs or DELDs in the batch
+              when (len > 0) $ liftIO $ do
+                atomicModifyIORef'_ (qSubEnd stats) (+ len)
+                atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs or DELDs in the batch
 
     receiveFromProxyAgent :: ProxyAgent -> M ()
     receiveFromProxyAgent ProxyAgent {smpAgent = SMPClientAgent {agentQ}} =
@@ -294,6 +324,18 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
           deleted <- liftIO $ deleteExpiredMsgs q old
           liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
 
+    expireNtfsThread :: ServerConfig -> M ()
+    expireNtfsThread ServerConfig {notificationExpiration = expCfg} = do
+      ns <- asks ntfStore
+      let interval = checkInterval expCfg * 1000000
+      stats <- asks serverStats
+      labelMyThread "expireNtfsThread"
+      liftIO $ forever $ do
+        threadDelay' interval
+        old <- expireBeforeEpoch expCfg
+        expired <- deleteExpiredNtfs ns old
+        when (expired > 0) $ atomicModifyIORef'_ (msgNtfExpired stats) (+ expired)
+
     serverStatsThread_ :: ServerConfig -> [M ()]
     serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime, serverStatsLogFile} =
       [logServerStats logStatsStartTime interval serverStatsLogFile]
@@ -351,8 +393,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
           msgRecvNtf' <- atomicSwapIORef msgRecvNtf 0
           psNtf <- liftIO $ periodStatCounts activeQueuesNtf ts
           msgNtfs' <- atomicSwapIORef (msgNtfs ss) 0
+          msgNtfsB' <- atomicSwapIORef (msgNtfsB ss) 0
           msgNtfNoSub' <- atomicSwapIORef (msgNtfNoSub ss) 0
           msgNtfLost' <- atomicSwapIORef (msgNtfLost ss) 0
+          msgNtfExpired' <- atomicSwapIORef (msgNtfExpired ss) 0
           pRelays' <- getResetProxyStatsData pRelays
           pRelaysOwn' <- getResetProxyStatsData pRelaysOwn
           pMsgFwds' <- getResetProxyStatsData pMsgFwds
@@ -424,7 +468,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                        show qSubEnd',
                        show qSubEndB',
                        show ntfDeletedB',
-                       show ntfSubB'
+                       show ntfSubB',
+                       show msgNtfsB',
+                       show msgNtfExpired'
                      ]
               )
         liftIO $ threadDelay' interval
@@ -534,6 +580,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                 hPutStrLn h $ "other GET events (auth, duplicate, prohibited): " <> show gets
                 putStat "msgSentNtf" msgSentNtf
                 putStat "msgRecvNtf" msgRecvNtf
+                putStat "msgNtfs" msgNtfs
+                putStat "msgNtfsB" msgNtfsB
+                putStat "msgNtfExpired" msgNtfExpired
                 putStat "qCount" qCount
                 putStat "msgCount" msgCount
                 putProxyStat "pRelays" pRelays
@@ -932,7 +981,7 @@ forkClient Client {endThreads, endThreadSeq} label action = do
   mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId
 
 client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
-client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers, notifiers} = do
+client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
   forever $
     atomically (readTBQueue rcvQ)
@@ -1135,6 +1184,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           liftIO (deleteQueueNotifier st entId) >>= \case
             Right (Just nId) -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
+              asks ntfStore >>= liftIO . (`deleteNtfs` nId)
               atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
               incStat . ntfDeleted =<< asks serverStats
               pure ok
@@ -1276,7 +1326,14 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               Message {msgFlags} -> do
                 stats <- asks serverStats
                 incStat $ msgRecv stats
-                when isGet $ incStat $ msgRecvGet stats
+                if isGet
+                  then incStat $ msgRecvGet stats
+                  else pure () -- TODO skip notification delivery for delivered message  
+                  -- skipping delivery fails tests, it should be counted in msgNtfSkipped
+                  -- forM_ (notifierId <$> notifier qr) $ \nId -> do
+                  --   ns <- asks ntfStore
+                  --   atomically $ TM.lookup nId ns >>=
+                  --     mapM_ (\MsgNtf {ntfMsgId} -> when (msgId == msgId') $ TM.delete nId ns)
                 liftIO $ atomicModifyIORef'_ (msgCount stats) (subtract 1)
                 liftIO $ updatePeriodStats (activeQueues stats) entId
                 when (notification msgFlags) $ do
@@ -1310,7 +1367,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                         Just (msg, wasEmpty) -> time "SEND ok" $ do
                           when wasEmpty $ liftIO $ tryDeliverMessage msg
                           when (notification msgFlags) $ do
-                            mapM_ (`trySendNotification` msg) (notifier qr)
+                            mapM_ (`enqueueNotification` msg) (notifier qr)
                             incStat $ msgSentNtf stats
                             liftIO $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
                           incStat $ msgSent stats
@@ -1395,39 +1452,20 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                             deliver q s
                             writeTVar st NoSub
 
-            trySendNotification :: NtfCreds -> Message -> M ()
-            trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg = do
-              stats <- asks serverStats
-              liftIO (TM.lookupIO notifierId notifiers) >>= \case
-                Nothing -> do
-                  incStat $ msgNtfNoSub stats
-                  logWarn "No notification subscription"
-                Just ntfClnt -> do
-                  let updateStats True = incStat $ msgNtfs stats
-                      updateStats _ = do
-                        incStat $ msgNtfLost stats
-                        logWarn "Dropped message notification"
-                  writeNtf notifierId msg rcvNtfDhSecret ntfClnt >>= mapM_ updateStats
+            enqueueNotification :: NtfCreds -> Message -> M ()
+            enqueueNotification _ MessageQuota {} = pure ()
+            enqueueNotification NtfCreds {notifierId = nId, rcvNtfDhSecret} Message {msgId, msgTs} = do
+              -- stats <- asks serverStats
+              ns <- asks ntfStore
+              ntf <- mkMessageNotification msgId msgTs rcvNtfDhSecret
+              liftIO $ storeNtf ns nId ntf
 
-            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> TVar Client -> M (Maybe Bool)
-            writeNtf nId msg rcvNtfDhSecret ntfClnt = case msg of
-              Message {msgId, msgTs} -> Just <$> do
-                (nmsgNonce, encNMsgMeta) <- mkMessageNotification msgId msgTs rcvNtfDhSecret
-                -- must be in one STM transaction to avoid the queue becoming full between the check and writing
-                atomically $ do
-                  Client {sndQ = q} <- readTVar ntfClnt
-                  ifM
-                    (isFullTBQueue q)
-                    (pure $ False)
-                    (True <$ writeTBQueue q [(CorrId "", nId, NMSG nmsgNonce encNMsgMeta)])
-              _ -> pure Nothing
-
-            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> M (C.CbNonce, EncNMsgMeta)
+            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> M MsgNtf
             mkMessageNotification msgId msgTs rcvNtfDhSecret = do
-              cbNonce <- atomically . C.randomCbNonce =<< asks random
+              ntfNonce <- atomically . C.randomCbNonce =<< asks random
               let msgMeta = NMsgMeta {msgId, msgTs}
-                  encNMsgMeta = C.cbEncrypt rcvNtfDhSecret cbNonce (smpEncode msgMeta) 128
-              pure . (cbNonce,) $ fromRight "" encNMsgMeta
+                  encNMsgMeta = C.cbEncrypt rcvNtfDhSecret ntfNonce (smpEncode msgMeta) 128
+              pure $ MsgNtf {ntfMsgId = msgId, ntfTs = msgTs, ntfNonce, ntfEncMeta = fromRight "" encNMsgMeta}
 
         processForwardedCommand :: EncFwdTransmission -> M BrokerMsg
         processForwardedCommand (EncFwdTransmission s) = fmap (either ERR id) . runExceptT $ do
@@ -1528,9 +1566,10 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                 -- queue is usually deleted by the same client that is currently subscribed,
                 -- we delete subscription here, so the client with no subscriptions can be disconnected.
                 TM.delete entId subscriptions
-              forM_ (notifierId <$> notifier q) $ \nId ->
+              forM_ (notifierId <$> notifier q) $ \nId -> do
                 -- queue is deleted by a different client from the one subscribed to notifications,
                 -- so we don't need to remove subscription from the current client.
+                asks ntfStore >>= liftIO . (`deleteNtfs` nId)
                 atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
               updateDeletedStats q
               pure ok
@@ -1657,6 +1696,50 @@ restoreServerMessages =
             msgErr :: Show e => String -> e -> String
             msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
 
+saveServerNtfs :: M ()
+saveServerNtfs = asks (storeNtfsFile . config) >>= mapM_ saveNtfs
+  where
+    saveNtfs f = do
+      logInfo $ "saving notifications to file " <> T.pack f
+      NtfStore ns <- asks ntfStore
+      liftIO . withFile f WriteMode $ \h ->
+        readTVarIO ns >>= mapM_ (saveQueueNtfs h) . M.assocs
+      logInfo "notifications saved"
+      where
+        -- reverse on save, to save notifications in order, will become reversed again when restoring.
+        saveQueueNtfs h (nId, v) = BLD.hPutBuilder h . encodeNtfs nId . reverse =<< readTVarIO v
+        encodeNtfs nId = mconcat . map (\ntf -> BLD.byteString (strEncode $ NLRv1 nId ntf) <> BLD.char8 '\n')
+
+restoreServerNtfs :: M Int
+restoreServerNtfs =
+  asks (storeNtfsFile . config) >>= \case
+    Just f -> ifM (doesFileExist f) (restoreNtfs f) (pure 0)
+    Nothing -> pure 0
+  where
+    restoreNtfs f = do
+      logInfo $ "restoring notifications from file " <> T.pack f
+      ns <- asks ntfStore
+      old <- asks (notificationExpiration . config) >>= liftIO . expireBeforeEpoch
+      runExceptT (liftIO (LB.readFile f) >>= foldM (restoreNtf ns old) 0 . LB.lines) >>= \case
+        Left e -> do
+          logError . T.pack $ "error restoring notifications: " <> e
+          liftIO exitFailure
+        Right expired -> do
+          renameFile f $ f <> ".bak"
+          logInfo "notifications restored"
+          pure expired
+      where
+        restoreNtf ns old !expired s' = do
+          NLRv1 nId ntf <- liftEither . first (ntfErr "parsing") $ strDecode s
+          liftIO $ addToNtfs nId ntf
+          where
+            s = LB.toStrict s'
+            addToNtfs nId ntf@MsgNtf {ntfTs}
+              | systemSeconds ntfTs < old = pure (expired + 1)
+              | otherwise = storeNtf ns nId ntf $> expired
+            ntfErr :: Show e => String -> e -> String
+            ntfErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
+
 saveServerStats :: M ()
 saveServerStats =
   asks (serverStatsBackupFile . config)
@@ -1667,8 +1750,8 @@ saveServerStats =
       B.writeFile f $ strEncode stats
       logInfo "server stats saved"
 
-restoreServerStats :: Int -> M ()
-restoreServerStats expiredWhileRestoring = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
+restoreServerStats :: Int -> Int -> M ()
+restoreServerStats expiredMsgs expiredNtfs = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
   where
     restoreStats f = whenM (doesFileExist f) $ do
       logInfo $ "restoring server stats from file " <> T.pack f
@@ -1677,7 +1760,7 @@ restoreServerStats expiredWhileRestoring = asks (serverStatsBackupFile . config)
           s <- asks serverStats
           _qCount <- fmap M.size . readTVarIO . queues =<< asks queueStore
           _msgCount <- liftIO . foldM (\(!n) q -> (n +) <$> getQueueSize q) 0 =<< readTVarIO =<< asks msgStore
-          liftIO $ setServerStats s d {_qCount, _msgCount, _msgExpired = _msgExpired d + expiredWhileRestoring}
+          liftIO $ setServerStats s d {_qCount, _msgCount, _msgExpired = _msgExpired d + expiredMsgs, _msgNtfExpired = _msgNtfExpired d + expiredNtfs}
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
           when (_qCount /= statsQCount) $ logWarn $ "Queue count differs: stats: " <> tshow statsQCount <> ", store: " <> tshow _qCount
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 05ed7da53..a485ab73e 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -38,6 +38,7 @@ import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.MsgStore.STM
+import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.QueueStore (NtfCreds (..), QueueRec (..))
 import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.Stats
@@ -61,6 +62,7 @@ data ServerConfig = ServerConfig
     msgIdBytes :: Int,
     storeLogFile :: Maybe FilePath,
     storeMsgsFile :: Maybe FilePath,
+    storeNtfsFile :: Maybe FilePath,
     -- | set to False to prohibit creating new queues
     allowNewQueues :: Bool,
     -- | simple password that the clients need to pass in handshake to be able to create new queues
@@ -70,6 +72,8 @@ data ServerConfig = ServerConfig
     controlPortAdminAuth :: Maybe BasicAuth,
     -- | time after which the messages can be removed from the queues and check interval, seconds
     messageExpiration :: Maybe ExpirationConfig,
+    -- | notification expiration interval (seconds)
+    notificationExpiration :: ExpirationConfig,
     -- | time after which the socket with inactive client can be disconnected (without any messages or commands, incl. PING),
     -- and check interval, seconds
     inactiveClientExpiration :: Maybe ExpirationConfig,
@@ -82,6 +86,8 @@ data ServerConfig = ServerConfig
     serverStatsLogFile :: FilePath,
     -- | file to save and restore stats
     serverStatsBackupFile :: Maybe FilePath,
+    -- | notification delivery interval
+    ntfDeliveryInterval :: Int,
     -- | interval between sending pending END events to unsubscribed clients, seconds
     pendingENDInterval :: Int,
     smpCredentials :: ServerCredentials,
@@ -110,6 +116,16 @@ defaultMessageExpiration =
       checkInterval = 43200 -- seconds, 12 hours
     }
 
+defNtfExpirationHours :: Int64
+defNtfExpirationHours = 24
+
+defaultNtfExpiration :: ExpirationConfig
+defaultNtfExpiration =
+  ExpirationConfig
+    { ttl = defNtfExpirationHours * 3600, -- seconds
+      checkInterval = 3600 -- seconds, 1 hour
+    }
+
 defaultInactiveClientExpiration :: ExpirationConfig
 defaultInactiveClientExpiration =
   ExpirationConfig
@@ -127,6 +143,7 @@ data Env = Env
     serverIdentity :: KeyHash,
     queueStore :: QueueStore,
     msgStore :: STMMsgStore,
+    ntfStore :: NtfStore,
     random :: TVar ChaChaDRG,
     storeLog :: Maybe (StoreLog 'WriteMode),
     tlsServerCreds :: T.Credential,
@@ -229,6 +246,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAg
   server <- newServer
   queueStore <- newQueueStore
   msgStore <- newMsgStore
+  ntfStore <- NtfStore <$> TM.emptyIO
   random <- C.newRandom
   storeLog <-
     forM storeLogFile $ \f -> do
@@ -244,7 +262,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAg
   clientSeq <- newTVarIO 0
   clients <- newTVarIO mempty
   proxyAgent <- newSMPProxyAgent smpAgentCfg random
-  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerCreds, httpServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
+  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, ntfStore, random, storeLog, tlsServerCreds, httpServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
   where
     getCredentials protocol creds = do
       files <- missingCreds
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index bcd96c170..ca4a5ed60 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -38,7 +38,7 @@ import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
 import Simplex.Messaging.Server (AttachHTTP, runSMPServer)
 import Simplex.Messaging.Server.CLI
-import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defMsgExpirationDays, defaultInactiveClientExpiration, defaultMessageExpiration, defaultProxyClientConcurrency)
+import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedServerSMPRelayVRange)
@@ -154,7 +154,8 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 <> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
                    \# they are preserved in the .bak file until the next restart.\n"
                 <> ("restore_messages: " <> onOff enableStoreLog <> "\n")
-                <> ("expire_messages_days: " <> tshow defMsgExpirationDays <> "\n\n")
+                <> ("expire_messages_days: " <> tshow defMsgExpirationDays <> "\n")
+                <> ("expire_ntfs_hours: " <> tshow defNtfExpirationHours <> "\n\n")
                 <> "# Log daily server statistics to CSV file\n"
                 <> ("log_stats: " <> onOff logStats <> "\n\n")
                 <> "[AUTH]\n\
@@ -268,6 +269,11 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
         enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
         logStats = settingIsOn "STORE_LOG" "log_stats" ini
         c = combine cfgPath . ($ defaultX509Config)
+        restoreMessagesFile path = case iniOnOff "STORE_LOG" "restore_messages" ini of
+          Just True -> Just path
+          Just False -> Nothing
+          -- if the setting is not set, it is enabled when store log is enabled
+          _ -> enableStoreLog $> path
         transports = iniTransports ini
         sharedHTTP = any (\(_, _, addHTTP) -> addHTTP) transports
         serverConfig =
@@ -286,13 +292,8 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                   },
               httpCredentials = (\WebHttpsParams {key, cert} -> ServerCredentials {caCertificateFile = Nothing, privateKeyFile = key, certificateFile = cert}) <$> webHttpsParams',
               storeLogFile = enableStoreLog $> storeLogFilePath,
-              storeMsgsFile =
-                let messagesPath = combine logPath "smp-server-messages.log"
-                 in case iniOnOff "STORE_LOG" "restore_messages" ini of
-                      Just True -> Just messagesPath
-                      Just False -> Nothing
-                      -- if the setting is not set, it is enabled when store log is enabled
-                      _ -> enableStoreLog $> messagesPath,
+              storeMsgsFile = restoreMessagesFile $ combine logPath "smp-server-messages.log",
+              storeNtfsFile = restoreMessagesFile $ combine logPath "smp-server-ntfs.log",
               -- allow creating new queues by default
               allowNewQueues = fromMaybe True $ iniOnOff "AUTH" "new_queues" ini,
               newQueueBasicAuth = either error id <$!> strDecodeIni "AUTH" "create_password" ini,
@@ -303,6 +304,10 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                   defaultMessageExpiration
                     { ttl = 86400 * readIniDefault defMsgExpirationDays "STORE_LOG" "expire_messages_days" ini
                     },
+              notificationExpiration =
+                defaultNtfExpiration
+                  { ttl = 3600 * readIniDefault defNtfExpirationHours "STORE_LOG" "expire_ntfs_hours" ini
+                  },
               inactiveClientExpiration =
                 settingIsOn "INACTIVE_CLIENTS" "disconnect" ini
                   $> ExpirationConfig
@@ -314,6 +319,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               serverStatsLogFile = combine logPath "smp-server-stats.daily.log",
               serverStatsBackupFile = logStats $> combine logPath "smp-server-stats.log",
               pendingENDInterval = 15000000, -- 15 seconds
+              ntfDeliveryInterval = 3000000, -- 3 seconds
               smpServerVRange = supportedServerSMPRelayVRange,
               transportConfig =
                 defaultTransportServerConfig
diff --git a/src/Simplex/Messaging/Server/NtfStore.hs b/src/Simplex/Messaging/Server/NtfStore.hs
new file mode 100644
index 000000000..ded2bd85d
--- /dev/null
+++ b/src/Simplex/Messaging/Server/NtfStore.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Messaging.Server.NtfStore where
+
+import Control.Concurrent.STM
+import Control.Monad (foldM)
+import Data.Int (Int64)
+import qualified Data.Map.Strict as M
+import Data.Time.Clock.System (SystemTime (..))
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (EncNMsgMeta, MsgId, NotifierId)
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
+
+newtype NtfStore = NtfStore (TMap NotifierId (TVar [MsgNtf]))
+
+data MsgNtf = MsgNtf
+  { ntfMsgId :: MsgId,
+    ntfTs :: SystemTime,
+    ntfNonce :: C.CbNonce,
+    ntfEncMeta :: EncNMsgMeta
+  }
+
+storeNtf :: NtfStore -> NotifierId -> MsgNtf -> IO ()
+storeNtf (NtfStore ns) nId ntf = do
+  TM.lookupIO nId ns >>= atomically . maybe newNtfs (`modifyTVar'` (ntf :))
+  -- TODO coalesce messages here once the client is updated to process multiple messages
+  -- for single notification.
+  -- when (isJust prevNtf) $ incStat $ msgNtfReplaced stats
+  where
+    newNtfs = TM.lookup nId ns >>= maybe (TM.insertM nId (newTVar [ntf]) ns) (`modifyTVar'` (ntf :))
+
+deleteNtfs :: NtfStore -> NotifierId -> IO ()
+deleteNtfs (NtfStore ns) nId = atomically $ TM.delete nId ns
+
+flushNtfs :: NtfStore -> NotifierId -> IO [MsgNtf]
+flushNtfs (NtfStore ns) nId = do
+  TM.lookupIO nId ns >>= maybe (pure []) swapNtfs
+  where
+    swapNtfs v =
+      readTVarIO v >>= \case
+        [] -> pure []
+        -- if notifications available, atomically swap with empty array
+        _ -> atomically (swapTVar v [])
+
+deleteExpiredNtfs :: NtfStore -> Int64 -> IO Int
+deleteExpiredNtfs (NtfStore ns) old =
+  foldM (\expired -> fmap (expired +) . expireQueue) 0 . M.keys =<< readTVarIO ns
+  where
+    expireQueue nId = TM.lookupIO nId ns >>= maybe (pure 0) expire
+    expire v = readTVarIO v >>= \case
+      [] -> pure 0
+      _ ->
+        atomically $ readTVar v >>= \case
+          [] -> pure 0
+          -- check the last message first, it is the earliest
+          ntfs | systemSeconds (ntfTs $ last $ ntfs) < old -> do
+            let !ntfs' = filter (\MsgNtf {ntfTs = ts} -> systemSeconds ts >= old) ntfs
+            writeTVar v ntfs'
+            pure $! length ntfs - length ntfs'
+          _ -> pure 0
+
+data NtfLogRecord = NLRv1 NotifierId MsgNtf
+
+instance StrEncoding MsgNtf where
+  strEncode MsgNtf {ntfMsgId, ntfTs, ntfNonce, ntfEncMeta} = strEncode (ntfMsgId, ntfTs, ntfNonce, ntfEncMeta)
+  strP = do
+    (ntfMsgId, ntfTs, ntfNonce, ntfEncMeta) <- strP
+    pure MsgNtf {ntfMsgId, ntfTs, ntfNonce, ntfEncMeta}
+
+instance StrEncoding NtfLogRecord where
+  strEncode (NLRv1 nId ntf) = strEncode (Str "v1", nId, ntf)
+  strP = "v1 " *> (NLRv1 <$> strP_ <*> strP)
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index 097ddb607..49078d2d9 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -67,8 +67,10 @@ data ServerStats = ServerStats
     msgRecvNtf :: IORef Int, -- received messages with NTF flag
     activeQueuesNtf :: PeriodStats,
     msgNtfs :: IORef Int, -- messages notications delivered to NTF server (<= msgSentNtf)
+    msgNtfsB :: IORef Int, -- messages notication batches delivered to NTF server
     msgNtfNoSub :: IORef Int, -- no subscriber to notifications (e.g., NTF server not connected)
     msgNtfLost :: IORef Int, -- notification is lost because NTF delivery queue is full
+    msgNtfExpired :: IORef Int, -- expired
     pRelays :: ProxyStats,
     pRelaysOwn :: ProxyStats,
     pMsgFwds :: ProxyStats,
@@ -117,8 +119,10 @@ data ServerStatsData = ServerStatsData
     _msgRecvNtf :: Int,
     _activeQueuesNtf :: PeriodStatsData,
     _msgNtfs :: Int,
+    _msgNtfsB :: Int,
     _msgNtfNoSub :: Int,
     _msgNtfLost :: Int,
+    _msgNtfExpired :: Int,
     _pRelays :: ProxyStatsData,
     _pRelaysOwn :: ProxyStatsData,
     _pMsgFwds :: ProxyStatsData,
@@ -169,8 +173,10 @@ newServerStats ts = do
   msgRecvNtf <- newIORef 0
   activeQueuesNtf <- newPeriodStats
   msgNtfs <- newIORef 0
+  msgNtfsB <- newIORef 0
   msgNtfNoSub <- newIORef 0
   msgNtfLost <- newIORef 0
+  msgNtfExpired <- newIORef 0
   pRelays <- newProxyStats
   pRelaysOwn <- newProxyStats
   pMsgFwds <- newProxyStats
@@ -218,8 +224,10 @@ newServerStats ts = do
         msgRecvNtf,
         activeQueuesNtf,
         msgNtfs,
+        msgNtfsB,
         msgNtfNoSub,
         msgNtfLost,
+        msgNtfExpired,
         pRelays,
         pRelaysOwn,
         pMsgFwds,
@@ -269,8 +277,10 @@ getServerStatsData s = do
   _msgRecvNtf <- readIORef $ msgRecvNtf s
   _activeQueuesNtf <- getPeriodStatsData $ activeQueuesNtf s
   _msgNtfs <- readIORef $ msgNtfs s
+  _msgNtfsB <- readIORef $ msgNtfsB s
   _msgNtfNoSub <- readIORef $ msgNtfNoSub s
   _msgNtfLost <- readIORef $ msgNtfLost s
+  _msgNtfExpired <- readIORef $ msgNtfExpired s
   _pRelays <- getProxyStatsData $ pRelays s
   _pRelaysOwn <- getProxyStatsData $ pRelaysOwn s
   _pMsgFwds <- getProxyStatsData $ pMsgFwds s
@@ -318,8 +328,10 @@ getServerStatsData s = do
         _msgRecvNtf,
         _activeQueuesNtf,
         _msgNtfs,
+        _msgNtfsB,
         _msgNtfNoSub,
         _msgNtfLost,
+        _msgNtfExpired,
         _pRelays,
         _pRelaysOwn,
         _pMsgFwds,
@@ -370,8 +382,10 @@ setServerStats s d = do
   writeIORef (msgRecvNtf s) $! _msgRecvNtf d
   setPeriodStats (activeQueuesNtf s) (_activeQueuesNtf d)
   writeIORef (msgNtfs s) $! _msgNtfs d
+  writeIORef (msgNtfsB s) $! _msgNtfsB d
   writeIORef (msgNtfNoSub s) $! _msgNtfNoSub d
   writeIORef (msgNtfLost s) $! _msgNtfLost d
+  writeIORef (msgNtfExpired s) $! _msgNtfExpired d
   setProxyStats (pRelays s) $! _pRelays d
   setProxyStats (pRelaysOwn s) $! _pRelaysOwn d
   setProxyStats (pMsgFwds s) $! _pMsgFwds d
@@ -420,8 +434,10 @@ instance StrEncoding ServerStatsData where
         "msgSentNtf=" <> strEncode (_msgSentNtf d),
         "msgRecvNtf=" <> strEncode (_msgRecvNtf d),
         "msgNtfs=" <> strEncode (_msgNtfs d),
+        "msgNtfsB=" <> strEncode (_msgNtfsB d),
         "msgNtfNoSub=" <> strEncode (_msgNtfNoSub d),
         "msgNtfLost=" <> strEncode (_msgNtfLost d),
+        "msgNtfExpired=" <> strEncode (_msgNtfExpired d),
         "activeQueues:",
         strEncode (_activeQueues d),
         "activeQueuesNtf:",
@@ -475,8 +491,10 @@ instance StrEncoding ServerStatsData where
     _msgSentNtf <- opt "msgSentNtf="
     _msgRecvNtf <- opt "msgRecvNtf="
     _msgNtfs <- opt "msgNtfs="
+    _msgNtfsB <- opt "msgNtfsB="
     _msgNtfNoSub <- opt "msgNtfNoSub="
     _msgNtfLost <- opt "msgNtfLost="
+    _msgNtfExpired <- opt "msgNtfExpired="
     _activeQueues <-
       optional ("activeQueues:" <* A.endOfLine) >>= \case
         Just _ -> strP <* optional A.endOfLine
@@ -536,8 +554,10 @@ instance StrEncoding ServerStatsData where
           _msgSentNtf,
           _msgRecvNtf,
           _msgNtfs,
+          _msgNtfsB,
           _msgNtfNoSub,
           _msgNtfLost,
+          _msgNtfExpired,
           _activeQueues,
           _activeQueuesNtf,
           _pRelays,
diff --git a/src/Simplex/Messaging/TMap.hs b/src/Simplex/Messaging/TMap.hs
index 1bc9bcb60..02d20b695 100644
--- a/src/Simplex/Messaging/TMap.hs
+++ b/src/Simplex/Messaging/TMap.hs
@@ -9,6 +9,7 @@ module Simplex.Messaging.TMap
     member,
     memberIO,
     insert,
+    insertM,
     delete,
     lookupInsert,
     lookupDelete,
@@ -62,6 +63,10 @@ insert :: Ord k => k -> a -> TMap k a -> STM ()
 insert k v m = modifyTVar' m $ M.insert k v
 {-# INLINE insert #-}
 
+insertM :: Ord k => k -> STM a -> TMap k a -> STM ()
+insertM k f m = modifyTVar' m . M.insert k =<< f
+{-# INLINE insertM #-}
+
 delete :: Ord k => k -> TMap k a -> STM ()
 delete k m = modifyTVar' m $ M.delete k
 {-# INLINE delete #-}
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 40071873c..272c6d6d6 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -54,7 +54,7 @@ import Data.Text.Encoding (encodeUtf8)
 import Database.SQLite.Simple.QQ (sql)
 import NtfClient
 import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testNtfServer, testNtfServer2)
-import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn)
+import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore')
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, Env (..), InitialAgentServers)
@@ -134,9 +134,8 @@ notificationTests t = do
           withNtfServer t $ testChangeToken apns
   describe "Notifications server store log" $
     it "should save and restore tokens and subscriptions" $
-      withSmpServer t $
-        withAPNSMockServer $ \apns ->
-          testNotificationsStoreLog t apns
+      withAPNSMockServer $ \apns ->
+        testNotificationsStoreLog t apns
   describe "Notifications after SMP server restart" $
     it "should resume subscriptions after SMP server is restarted" $
       withAPNSMockServer $ \apns ->
@@ -183,15 +182,14 @@ runNtfTestCfg t baseId smpCfg ntfCfg aCfg bCfg runTest = do
   threadDelay 100000
 
 testNotificationToken :: APNSMockServer -> IO ()
-testNotificationToken APNSMockServer {apnsQ} = do
+testNotificationToken apns = do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+      getMockNotification apns tkn
     verification <- ntfData .-> "verification"
     nonce <- C.cbNonce <$> ntfData .-> "nonce"
-    liftIO $ sendApnsResponse APNSRespOk
     verifyNtfToken a tkn nonce verification
     NTActive <- checkNtfToken a tkn
     deleteNtfToken a tkn
@@ -208,48 +206,44 @@ v .-> key = do
 -- logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 testNtfTokenRepeatRegistration :: APNSMockServer -> IO ()
-testNtfTokenRepeatRegistration APNSMockServer {apnsQ} = do
+testNtfTokenRepeatRegistration apns = do
   -- setLogLevel LogError -- LogDebug
   -- withGlobalLogging logCfg $ do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+      getMockNotification apns tkn
     verification <- ntfData .-> "verification"
     nonce <- C.cbNonce <$> ntfData .-> "nonce"
-    liftIO $ sendApnsResponse APNSRespOk
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
+      getMockNotification apns tkn
     _ <- ntfData' .-> "verification"
     _ <- C.cbNonce <$> ntfData' .-> "nonce"
-    liftIO $ sendApnsResponse' APNSRespOk
     -- can still use the first verification code, it is the same after decryption
     verifyNtfToken a tkn nonce verification
     NTActive <- checkNtfToken a tkn
     pure ()
 
 testNtfTokenSecondRegistration :: APNSMockServer -> IO ()
-testNtfTokenSecondRegistration APNSMockServer {apnsQ} =
+testNtfTokenSecondRegistration apns =
   -- setLogLevel LogError -- LogDebug
   -- withGlobalLogging logCfg $ do
   withAgentClients2 $ \a a' -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+      getMockNotification apns tkn
     verification <- ntfData .-> "verification"
     nonce <- C.cbNonce <$> ntfData .-> "nonce"
-    liftIO $ sendApnsResponse APNSRespOk
     verifyNtfToken a tkn nonce verification
 
     NTRegistered <- registerNtfToken a' tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
+      getMockNotification apns tkn
     verification' <- ntfData' .-> "verification"
     nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
-    liftIO $ sendApnsResponse' APNSRespOk
 
     -- at this point the first token is still active
     NTActive <- checkNtfToken a tkn
@@ -265,14 +259,13 @@ testNtfTokenSecondRegistration APNSMockServer {apnsQ} =
     pure ()
 
 testNtfTokenServerRestart :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestart t APNSMockServer {apnsQ} = do
+testNtfTokenServerRestart t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   ntfData <- withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+        getMockNotification apns tkn
       pure ntfData
   -- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server
   threadDelay 1000000
@@ -287,14 +280,13 @@ testNtfTokenServerRestart t APNSMockServer {apnsQ} = do
       pure ()
 
 testNtfTokenServerRestartReverify :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReverify t APNSMockServer {apnsQ} = do
+testNtfTokenServerRestartReverify t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a -> do
     ntfData <- withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+        getMockNotification apns tkn
       pure ntfData
     runRight_ $ do
       verification <- ntfData .-> "verification"
@@ -311,14 +303,13 @@ testNtfTokenServerRestartReverify t APNSMockServer {apnsQ} = do
       pure ()
 
 testNtfTokenServerRestartReverifyTimeout :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReverifyTimeout t APNSMockServer {apnsQ} = do
+testNtfTokenServerRestartReverifyTimeout t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
     (nonce, verification) <- withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+        getMockNotification apns tkn
       verification <- ntfData .-> "verification"
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a tkn nonce verification
@@ -347,14 +338,14 @@ testNtfTokenServerRestartReverifyTimeout t APNSMockServer {apnsQ} = do
       pure ()
 
 testNtfTokenServerRestartReregister :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReregister t APNSMockServer {apnsQ} = do
+testNtfTokenServerRestartReregister t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <-
+        getMockNotification apns tkn
+      pure ()
   -- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server
   threadDelay 1000000
   withAgent 2 agentCfg initAgentServers testDB $ \a' ->
@@ -362,9 +353,8 @@ testNtfTokenServerRestartReregister t APNSMockServer {apnsQ} = do
     -- so that repeat registration happens when client is restarted.
     withNtfServerStoreLog t $ \_ -> runRight_ $ do
       NTRegistered <- registerNtfToken a' tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+        getMockNotification apns tkn
       verification <- ntfData .-> "verification"
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a' tkn nonce verification
@@ -372,14 +362,14 @@ testNtfTokenServerRestartReregister t APNSMockServer {apnsQ} = do
       pure ()
 
 testNtfTokenServerRestartReregisterTimeout :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReregisterTimeout t APNSMockServer {apnsQ} = do
+testNtfTokenServerRestartReregisterTimeout t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
     withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <-
+        getMockNotification apns tkn
+      pure ()
     -- this emulates the situation when server registered token but the client did not receive the response
     withTransaction store $ \db ->
       DB.execute
@@ -398,9 +388,8 @@ testNtfTokenServerRestartReregisterTimeout t APNSMockServer {apnsQ} = do
     -- so that repeat registration happens when client is restarted.
     withNtfServerStoreLog t $ \_ -> runRight_ $ do
       NTRegistered <- registerNtfToken a' tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+        getMockNotification apns tkn
       verification <- ntfData .-> "verification"
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a' tkn nonce verification
@@ -414,18 +403,17 @@ getTestNtfTokenPort a =
     Nothing -> error "no active NtfToken"
 
 testNtfTokenMultipleServers :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenMultipleServers t APNSMockServer {apnsQ} = do
+testNtfTokenMultipleServers t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers2 testDB $ \a ->
     withNtfServerThreadOn t ntfTestPort $ \ntf ->
       withNtfServerThreadOn t ntfTestPort2 $ \ntf2 -> runRight_ $ do
         -- register a new token, the agent picks a server and stores its choice
         NTRegistered <- registerNtfToken a tkn NMPeriodic
-        APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-          atomically $ readTBQueue apnsQ
+        APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+          getMockNotification apns tkn
         verification <- ntfData .-> "verification"
         nonce <- C.cbNonce <$> ntfData .-> "nonce"
-        liftIO $ sendApnsResponse APNSRespOk
         verifyNtfToken a tkn nonce verification
         NTActive <- checkNtfToken a tkn
         -- shut down the "other" server
@@ -439,10 +427,10 @@ testNtfTokenMultipleServers t APNSMockServer {apnsQ} = do
         pure ()
 
 testNtfTokenChangeServers :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenChangeServers t APNSMockServer {apnsQ} =
+testNtfTokenChangeServers t apns =
   withNtfServerThreadOn t ntfTestPort $ \ntf -> do
     tkn1 <- withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight $ do
-      tkn <- registerTestToken a "abcd" NMInstant apnsQ
+      tkn <- registerTestToken a "abcd" NMInstant apns
       NTActive <- checkNtfToken a tkn
       liftIO $ setNtfServers a [testNtfServer2]
       NTActive <- checkNtfToken a tkn -- still works on old server
@@ -457,15 +445,15 @@ testNtfTokenChangeServers t APNSMockServer {apnsQ} =
         liftIO $ setNtfServers a [testNtfServer2] -- just change configured server list
         getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort -- not yet changed
         -- trigger token replace
-        tkn2 <- registerTestToken a "xyzw" NMInstant apnsQ
+        tkn2 <- registerTestToken a "xyzw" NMInstant apns
         getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort -- not yet changed
         deleteNtfToken a tkn2 -- force server switch
-        Left BROKER {brokerErr = NETWORK} <- tryError $ registerTestToken a "qwer" NMInstant apnsQ -- ok, it's down for now
+        Left BROKER {brokerErr = NETWORK} <- tryError $ registerTestToken a "qwer" NMInstant apns -- ok, it's down for now
         getTestNtfTokenPort a >>= \port2 -> liftIO $ port2 `shouldBe` ntfTestPort2 -- but the token got updated
       killThread ntf
       withNtfServerOn t ntfTestPort2 $ runRight_ $ do
         liftIO $ threadDelay 1000000 -- for notification server to reconnect
-        tkn <- registerTestToken a "qwer" NMInstant apnsQ
+        tkn <- registerTestToken a "qwer" NMInstant apns
         checkNtfToken a tkn >>= \r -> liftIO $ r `shouldBe` NTActive
 
 testRunNTFServerTests :: ATransport -> NtfServer -> IO (Maybe ProtocolTestFailure)
@@ -475,7 +463,7 @@ testRunNTFServerTests t srv =
       testProtocolServer a 1 $ ProtoServerWithAuth srv Nothing
 
 testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
-testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
+testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
   (bobId, aliceId, nonce, message) <- runRight $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -488,11 +476,10 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
     -- register notification token
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken alice tkn NMInstant
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+      getMockNotification apns tkn
     verification <- ntfData .-> "verification"
     vNonce <- C.cbNonce <$> ntfData .-> "nonce"
-    liftIO $ sendApnsResponse APNSRespOk
     verifyNtfToken alice tkn vNonce verification
     NTActive <- checkNtfToken alice tkn
     -- send message
@@ -500,7 +487,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
     -- notification
-    (nonce, message) <- messageNotification apnsQ
+    (nonce, message) <- messageNotification apns tkn
     pure (bobId, aliceId, nonce, message)
 
   -- alice client already has subscription for the connection
@@ -533,65 +520,64 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
     2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
     get bob ##> ("", aliceId, SENT $ baseId + 2)
     -- no notifications should follow
-    noNotification apnsQ
+    noNotification alice apns
   where
     msgId = subtract baseId
 
 testNotificationSubscriptionNewConnection :: HasCallStack => APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
-testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} baseId alice bob =
+testNotificationSubscriptionNewConnection apns baseId alice bob =
   runRight_ $ do
     -- alice registers notification token
-    DeviceToken {} <- registerTestToken alice "abcd" NMInstant apnsQ
+    DeviceToken {} <- registerTestToken alice "abcd" NMInstant apns
     -- bob registers notification token
-    DeviceToken {} <- registerTestToken bob "bcde" NMInstant apnsQ
+    DeviceToken {} <- registerTestToken bob "bcde" NMInstant apns
     -- establish connection
     liftIO $ threadDelay 50000
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
     liftIO $ threadDelay 1000000
     (aliceId, _sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
     liftIO $ threadDelay 750000
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     liftIO $ threadDelay 500000
     allowConnection alice bobId confId "alice's connInfo"
-    void $ messageNotificationData bob apnsQ
+    void $ messageNotificationData bob apns
     get bob ##> ("", aliceId, INFO "alice's connInfo")
-    when (baseId == 3) $ void $ messageNotificationData alice apnsQ
+    when (baseId == 3) $ void $ messageNotificationData alice apns
     get alice ##> ("", bobId, CON)
-    when (baseId == 3) $ void $ messageNotificationData bob apnsQ
+    when (baseId == 3) $ void $ messageNotificationData bob apns
     get bob ##> ("", aliceId, CON)
     -- bob sends message
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 1) Nothing
     -- alice sends message
     2 <- msgId <$> sendMessage alice bobId (SMP.MsgFlags True) "hey there"
     get alice ##> ("", bobId, SENT $ baseId + 2)
-    void $ messageNotificationData bob apnsQ
+    void $ messageNotificationData bob apns
     get bob =##> \case ("", c, Msg "hey there") -> c == aliceId; _ -> False
     ackMessage bob aliceId (baseId + 2) Nothing
     -- no unexpected notifications should follow
-    noNotification apnsQ
+    noNotifications apns
   where
     msgId = subtract baseId
 
-registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO DeviceToken
-registerTestToken a token mode apnsQ = do
+registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> APNSMockServer -> ExceptT AgentErrorType IO DeviceToken
+registerTestToken a token mode apns = do
   let tkn = DeviceToken PPApnsTest token
   NTRegistered <- registerNtfToken a tkn mode
-  Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
-    timeout 1000000 . atomically $ readTBQueue apnsQ
+  Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
+    timeout 1000000 $ getMockNotification apns tkn
   verification' <- ntfData' .-> "verification"
   nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
-  liftIO $ sendApnsResponse' APNSRespOk
   verifyNtfToken a tkn nonce' verification'
   NTActive <- checkNtfToken a tkn
   pure tkn
 
-testChangeNotificationsMode :: APNSMockServer -> IO ()
-testChangeNotificationsMode APNSMockServer {apnsQ} =
+testChangeNotificationsMode :: HasCallStack => APNSMockServer -> IO ()
+testChangeNotificationsMode apns =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -603,12 +589,12 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, CON)
     -- register notification token, set mode to NMInstant
-    tkn <- registerTestToken alice "abcd" NMInstant apnsQ
+    tkn <- registerTestToken alice "abcd" NMInstant apns
     -- send message, receive notification
     liftIO $ threadDelay 500000
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 1) Nothing
     -- set mode to NMPeriodic
@@ -617,7 +603,7 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
     liftIO $ threadDelay 750000
     2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
     get bob ##> ("", aliceId, SENT $ baseId + 2)
-    noNotification apnsQ
+    noNotification alice apns
     get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 2) Nothing
     -- set mode to NMInstant
@@ -626,7 +612,7 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
     liftIO $ threadDelay 500000
     3 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello there"
     get bob ##> ("", aliceId, SENT $ baseId + 3)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello there") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 3) Nothing
     -- turn off notifications
@@ -635,26 +621,26 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
     liftIO $ threadDelay 500000
     4 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "why hello there"
     get bob ##> ("", aliceId, SENT $ baseId + 4)
-    noNotification apnsQ
+    noNotifications apns
     get alice =##> \case ("", c, Msg "why hello there") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 4) Nothing
     -- turn on notifications, set mode to NMInstant
-    void $ registerTestToken alice "abcd" NMInstant apnsQ
+    void $ registerTestToken alice "abcd" NMInstant apns
     -- send message, receive notification
     liftIO $ threadDelay 500000
     5 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hey"
     get bob ##> ("", aliceId, SENT $ baseId + 5)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hey") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 5) Nothing
     -- no notifications should follow
-    noNotification apnsQ
+    noNotification alice apns
   where
     baseId = 1
     msgId = subtract baseId
 
 testChangeToken :: APNSMockServer -> IO ()
-testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers testDB2 $ \bob -> do
+testChangeToken apns = withAgent 1 agentCfg initAgentServers testDB2 $ \bob -> do
   (aliceId, bobId) <- withAgent 2 agentCfg initAgentServers testDB $ \alice -> runRight $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -666,12 +652,12 @@ testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers t
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, CON)
     -- register notification token, set mode to NMInstant
-    void $ registerTestToken alice "abcd" NMInstant apnsQ
+    void $ registerTestToken alice "abcd" NMInstant apns
     -- send message, receive notification
     liftIO $ threadDelay 500000
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 1) Nothing
     pure (aliceId, bobId)
@@ -679,53 +665,66 @@ testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers t
   withAgent 3 agentCfg initAgentServers testDB $ \alice1 -> runRight_ $ do
     subscribeConnection alice1 bobId
     -- change notification token
-    void $ registerTestToken alice1 "bcde" NMInstant apnsQ
+    void $ registerTestToken alice1 "bcde" NMInstant apns
     -- send message, receive notification
     liftIO $ threadDelay 500000
     2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello there"
     get bob ##> ("", aliceId, SENT $ baseId + 2)
-    void $ messageNotificationData alice1 apnsQ
+    void $ messageNotificationData alice1 apns
     get alice1 =##> \case ("", c, Msg "hello there") -> c == bobId; _ -> False
     ackMessage alice1 bobId (baseId + 2) Nothing
     -- no notifications should follow
-    noNotification apnsQ
+    noNotification alice1 apns
   where
     baseId = 1
     msgId = subtract baseId
 
 testNotificationsStoreLog :: ATransport -> APNSMockServer -> IO ()
-testNotificationsStoreLog t APNSMockServer {apnsQ} = withAgentClients2 $ \alice bob -> do
-  (aliceId, bobId) <- withNtfServerStoreLog t $ \threadId -> runRight $ do
-    (aliceId, bobId) <- makeConnection alice bob
-    _ <- registerTestToken alice "abcd" NMInstant apnsQ
-    liftIO $ threadDelay 250000
-    2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
-    get bob ##> ("", aliceId, SENT 2)
-    void $ messageNotificationData alice apnsQ
-    get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
-    ackMessage alice bobId 2 Nothing
-    liftIO $ killThread threadId
-    pure (aliceId, bobId)
+testNotificationsStoreLog t apns = withAgentClients2 $ \alice bob -> do
+  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    (aliceId, bobId) <- withNtfServerStoreLog t $ \threadId -> runRight $ do
+      (aliceId, bobId) <- makeConnection alice bob
+      _ <- registerTestToken alice "abcd" NMInstant apns
+      liftIO $ threadDelay 250000
+      2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
+      get bob ##> ("", aliceId, SENT 2)
+      void $ messageNotificationData alice apns
+      get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
+      ackMessage alice bobId 2 Nothing
+      liftIO $ killThread threadId
+      pure (aliceId, bobId)
 
-  liftIO $ threadDelay 250000
-
-  withNtfServerStoreLog t $ \threadId -> runRight_ $ do
     liftIO $ threadDelay 250000
-    3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
-    get bob ##> ("", aliceId, SENT 3)
-    void $ messageNotificationData alice apnsQ
-    get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
-    liftIO $ killThread threadId
+
+    withNtfServerStoreLog t $ \threadId -> runRight_ $ do
+      liftIO $ threadDelay 250000
+      3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
+      get bob ##> ("", aliceId, SENT 3)
+      void $ messageNotificationData alice apns
+      get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
+      ackMessage alice bobId 3 Nothing
+      liftIO $ killThread threadId
+
+    runRight_ $ do
+      4 <- sendMessage bob aliceId (SMP.MsgFlags True) "message 4"
+      get bob ##> ("", aliceId, SENT 4)
+      get alice =##> \case ("", c, Msg "message 4") -> c == bobId; _ -> False
+      ackMessage alice bobId 4 Nothing
+      noNotifications apns
+
+  withSmpServerStoreMsgLogOn t testPort $ \_ ->
+    withNtfServerStoreLog t $ \_ -> runRight_ $ do
+      void $ messageNotificationData alice apns
 
 testNotificationsSMPRestart :: ATransport -> APNSMockServer -> IO ()
-testNotificationsSMPRestart t APNSMockServer {apnsQ} = withAgentClients2 $ \alice bob -> do
+testNotificationsSMPRestart t apns = withAgentClients2 $ \alice bob -> do
   (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \threadId -> runRight $ do
     (aliceId, bobId) <- makeConnection alice bob
-    _ <- registerTestToken alice "abcd" NMInstant apnsQ
+    _ <- registerTestToken alice "abcd" NMInstant apns
     liftIO $ threadDelay 250000
     2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT 2)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId 2 Nothing
     liftIO $ killThread threadId
@@ -741,22 +740,22 @@ testNotificationsSMPRestart t APNSMockServer {apnsQ} = withAgentClients2 $ \alic
     liftIO $ threadDelay 1000000
     3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
     get bob ##> ("", aliceId, SENT 3)
-    _ <- messageNotificationData alice apnsQ
+    _ <- messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
     liftIO $ killThread threadId
 
 testNotificationsSMPRestartBatch :: Int -> ATransport -> APNSMockServer -> IO ()
-testNotificationsSMPRestartBatch n t APNSMockServer {apnsQ} =
+testNotificationsSMPRestartBatch n t apns =
   withAgentClientsCfgServers2 agentCfg agentCfg initAgentServers2 $ \a b -> do
     threadDelay 1000000
     conns <- runServers $ do
       conns <- replicateM (n :: Int) $ makeConnection a b
-      _ <- registerTestToken a "abcd" NMInstant apnsQ
+      _ <- registerTestToken a "abcd" NMInstant apns
       liftIO $ threadDelay 5000000
       forM_ conns $ \(aliceId, bobId) -> do
         msgId <- sendMessage b aliceId (SMP.MsgFlags True) "hello"
         get b ##> ("", aliceId, SENT msgId)
-        void $ messageNotificationData a apnsQ
+        void $ messageNotificationData a apns
         get a =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
         ackMessage a bobId msgId Nothing
       pure conns
@@ -780,7 +779,7 @@ testNotificationsSMPRestartBatch n t APNSMockServer {apnsQ} =
       forM_ conns $ \(aliceId, bobId) -> do
         msgId <- sendMessage b aliceId (SMP.MsgFlags True) "hello again"
         get b ##> ("", aliceId, SENT msgId)
-        _ <- messageNotificationData a apnsQ
+        _ <- messageNotificationData a apns
         get a =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
   where
     runServers :: ExceptT AgentErrorType IO a -> IO a
@@ -792,16 +791,16 @@ testNotificationsSMPRestartBatch n t APNSMockServer {apnsQ} =
         pure res
 
 testSwitchNotifications :: InitialAgentServers -> APNSMockServer -> IO ()
-testSwitchNotifications servers APNSMockServer {apnsQ} =
+testSwitchNotifications servers apns =
   withAgentClientsCfgServers2 agentCfg agentCfg servers $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
     exchangeGreetings a bId b aId
-    _ <- registerTestToken a "abcd" NMInstant apnsQ
+    _ <- registerTestToken a "abcd" NMInstant apns
     liftIO $ threadDelay 250000
     let testMessage msg = do
           msgId <- sendMessage b aId (SMP.MsgFlags True) msg
           get b ##> ("", aId, SENT msgId)
-          void $ messageNotificationData a apnsQ
+          void $ messageNotificationData a apns
           get a =##> \case ("", c, Msg msg') -> c == bId && msg == msg'; _ -> False
           ackMessage a bId msgId Nothing
     testMessage "hello"
@@ -811,74 +810,80 @@ testSwitchNotifications servers APNSMockServer {apnsQ} =
     testMessage "hello again"
 
 testNotificationsOldToken :: APNSMockServer -> IO ()
-testNotificationsOldToken APNSMockServer {apnsQ} =
+testNotificationsOldToken apns =
   withAgentClients3 $ \a b c -> runRight_ $ do
     (abId, baId) <- makeConnection a b
-    let testMessageAB = testMessage_ apnsQ a abId b baId
-    _ <- registerTestToken a "abcd" NMInstant apnsQ
+    let testMessageAB = testMessage_ apns a abId b baId
+    _ <- registerTestToken a "abcd" NMInstant apns
     liftIO $ threadDelay 250000
     testMessageAB "hello"
     -- change server
     liftIO $ setNtfServers a [testNtfServer2] -- server 2 isn't running now, don't use
     -- replacing token keeps server
-    _ <- registerTestToken a "xyzw" NMInstant apnsQ
+    _ <- registerTestToken a "xyzw" NMInstant apns
     getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort
     testMessageAB "still there"
     -- new connections keep server
     (acId, caId) <- makeConnection a c
-    let testMessageAC = testMessage_ apnsQ a acId c caId
+    let testMessageAC = testMessage_ apns a acId c caId
     testMessageAC "greetings"
 
 testNotificationsNewToken :: APNSMockServer -> ThreadId -> IO ()
-testNotificationsNewToken APNSMockServer {apnsQ} oldNtf =
+testNotificationsNewToken apns oldNtf =
   withAgentClients3 $ \a b c -> runRight_ $ do
     (abId, baId) <- makeConnection a b
-    let testMessageAB = testMessage_ apnsQ a abId b baId
-    tkn <- registerTestToken a "abcd" NMInstant apnsQ
+    let testMessageAB = testMessage_ apns a abId b baId
+    tkn <- registerTestToken a "abcd" NMInstant apns
     getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort
     liftIO $ threadDelay 250000
     testMessageAB "hello"
     -- switch
     liftIO $ setNtfServers a [testNtfServer2]
     deleteNtfToken a tkn
-    _ <- registerTestToken a "abcd" NMInstant apnsQ
+    _ <- registerTestToken a "abcd" NMInstant apns
     getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort2
     liftIO $ threadDelay 250000
     liftIO $ killThread oldNtf
     -- -- back to work
     testMessageAB "hello again"
     (acId, caId) <- makeConnection a c
-    let testMessageAC = testMessage_ apnsQ a acId c caId
+    let testMessageAC = testMessage_ apns a acId c caId
     testMessageAC "greetings"
 
-testMessage_ :: HasCallStack => TBQueue APNSMockRequest -> AgentClient -> ConnId -> AgentClient -> ConnId -> SMP.MsgBody -> ExceptT AgentErrorType IO ()
-testMessage_ apnsQ a aId b bId msg = do
+testMessage_ :: HasCallStack => APNSMockServer -> AgentClient -> ConnId -> AgentClient -> ConnId -> SMP.MsgBody -> ExceptT AgentErrorType IO ()
+testMessage_ apns a aId b bId msg = do
   msgId <- sendMessage b aId (SMP.MsgFlags True) msg
   get b ##> ("", aId, SENT msgId)
-  void $ messageNotificationData a apnsQ
+  void $ messageNotificationData a apns
   get a =##> \case ("", c, Msg msg') -> c == bId && msg == msg'; _ -> False
   ackMessage a bId msgId Nothing
 
-messageNotification :: HasCallStack => TBQueue APNSMockRequest -> ExceptT AgentErrorType IO (C.CbNonce, ByteString)
-messageNotification apnsQ = do
-  1000000 `timeout` atomically (readTBQueue apnsQ) >>= \case
+messageNotification :: HasCallStack => APNSMockServer -> DeviceToken -> ExceptT AgentErrorType IO (C.CbNonce, ByteString)
+messageNotification apns tkn = do
+  500000 `timeout` getMockNotification apns tkn >>= \case
     Nothing -> error "no notification"
-    Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}, sendApnsResponse} -> do
+    Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}} -> do
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       message <- ntfData .-> "message"
-      liftIO $ sendApnsResponse APNSRespOk
       pure (nonce, message)
     _ -> error "bad notification"
 
-messageNotificationData :: HasCallStack => AgentClient -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO PNMessageData
-messageNotificationData c apnsQ = do
-  (nonce, message) <- messageNotification apnsQ
-  NtfToken {ntfDhSecret = Just dhSecret} <- getNtfTokenData c
+messageNotificationData :: HasCallStack => AgentClient -> APNSMockServer -> ExceptT AgentErrorType IO PNMessageData
+messageNotificationData c apns = do
+  NtfToken {deviceToken, ntfDhSecret = Just dhSecret} <- getNtfTokenData c
+  (nonce, message) <- messageNotification apns deviceToken
   Right pnMsgs <- liftEither . first INTERNAL $ Right . parseAll pnMessagesP =<< first show (C.cbDecrypt dhSecret nonce message)
   pure $ L.last pnMsgs
 
-noNotification :: TBQueue APNSMockRequest -> ExceptT AgentErrorType IO ()
-noNotification apnsQ = do
-  500000 `timeout` atomically (readTBQueue apnsQ) >>= \case
+noNotification :: AgentClient -> APNSMockServer -> ExceptT AgentErrorType IO ()
+noNotification c apns = do
+  NtfToken {deviceToken} <- getNtfTokenData c
+  500000 `timeout` getMockNotification apns deviceToken >>= \case
+    Nothing -> pure ()
+    _ -> error "unexpected notification"
+
+noNotifications :: APNSMockServer -> ExceptT AgentErrorType IO ()
+noNotifications apns = do
+  500000 `timeout` getAnyMockNotification apns >>= \case
     Nothing -> pure ()
     _ -> error "unexpected notification"
diff --git a/tests/CoreTests/BatchingTests.hs b/tests/CoreTests/BatchingTests.hs
index a12cbf1ea..e2427b565 100644
--- a/tests/CoreTests/BatchingTests.hs
+++ b/tests/CoreTests/BatchingTests.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -14,11 +15,13 @@ import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString as B
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.List.NonEmpty as L
+import Data.Time.Clock.System (SystemTime, getSystemTime)
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
 import qualified Data.X509.File as XF
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport
 import Test.Hspec
@@ -26,29 +29,30 @@ import Test.Hspec
 batchingTests :: Spec
 batchingTests = do
   describe "batchTransmissions" $ do
-    describe "SMP v6 (current)" $ do
-      it "should batch with 107 subscriptions per batch" testBatchSubscriptions
+    describe "SMP v6 (previous)" $ do
+      it "should batch with 107 subscriptions per batch" testBatchSubscriptionsV6
+      it "should break on message that does not fit" testBatchWithMessageV6
+      it "should break on large message" testBatchWithLargeMessageV6
+    describe "SMP current" $ do
+      it "should batch with 136 subscriptions per batch" testBatchSubscriptions
       it "should break on message that does not fit" testBatchWithMessage
       it "should break on large message" testBatchWithLargeMessage
-    describe "v7 (next)" $ do
-      it "should batch with 136 subscriptions per batch" testBatchSubscriptionsV7
-      it "should break on message that does not fit" testBatchWithMessageV7
-      it "should break on large message" testBatchWithLargeMessageV7
   describe "batchTransmissions'" $ do
-    describe "SMP v6 (current)" $ do
-      it "should batch with 107 subscriptions per batch" testClientBatchSubscriptions
+    describe "SMP v6 (previous)" $ do
+      it "should batch with 107 subscriptions per batch" testClientBatchSubscriptionsV6
+      it "should break on message that does not fit" testClientBatchWithMessageV6
+      it "should break on large message" testClientBatchWithLargeMessageV6
+    describe "SMP current" $ do
+      it "should batch with 136 subscriptions per batch" testClientBatchSubscriptions
+      it "should batch with 255 ENDs per batch" testClientBatchENDs
+      it "should batch with 80 NMSGs per batch" testClientBatchNMSGs
       it "should break on message that does not fit" testClientBatchWithMessage
       it "should break on large message" testClientBatchWithLargeMessage
-    describe "v7 (next)" $ do
-      it "should batch with 136 subscriptions per batch" testClientBatchSubscriptionsV7
-      it "should batch with N ENDs per batch" testClientBatchENDs
-      it "should break on message that does not fit" testClientBatchWithMessageV7
-      it "should break on large message" testClientBatchWithLargeMessageV7
 
-testBatchSubscriptions :: IO ()
-testBatchSubscriptions = do
+testBatchSubscriptionsV6 :: IO ()
+testBatchSubscriptionsV6 = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs <- replicateM 250 $ randomSUB sessId
+  subs <- replicateM 250 $ randomSUBv6 sessId
   let batches1 = batchTransmissions False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   length batches1 `shouldBe` 250
@@ -58,10 +62,10 @@ testBatchSubscriptions = do
   (n1, n2, n3) `shouldBe` (36, 107, 107)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testBatchSubscriptionsV7 :: IO ()
-testBatchSubscriptionsV7 = do
+testBatchSubscriptions :: IO ()
+testBatchSubscriptions = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs <- replicateM 300 $ randomSUBv7 sessId
+  subs <- replicateM 300 $ randomSUB sessId
   let batches1 = batchTransmissions False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   length batches1 `shouldBe` 300
@@ -71,6 +75,22 @@ testBatchSubscriptionsV7 = do
   (n1, n2, n3) `shouldBe` (28, 136, 136)
   all lenOk [s1, s2, s3] `shouldBe` True
 
+testBatchWithMessageV6 :: IO ()
+testBatchWithMessageV6 = do
+  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
+  subs1 <- replicateM 60 $ randomSUBv6 sessId
+  send <- randomSENDv6 sessId 8000
+  subs2 <- replicateM 40 $ randomSUBv6 sessId
+  let cmds = subs1 <> [send] <> subs2
+      batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
+  all lenOk1 batches1 `shouldBe` True
+  length batches1 `shouldBe` 101
+  let batches = batchTransmissions True smpBlockSize $ L.fromList cmds
+  length batches `shouldBe` 2
+  [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _] <- pure batches
+  (n1, n2) `shouldBe` (47, 54)
+  all lenOk [s1, s2] `shouldBe` True
+
 testBatchWithMessage :: IO ()
 testBatchWithMessage = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
@@ -84,31 +104,15 @@ testBatchWithMessage = do
   let batches = batchTransmissions True smpBlockSize $ L.fromList cmds
   length batches `shouldBe` 2
   [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _] <- pure batches
-  (n1, n2) `shouldBe` (47, 54)
-  all lenOk [s1, s2] `shouldBe` True
-
-testBatchWithMessageV7 :: IO ()
-testBatchWithMessageV7 = do
-  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs1 <- replicateM 60 $ randomSUBv7 sessId
-  send <- randomSENDv7 sessId 8000
-  subs2 <- replicateM 40 $ randomSUBv7 sessId
-  let cmds = subs1 <> [send] <> subs2
-      batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
-  all lenOk1 batches1 `shouldBe` True
-  length batches1 `shouldBe` 101
-  let batches = batchTransmissions True smpBlockSize $ L.fromList cmds
-  length batches `shouldBe` 2
-  [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _] <- pure batches
   (n1, n2) `shouldBe` (32, 69)
   all lenOk [s1, s2] `shouldBe` True
 
-testBatchWithLargeMessage :: IO ()
-testBatchWithLargeMessage = do
+testBatchWithLargeMessageV6 :: IO ()
+testBatchWithLargeMessageV6 = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs1 <- replicateM 50 $ randomSUB sessId
-  send <- randomSEND sessId 17000
-  subs2 <- replicateM 150 $ randomSUB sessId
+  subs1 <- replicateM 50 $ randomSUBv6 sessId
+  send <- randomSENDv6 sessId 17000
+  subs2 <- replicateM 150 $ randomSUBv6 sessId
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -122,12 +126,12 @@ testBatchWithLargeMessage = do
   (n1, n2, n3) `shouldBe` (50, 43, 107)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testBatchWithLargeMessageV7 :: IO ()
-testBatchWithLargeMessageV7 = do
+testBatchWithLargeMessage :: IO ()
+testBatchWithLargeMessage = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs1 <- replicateM 60 $ randomSUBv7 sessId
-  send <- randomSENDv7 sessId 17000
-  subs2 <- replicateM 150 $ randomSUBv7 sessId
+  subs1 <- replicateM 60 $ randomSUB sessId
+  send <- randomSEND sessId 17000
+  subs2 <- replicateM 150 $ randomSUB sessId
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -141,10 +145,10 @@ testBatchWithLargeMessageV7 = do
   (n1, n2, n3) `shouldBe` (60, 14, 136)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testClientBatchSubscriptions :: IO ()
-testClientBatchSubscriptions = do
-  client <- testClientStub
-  subs <- replicateM 250 $ randomSUBCmd client
+testClientBatchSubscriptionsV6 :: IO ()
+testClientBatchSubscriptionsV6 = do
+  client <- testClientStubV6
+  subs <- replicateM 250 $ randomSUBCmdV6 client
   let batches1 = batchTransmissions' False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   let batches = batchTransmissions' True smpBlockSize $ L.fromList subs
@@ -154,10 +158,10 @@ testClientBatchSubscriptions = do
   (length rs1, length rs2, length rs3) `shouldBe` (36, 107, 107)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testClientBatchSubscriptionsV7 :: IO ()
-testClientBatchSubscriptionsV7 = do
-  client <- clientStubV7
-  subs <- replicateM 300 $ randomSUBCmdV7 client
+testClientBatchSubscriptions :: IO ()
+testClientBatchSubscriptions = do
+  client <- testClientStub
+  subs <- replicateM 300 $ randomSUBCmd client
   let batches1 = batchTransmissions' False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   let batches = batchTransmissions' True smpBlockSize $ L.fromList subs
@@ -169,7 +173,7 @@ testClientBatchSubscriptionsV7 = do
 
 testClientBatchENDs :: IO ()
 testClientBatchENDs = do
-  client <- clientStubV7
+  client <- testClientStub
   ends <- replicateM 300 randomENDCmd
   let ends' = map (\t -> Right (Nothing, encodeTransmission (thParams client) t)) ends
       batches1 = batchTransmissions False smpBlockSize $ L.fromList ends'
@@ -181,6 +185,38 @@ testClientBatchENDs = do
   (length rs1, length rs2) `shouldBe` (45, 255)
   all lenOk [s1, s2] `shouldBe` True
 
+testClientBatchNMSGs :: IO ()
+testClientBatchNMSGs = do
+  client <- testClientStub
+  ts <- getSystemTime
+  ntfs <- replicateM 200 $ randomNMSGCmd ts
+  let ntfs' = map (\t -> Right (Nothing, encodeTransmission (thParams client) t)) ntfs
+      batches1 = batchTransmissions False smpBlockSize $ L.fromList ntfs'
+  all lenOk1 batches1 `shouldBe` True
+  let batches = batchTransmissions True smpBlockSize $ L.fromList ntfs'
+  length batches `shouldBe` 3
+  [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2, TBTransmissions s3 n3 rs3] <- pure batches
+  (n1, n2, n3) `shouldBe` (40, 80, 80)
+  (length rs1, length rs2, length rs3) `shouldBe` (40, 80, 80)
+  all lenOk [s1, s2, s3] `shouldBe` True
+
+testClientBatchWithMessageV6 :: IO ()
+testClientBatchWithMessageV6 = do
+  client <- testClientStubV6
+  subs1 <- replicateM 60 $ randomSUBCmdV6 client
+  send <- randomSENDCmdV6 client 8000
+  subs2 <- replicateM 40 $ randomSUBCmdV6 client
+  let cmds = subs1 <> [send] <> subs2
+      batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
+  all lenOk1 batches1 `shouldBe` True
+  length batches1 `shouldBe` 101
+  let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds
+  length batches `shouldBe` 2
+  [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2] <- pure batches
+  (n1, n2) `shouldBe` (47, 54)
+  (length rs1, length rs2) `shouldBe` (47, 54)
+  all lenOk [s1, s2] `shouldBe` True
+
 testClientBatchWithMessage :: IO ()
 testClientBatchWithMessage = do
   client <- testClientStub
@@ -194,33 +230,16 @@ testClientBatchWithMessage = do
   let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds
   length batches `shouldBe` 2
   [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2] <- pure batches
-  (n1, n2) `shouldBe` (47, 54)
-  (length rs1, length rs2) `shouldBe` (47, 54)
-  all lenOk [s1, s2] `shouldBe` True
-
-testClientBatchWithMessageV7 :: IO ()
-testClientBatchWithMessageV7 = do
-  client <- clientStubV7
-  subs1 <- replicateM 60 $ randomSUBCmdV7 client
-  send <- randomSENDCmdV7 client 8000
-  subs2 <- replicateM 40 $ randomSUBCmdV7 client
-  let cmds = subs1 <> [send] <> subs2
-      batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
-  all lenOk1 batches1 `shouldBe` True
-  length batches1 `shouldBe` 101
-  let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds
-  length batches `shouldBe` 2
-  [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2] <- pure batches
   (n1, n2) `shouldBe` (32, 69)
   (length rs1, length rs2) `shouldBe` (32, 69)
   all lenOk [s1, s2] `shouldBe` True
 
-testClientBatchWithLargeMessage :: IO ()
-testClientBatchWithLargeMessage = do
-  client <- testClientStub
-  subs1 <- replicateM 50 $ randomSUBCmd client
-  send <- randomSENDCmd client 17000
-  subs2 <- replicateM 150 $ randomSUBCmd client
+testClientBatchWithLargeMessageV6 :: IO ()
+testClientBatchWithLargeMessageV6 = do
+  client <- testClientStubV6
+  subs1 <- replicateM 50 $ randomSUBCmdV6 client
+  send <- randomSENDCmdV6 client 17000
+  subs2 <- replicateM 150 $ randomSUBCmdV6 client
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -244,12 +263,12 @@ testClientBatchWithLargeMessage = do
   (length rs1', length rs2') `shouldBe` (93, 107)
   all lenOk [s1', s2'] `shouldBe` True
 
-testClientBatchWithLargeMessageV7 :: IO ()
-testClientBatchWithLargeMessageV7 = do
-  client <- clientStubV7
-  subs1 <- replicateM 60 $ randomSUBCmdV7 client
-  send <- randomSENDCmdV7 client 17000
-  subs2 <- replicateM 150 $ randomSUBCmdV7 client
+testClientBatchWithLargeMessage :: IO ()
+testClientBatchWithLargeMessage = do
+  client <- testClientStub
+  subs1 <- replicateM 60 $ randomSUBCmd client
+  send <- randomSENDCmd client 17000
+  subs2 <- replicateM 150 $ randomSUBCmd client
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -273,25 +292,25 @@ testClientBatchWithLargeMessageV7 = do
   (length rs1', length rs2') `shouldBe` (74, 136)
   all lenOk [s1', s2'] `shouldBe` True
 
-testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
-testClientStub = do
+testClientStubV6 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
+testClientStubV6 = do
   g <- C.newRandom
   sessId <- atomically $ C.randomBytes 32 g
   smpClientStub g sessId subModeSMPVersion Nothing
 
-clientStubV7 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
-clientStubV7 = do
+testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
+testClientStub = do
   g <- C.newRandom
   sessId <- atomically $ C.randomBytes 32 g
   (rKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
-  thAuth_ <- testTHandleAuth authCmdsSMPVersion g rKey
-  smpClientStub g sessId authCmdsSMPVersion thAuth_
+  thAuth_ <- testTHandleAuth currentClientSMPRelayVersion g rKey
+  smpClientStub g sessId currentClientSMPRelayVersion thAuth_
+
+randomSUBv6 :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
+randomSUBv6 = randomSUB_ C.SEd25519 subModeSMPVersion
 
 randomSUB :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSUB = randomSUB_ C.SEd25519 subModeSMPVersion
-
-randomSUBv7 :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSUBv7 = randomSUB_ C.SEd25519 authCmdsSMPVersion
+randomSUB = randomSUB_ C.SEd25519 currentClientSMPRelayVersion
 
 randomSUB_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> VersionSMP -> ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSUB_ a v sessId = do
@@ -304,11 +323,11 @@ randomSUB_ a v sessId = do
       TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId rId, Cmd SRecipient SUB)
   pure $ (,tToSend) <$> authTransmission thAuth_ (Just rpKey) nonce tForAuth
 
-randomSUBCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
-randomSUBCmd = randomSUBCmd_ C.SEd25519
+randomSUBCmdV6 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
+randomSUBCmdV6 = randomSUBCmd_ C.SEd25519
 
-randomSUBCmdV7 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
-randomSUBCmdV7 = randomSUBCmd_ C.SEd25519 -- same as v6
+randomSUBCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
+randomSUBCmd = randomSUBCmd_ C.SEd25519 -- same as v6
 
 randomSUBCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
 randomSUBCmd_ a c = do
@@ -323,11 +342,22 @@ randomENDCmd = do
   rId <- atomically $ C.randomBytes 24 g
   pure (CorrId "", EntityId rId, END)
 
-randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSEND = randomSEND_ C.SEd25519 subModeSMPVersion
+randomNMSGCmd :: SystemTime -> IO (Transmission BrokerMsg)
+randomNMSGCmd ts = do
+  g <- C.newRandom
+  nId <- atomically $ C.randomBytes 24 g
+  msgId <- atomically $ C.randomBytes 24 g
+  (k, pk) <- atomically $ C.generateKeyPair g
+  nonce <- atomically $ C.randomCbNonce g
+  let msgMeta = NMsgMeta {msgId, msgTs = ts}
+  Right encNMsgMeta <- pure $ C.cbEncrypt (C.dh' k pk) nonce (smpEncode msgMeta) 128
+  pure (CorrId "", EntityId nId, NMSG nonce encNMsgMeta)
 
-randomSENDv7 :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSENDv7 = randomSEND_ C.SX25519 authCmdsSMPVersion
+randomSENDv6 :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
+randomSENDv6 = randomSEND_ C.SEd25519 subModeSMPVersion
+
+randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
+randomSEND = randomSEND_ C.SX25519 currentClientSMPRelayVersion
 
 randomSEND_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> VersionSMP -> ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSEND_ a v sessId len = do
@@ -365,11 +395,11 @@ testTHandleAuth v g (C.APublicAuthKey a serverPeerPubKey) = case a of
     pure $ Just THAuthClient {serverPeerPubKey, serverCertKey, sessSecret = Nothing}
   _ -> pure Nothing
 
-randomSENDCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
-randomSENDCmd = randomSENDCmd_ C.SEd25519
+randomSENDCmdV6 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
+randomSENDCmdV6 = randomSENDCmd_ C.SEd25519
 
-randomSENDCmdV7 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
-randomSENDCmdV7 = randomSENDCmd_ C.SX25519
+randomSENDCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
+randomSENDCmd = randomSENDCmd_ C.SX25519
 
 randomSENDCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
 randomSENDCmd_ a c len = do
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index 87ff797f0..6c38af721 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
@@ -14,14 +15,18 @@
 
 module NtfClient where
 
+import Control.Concurrent.STM (retry)
 import Control.Monad
 import Control.Monad.Except (runExceptT)
+import Control.Monad.IO.Class
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Types as JT
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
 import Data.List.NonEmpty (NonEmpty)
+import qualified Data.Map.Strict as M
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Network.HTTP.Types (Status)
@@ -33,13 +38,14 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost,
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Notifications.Protocol (NtfResponse)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfResponse)
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
 import Simplex.Messaging.Notifications.Server.Env
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
 import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol
+import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), http2TLSParams)
@@ -83,9 +89,9 @@ ntfServerCfg =
     { transports = [],
       subIdBytes = 24,
       regCodeBytes = 32,
-      clientQSize = 1,
-      subQSize = 1,
-      pushQSize = 1,
+      clientQSize = 2,
+      subQSize = 2,
+      pushQSize = 2,
       smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 0},
       apnsConfig =
         defaultAPNSPushClientConfig
@@ -124,7 +130,7 @@ ntfServerCfgVPrev =
 withNtfServerStoreLog :: ATransport -> (ThreadId -> IO a) -> IO a
 withNtfServerStoreLog t = withNtfServerCfg ntfServerCfg {storeLogFile = Just ntfTestStoreLogFile, transports = [(ntfTestPort, t, False)]}
 
-withNtfServerThreadOn :: ATransport -> ServiceName -> (ThreadId -> IO a) -> IO a
+withNtfServerThreadOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withNtfServerThreadOn t port' = withNtfServerCfg ntfServerCfg {transports = [(port', t, False)]}
 
 withNtfServerCfg :: HasCallStack => NtfServerConfig -> (ThreadId -> IO a) -> IO a
@@ -136,10 +142,10 @@ withNtfServerCfg cfg@NtfServerConfig {transports} =
         (\started -> runNtfServerBlocking started cfg)
         (pure ())
 
-withNtfServerOn :: ATransport -> ServiceName -> IO a -> IO a
+withNtfServerOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => IO a) -> IO a
 withNtfServerOn t port' = withNtfServerThreadOn t port' . const
 
-withNtfServer :: ATransport -> IO a -> IO a
+withNtfServer :: HasCallStack => ATransport -> (HasCallStack => IO a) -> IO a
 withNtfServer t = withNtfServerOn t ntfTestPort
 
 runNtfTest :: forall c a. Transport c => (THandleNTF c 'TClient -> IO a) -> IO a
@@ -166,22 +172,21 @@ ntfTest :: Transport c => TProxy c -> (THandleNTF c 'TClient -> IO ()) -> Expect
 ntfTest _ test' = runNtfTest test' `shouldReturn` ()
 
 data APNSMockRequest = APNSMockRequest
-  { notification :: APNSNotification,
-    sendApnsResponse :: APNSMockResponse -> IO ()
+  { notification :: APNSNotification
   }
 
 data APNSMockResponse = APNSRespOk | APNSRespError Status Text
 
 data APNSMockServer = APNSMockServer
   { action :: Async (),
-    apnsQ :: TBQueue APNSMockRequest,
+    notifications :: TM.TMap ByteString (TBQueue APNSMockRequest),
     http2Server :: HTTP2Server
   }
 
 apnsMockServerConfig :: HTTP2ServerConfig
 apnsMockServerConfig =
   HTTP2ServerConfig
-    { qSize = 1,
+    { qSize = 2,
       http2Port = apnsTestPort,
       bufferSize = 16384,
       bodyHeadSize = 16384,
@@ -224,23 +229,36 @@ deriving instance ToJSON APNSErrorResponse
 getAPNSMockServer :: HTTP2ServerConfig -> IO APNSMockServer
 getAPNSMockServer config@HTTP2ServerConfig {qSize} = do
   http2Server <- getHTTP2Server config Nothing
-  apnsQ <- newTBQueueIO qSize
-  action <- async $ runAPNSMockServer apnsQ http2Server
-  pure APNSMockServer {action, apnsQ, http2Server}
+  notifications <- TM.emptyIO
+  action <- async $ runAPNSMockServer notifications http2Server
+  pure APNSMockServer {action, notifications, http2Server}
   where
-    runAPNSMockServer apnsQ HTTP2Server {reqQ} = forever $ do
-      HTTP2Request {reqBody = HTTP2Body {bodyHead}, sendResponse} <- atomically $ readTBQueue reqQ
+    runAPNSMockServer notifications HTTP2Server {reqQ} = forever $ do
+      HTTP2Request {request, reqBody = HTTP2Body {bodyHead}, sendResponse} <- atomically $ readTBQueue reqQ
       let sendApnsResponse = \case
             APNSRespOk -> sendResponse $ H.responseNoBody N.ok200 []
             APNSRespError status reason ->
               sendResponse . H.responseBuilder status [] . lazyByteString $ J.encode APNSErrorResponse {reason}
       case J.decodeStrict' bodyHead of
-        Just notification ->
-          atomically $ writeTBQueue apnsQ APNSMockRequest {notification, sendApnsResponse}
+        Just notification -> do
+          Just token <- pure $ B.stripPrefix "/3/device/" =<< H.requestPath request
+          q <- atomically $ TM.lookup token notifications >>= maybe (newTokenQueue token) pure
+          atomically $ writeTBQueue q APNSMockRequest {notification}
+          sendApnsResponse APNSRespOk
+          where
+            newTokenQueue token = newTBQueue qSize >>= \q -> TM.insert token q notifications >> pure q
         _ -> do
           putStrLn $ "runAPNSMockServer J.decodeStrict' error, reqBody: " <> show bodyHead
           sendApnsResponse $ APNSRespError N.badRequest400 "bad_request_body"
 
+getMockNotification :: MonadIO m => APNSMockServer -> DeviceToken -> m APNSMockRequest
+getMockNotification APNSMockServer {notifications} (DeviceToken _ token) = do
+  atomically $ TM.lookup token notifications >>= maybe retry readTBQueue
+
+getAnyMockNotification :: MonadIO m => APNSMockServer -> m APNSMockRequest
+getAnyMockNotification APNSMockServer {notifications} = do
+  atomically $ readTVar notifications >>= mapM readTBQueue . M.elems >>= \case [] -> retry; ntf : _ -> pure ntf
+
 closeAPNSMockServer :: APNSMockServer -> IO ()
 closeAPNSMockServer APNSMockServer {action, http2Server} = do
   closeHTTP2Server http2Server
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index e3349e9a3..b9560976d 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -104,16 +104,15 @@ testNotificationSubscription (ATransport t) =
     (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
     let tkn = DeviceToken PPApnsTest "abcd"
-    withAPNSMockServer $ \APNSMockServer {apnsQ} ->
+    withAPNSMockServer $ \apns ->
       smpTest2 t $ \rh sh ->
         ntfTest t $ \nh -> do
           -- create queue
           (sId, rId, rKey, rcvDhSecret) <- createAndSecureQueue rh sPub
           -- register and verify token
           RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
-          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse = send} <-
-            atomically $ readTBQueue apnsQ
-          send APNSRespOk
+          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+            getMockNotification apns tkn
           let dhSecret = C.dh' ntfDh dhPriv
               Right verification = ntfData .-> "verification"
               Right nonce = C.cbNonce <$> ntfData .-> "nonce"
@@ -131,7 +130,7 @@ testNotificationSubscription (ATransport t) =
           threadDelay 50000
           Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello")
           -- receive notification
-          APNSMockRequest {notification, sendApnsResponse = send'} <- atomically $ readTBQueue apnsQ
+          APNSMockRequest {notification} <- getMockNotification apns tkn
           let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData'} = notification
               Right nonce' = C.cbNonce <$> ntfData' .-> "nonce"
               Right message = ntfData' .-> "message"
@@ -142,7 +141,6 @@ testNotificationSubscription (ATransport t) =
               Right NMsgMeta {msgId, msgTs} = parse smpP (AP.INTERNAL "error parsing NMsgMeta") nMsgMeta
           smpServer `shouldBe` srv
           notifierId `shouldBe` nId
-          send' APNSRespOk
           -- receive message
           Resp "" _ (MSG RcvMessage {msgId = mId1, msgBody = EncRcvMsgBody body}) <- tGet1 rh
           Right ClientRcvMsgBody {msgTs = mTs, msgBody} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret (C.cbNonce mId1) body)
@@ -154,9 +152,8 @@ testNotificationSubscription (ATransport t) =
           let tkn' = DeviceToken PPApnsTest "efgh"
           RespNtf "7" tId' NROk <- signSendRecvNtf nh tknKey ("7", tId, TRPL tkn')
           tId `shouldBe` tId'
-          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}, sendApnsResponse = send2} <-
-            atomically $ readTBQueue apnsQ
-          send2 APNSRespOk
+          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}} <-
+            getMockNotification apns tkn'
           let Right verification2 = ntfData2 .-> "verification"
               Right nonce2 = C.cbNonce <$> ntfData2 .-> "nonce"
               Right code2 = NtfRegCode <$> C.cbDecrypt dhSecret nonce2 verification2
@@ -164,7 +161,7 @@ testNotificationSubscription (ATransport t) =
           RespNtf "8a" _ (NRTkn NTActive) <- signSendRecvNtf nh tknKey ("8a", tId, TCHK)
           -- send message
           Resp "9" _ OK <- signSendRecv sh sKey ("9", sId, _SEND' "hello 2")
-          APNSMockRequest {notification = notification3, sendApnsResponse = send3} <- atomically $ readTBQueue apnsQ
+          APNSMockRequest {notification = notification3} <- getMockNotification apns tkn'
           let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData3} = notification3
               Right nonce3 = C.cbNonce <$> ntfData3 .-> "nonce"
               Right message3 = ntfData3 .-> "message"
@@ -173,4 +170,3 @@ testNotificationSubscription (ATransport t) =
               APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} = L.last pnMsgs2
           smpServer3 `shouldBe` srv
           notifierId3 `shouldBe` nId
-          send3 APNSRespOk
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 970be7174..273cc90ad 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -62,6 +62,12 @@ testStoreMsgsFile = "tests/tmp/smp-server-messages.log"
 testStoreMsgsFile2 :: FilePath
 testStoreMsgsFile2 = "tests/tmp/smp-server-messages.log.2"
 
+testStoreNtfsFile :: FilePath
+testStoreNtfsFile = "tests/tmp/smp-server-ntfs.log"
+
+testStoreNtfsFile2 :: FilePath
+testStoreNtfsFile2 = "tests/tmp/smp-server-ntfs.log.2"
+
 testServerStatsBackupFile :: FilePath
 testServerStatsBackupFile = "tests/tmp/smp-server-stats.log"
 
@@ -104,17 +110,20 @@ cfg =
       msgIdBytes = 24,
       storeLogFile = Nothing,
       storeMsgsFile = Nothing,
+      storeNtfsFile = Nothing,
       allowNewQueues = True,
       newQueueBasicAuth = Nothing,
       controlPortUserAuth = Nothing,
       controlPortAdminAuth = Nothing,
       messageExpiration = Just defaultMessageExpiration,
+      notificationExpiration = defaultNtfExpiration,
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
       logStatsInterval = Nothing,
       logStatsStartTime = 0,
       serverStatsLogFile = "tests/smp-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
       pendingENDInterval = 500000,
+      ntfDeliveryInterval = 200000,
       smpCredentials =
         ServerCredentials
           { caCertificateFile = Just "tests/fixtures/ca.crt",
@@ -159,7 +168,15 @@ proxyVRangeV8 :: VersionRangeSMP
 proxyVRangeV8 = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion
 
 withSmpServerStoreMsgLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
-withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, serverStatsBackupFile = Just testServerStatsBackupFile}
+withSmpServerStoreMsgLogOn t =
+  withSmpServerConfigOn
+    t
+    cfg
+      { storeLogFile = Just testStoreLogFile,
+        storeMsgsFile = Just testStoreMsgsFile,
+        storeNtfsFile = Just testStoreNtfsFile,
+        serverStatsBackupFile = Just testServerStatsBackupFile
+      }
 
 withSmpServerStoreLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withSmpServerStoreLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, serverStatsBackupFile = Just testServerStatsBackupFile}
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 6fe10b38b..2025ff911 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -375,11 +375,11 @@ agentViaProxyRetryOffline = do
             ackMessage alice bobId (baseId + 4) Nothing
   where
     withServer :: (ThreadId -> IO a) -> IO a
-    withServer = withServer_ testStoreLogFile testStoreMsgsFile testPort
+    withServer = withServer_ testStoreLogFile testStoreMsgsFile testStoreNtfsFile testPort
     withServer2 :: (ThreadId -> IO a) -> IO a
-    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsFile2 testPort2
-    withServer_ storeLog storeMsgs port =
-      withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just storeLog, storeMsgsFile = Just storeMsgs} port
+    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsFile2 testStoreNtfsFile2 testPort2
+    withServer_ storeLog storeMsgs storeNtfs port =
+      withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just storeLog, storeMsgsFile = Just storeMsgs, storeNtfsFile = Just storeNtfs} port
     a `up` cId = nGet a =##> \case ("", "", UP _ [c]) -> c == cId; _ -> False
     a `down` cId = nGet a =##> \case ("", "", DOWN _ [c]) -> c == cId; _ -> False
     aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 0a1729ab8..d1ba7c67f 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -615,7 +615,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 2
     logSize testStoreMsgsFile `shouldReturn` 5
-    logSize testServerStatsBackupFile `shouldReturn` 72
+    logSize testServerStatsBackupFile `shouldReturn` 74
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
 
@@ -633,7 +633,7 @@ testRestoreMessages at@(ATransport t) =
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
     logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 72
+    logSize testServerStatsBackupFile `shouldReturn` 74
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
@@ -652,7 +652,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     logSize testStoreMsgsFile `shouldReturn` 0
-    logSize testServerStatsBackupFile `shouldReturn` 72
+    logSize testServerStatsBackupFile `shouldReturn` 74
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
 

From 9cf6c97137039d02f308974470598d1418ce55ff Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Sun, 29 Sep 2024 21:50:38 +0400
Subject: [PATCH 131/195] ntf: batch ntf worker command processing (#1337)

* ntf: batch ntf worker command processing

* remove comment

* change batch size

* wip

* catch

* refactor

* refactor

* batch check

* refactor

* reschedule

* increase ntfSubCheckInterval

* first check interval

* check more statuses

* refactor, remove foldr'

* refactor 2

* refactor client

* refactor 3

* ntf server: improve support for batched commands (#1340)

* re-create ntf subscriptions on NTF AUTH errors

* name

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
---
 src/Simplex/Messaging/Agent/Client.hs         |  37 +-
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |   6 +-
 .../Messaging/Agent/NtfSubSupervisor.hs       | 322 +++++++++++-------
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  24 +-
 src/Simplex/Messaging/Client.hs               |   2 +
 src/Simplex/Messaging/Notifications/Client.hs |  20 ++
 src/Simplex/Messaging/Notifications/Server.hs |  36 +-
 .../Messaging/Notifications/Server/Env.hs     |   4 +-
 8 files changed, 294 insertions(+), 157 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index f578358f1..49198c65e 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -70,7 +70,9 @@ module Simplex.Messaging.Agent.Client
     agentNtfDeleteToken,
     agentNtfEnableCron,
     agentNtfCreateSubscription,
+    agentNtfCreateSubscriptions,
     agentNtfCheckSubscription,
+    agentNtfCheckSubscriptions,
     agentNtfDeleteSubscription,
     agentXFTPDownloadChunk,
     agentXFTPNewChunk,
@@ -153,6 +155,7 @@ module Simplex.Messaging.Agent.Client
     incXFTPServerStat',
     incXFTPServerSizeStat,
     incNtfServerStat,
+    incNtfServerStat',
     AgentWorkersDetails (..),
     getAgentWorkersDetails,
     AgentWorkersSummary (..),
@@ -1730,10 +1733,34 @@ agentNtfCreateSubscription :: AgentClient -> NtfTokenId -> NtfToken -> SMPQueueN
 agentNtfCreateSubscription c tknId NtfToken {ntfServer, ntfPrivKey} smpQueue nKey =
   withNtfClient c ntfServer tknId "SNEW" $ \ntf -> ntfCreateSubscription ntf ntfPrivKey (NewNtfSub tknId smpQueue nKey)
 
-agentNtfCheckSubscription :: AgentClient -> NtfSubscriptionId -> NtfToken -> AM NtfSubStatus
-agentNtfCheckSubscription c subId NtfToken {ntfServer, ntfPrivKey} =
+agentNtfCreateSubscriptions :: AgentClient -> NtfToken -> NonEmpty (NewNtfEntity 'Subscription) -> AM' (NonEmpty (Either AgentErrorType NtfSubscriptionId))
+agentNtfCreateSubscriptions = withNtfBatch "SNEW" ntfCreateSubscriptions
+
+agentNtfCheckSubscription :: AgentClient -> NtfToken -> NtfSubscriptionId -> AM NtfSubStatus
+agentNtfCheckSubscription c NtfToken {ntfServer, ntfPrivKey} subId =
   withNtfClient c ntfServer subId "SCHK" $ \ntf -> ntfCheckSubscription ntf ntfPrivKey subId
 
+agentNtfCheckSubscriptions :: AgentClient -> NtfToken -> NonEmpty NtfSubscriptionId -> AM' (NonEmpty (Either AgentErrorType NtfSubStatus))
+agentNtfCheckSubscriptions = withNtfBatch "SCHK" ntfCheckSubscriptions
+
+-- This batch sends all commands to one ntf server (client can only use one server at a time)
+withNtfBatch ::
+  ByteString ->
+  (NtfClient -> C.APrivateAuthKey -> NonEmpty a -> IO (NonEmpty (Either NtfClientError r))) ->
+  AgentClient ->
+  NtfToken ->
+  NonEmpty a ->
+  AM' (NonEmpty (Either AgentErrorType r))
+withNtfBatch cmdStr action c NtfToken {ntfServer, ntfPrivKey} subs = do
+  let tSess = (0, ntfServer, Nothing)
+  tryAgentError' (getNtfServerClient c tSess) >>= \case
+    Left e -> pure $ L.map (\_ -> Left e) subs
+    Right ntf -> liftIO $ do
+      logServer' "-->" c ntfServer (bshow (length subs) <> " subscriptions") cmdStr
+      L.map agentError <$> action ntf ntfPrivKey subs
+      where
+        agentError = first $ protocolClientError NTF $ clientServer ntf
+
 agentNtfDeleteSubscription :: AgentClient -> NtfSubscriptionId -> NtfToken -> AM ()
 agentNtfDeleteSubscription c subId NtfToken {ntfServer, ntfPrivKey} =
   withNtfClient c ntfServer subId "SDEL" $ \ntf -> ntfDeleteSubscription ntf ntfPrivKey subId
@@ -2058,9 +2085,13 @@ incXFTPServerStat_ = incServerStat (\AgentClient {xftpServersStats = s} -> s) ne
 {-# INLINE incXFTPServerStat_ #-}
 
 incNtfServerStat :: AgentClient -> UserId -> NtfServer -> (AgentNtfServerStats -> TVar Int) -> STM ()
-incNtfServerStat c userId srv sel = incServerStat (\AgentClient {ntfServersStats = s} -> s) newAgentNtfServerStats c userId srv sel 1
+incNtfServerStat c userId srv sel = incNtfServerStat' c userId srv sel 1
 {-# INLINE incNtfServerStat #-}
 
+incNtfServerStat' :: AgentClient -> UserId -> NtfServer -> (AgentNtfServerStats -> TVar Int) -> Int -> STM ()
+incNtfServerStat' = incServerStat (\AgentClient {ntfServersStats = s} -> s) newAgentNtfServerStats
+{-# INLINE incNtfServerStat' #-}
+
 incServerStat :: Num n => (AgentClient -> TMap (UserId, ProtocolServer p) s) -> STM s -> AgentClient -> UserId -> ProtocolServer p -> (s -> TVar n) -> n -> STM ()
 incServerStat statsSel mkNewStats c userId srv sel n = do
   TM.lookup (userId, srv) (statsSel c) >>= \case
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 99a241d2e..1af330f41 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -150,6 +150,7 @@ data AgentConfig = AgentConfig
     deleteErrorCount :: Int,
     ntfCron :: Word16,
     ntfBatchSize :: Int,
+    ntfSubFirstCheckInterval :: NominalDiffTime,
     ntfSubCheckInterval :: NominalDiffTime,
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
@@ -219,8 +220,9 @@ defaultAgentConfig =
       xftpMaxRecipientsPerRequest = 200,
       deleteErrorCount = 10,
       ntfCron = 20, -- minutes
-      ntfBatchSize = 200,
-      ntfSubCheckInterval = nominalDay,
+      ntfBatchSize = 150,
+      ntfSubFirstCheckInterval = nominalDay,
+      ntfSubCheckInterval = 3 * nominalDay,
       -- CA certificate private key is not needed for initialization
       -- ! we do not generate these
       caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
index 96f14dfc3..ff728eac3 100644
--- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
+++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
@@ -25,13 +26,14 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import Data.Bifunctor (first)
-import Data.Either (partitionEithers)
-import Data.Foldable (foldr')
+import Data.Either (fromRight, partitionEithers)
+import Data.Functor (($>))
+import Data.List (foldl')
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
+import Data.Maybe (catMaybes)
 import qualified Data.Set as S
-import Data.Text (Text)
 import Data.Time (UTCTime, addUTCTime, getCurrentTime)
 import Data.Time.Clock (diffUTCTime)
 import Simplex.Messaging.Agent.Client
@@ -43,11 +45,11 @@ import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Notifications.Protocol (NtfSubStatus (..), NtfTknStatus (..), SMPQueueNtf (..))
+import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Protocol (NtfServer, sameSrvAddr)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow, unlessM)
+import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow)
 import System.Random (randomR)
 import UnliftIO
 import UnliftIO.Concurrent (forkIO)
@@ -134,7 +136,7 @@ processNtfCmd c (cmd, connIds) = do
             [SMPServer], -- continue work (SMP)
             [NtfServer] -- continue work (Ntf)
           )
-        partitionQueueSubActions = foldr' decideSubWork ([], [], [], [])
+        partitionQueueSubActions = foldr decideSubWork ([], [], [], [])
           where
             -- sub = Nothing, needs to be created
             decideSubWork (rq, Nothing) (ns, rs, css, cns) = (rq : ns, rs, css, cns)
@@ -198,82 +200,167 @@ runNtfWorker c srv Worker {doWork} =
     ExceptT $ agentOperationBracket c AONtfNetwork throwWhenInactive $ runExceptT runNtfOperation
   where
     runNtfOperation :: AM ()
-    runNtfOperation =
-      withWork c doWork (`getNextNtfSubNTFAction` srv) $
-        \nextSub@(NtfSubscription {connId}, _, _) -> do
-          logInfo $ "runNtfWorker, nextSub " <> tshow nextSub
-          ri <- asks $ reconnectInterval . config
-          withRetryInterval ri $ \_ loop -> do
-            liftIO $ waitWhileSuspended c
-            liftIO $ waitForUserNetwork c
-            processSub nextSub
-              `catchAgentError` retryOnError c "NtfWorker" loop (workerInternalError c connId . show)
-    processSub :: (NtfSubscription, NtfSubNTFAction, NtfActionTs) -> AM ()
-    processSub (sub@NtfSubscription {userId, connId, smpServer, ntfSubId}, action, actionTs) = do
-      ts <- liftIO getCurrentTime
-      unlessM (lift $ rescheduleAction doWork ts actionTs) $
-        case action of
-          NSACreate ->
-            lift getNtfToken >>= \case
-              Just tkn@NtfToken {ntfServer, ntfTokenId = Just tknId, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
-                RcvQueue {clientNtfCreds} <- withStore c (`getPrimaryRcvQueue` connId)
-                case clientNtfCreds of
-                  Just ClientNtfCreds {ntfPrivateKey, notifierId} -> do
-                    atomically $ incNtfServerStat c userId ntfServer ntfCreateAttempts
-                    nSubId <- agentNtfCreateSubscription c tknId tkn (SMPQueueNtf smpServer notifierId) ntfPrivateKey
-                    atomically $ incNtfServerStat c userId ntfServer ntfCreated
-                    -- possible improvement: smaller retry until Active, less frequently (daily?) once Active
-                    let actionTs' = addUTCTime 30 ts
-                    withStore' c $ \db ->
-                      updateNtfSubscription db sub {ntfSubId = Just nSubId, ntfSubStatus = NASCreated NSNew} (NSANtf NSACheck) actionTs'
-                  _ -> workerInternalError c connId "NSACreate - no notifier queue credentials"
-              _ -> workerInternalError c connId "NSACreate - no active token"
-          NSACheck ->
-            lift getNtfToken >>= \case
-              Just tkn@NtfToken {ntfServer} ->
-                case ntfSubId of
-                  Just nSubId -> do
-                    atomically $ incNtfServerStat c userId ntfServer ntfCheckAttempts
-                    agentNtfCheckSubscription c nSubId tkn >>= \case
-                      NSAuth -> do
-                        withStore' c $ \db ->
-                          updateNtfSubscription db sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew} (NSASMP NSASmpKey) ts
-                        lift . void $ getNtfSMPWorker True c smpServer
-                      status -> updateSubNextCheck ts status
-                    atomically $ incNtfServerStat c userId ntfServer ntfChecked
-                  Nothing -> workerInternalError c connId "NSACheck - no subscription ID"
-              _ -> workerInternalError c connId "NSACheck - no active token"
-          -- NSADelete and NSARotate are deprecated, but their processing is kept for legacy db records
-          NSADelete ->
-            deleteNtfSub $ do
-              let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
-              withStore' c $ \db -> updateNtfSubscription db sub' (NSASMP NSASmpDelete) ts
-              lift . void $ getNtfSMPWorker True c smpServer
-          NSARotate ->
-            deleteNtfSub $ do
-              withStore' c $ \db -> deleteNtfSubscription db connId
-              ns <- asks ntfSupervisor
-              atomically $ writeTBQueue (ntfSubQ ns) (NSCCreate, [connId]) -- TODO [batch ntf] loop
+    runNtfOperation = do
+      ntfBatchSize <- asks $ ntfBatchSize . config
+      withWorkItems c doWork (\db -> getNextNtfSubNTFActions db srv ntfBatchSize) $ \nextSubs -> do
+        logInfo $ "runNtfWorker - length nextSubs = " <> tshow (length nextSubs)
+        currTs <- liftIO getCurrentTime
+        let (creates, checks, deletes, rotates) = splitActions currTs nextSubs
+        if null creates && null checks && null deletes && null rotates
+          then 
+            let (_, _, firstActionTs) = L.head nextSubs
+             in lift $ rescheduleWork doWork currTs firstActionTs
+          else do
+            retrySubActions c creates createSubs
+            retrySubActions c checks checkSubs
+            retrySubActions c deletes deleteSubs
+            retrySubActions c rotates rotateSubs
+    splitActions :: UTCTime -> NonEmpty (NtfSubNTFAction, NtfSubscription, NtfActionTs) -> ([NtfSubscription], [NtfSubscription], [NtfSubscription], [NtfSubscription])
+    splitActions currTs = foldr addAction ([], [], [], [])
       where
-        -- deleteNtfSub is only used in NSADelete and NSARotate, so also deprecated
-        deleteNtfSub continue = case ntfSubId of
-          Just nSubId ->
-            lift getNtfToken >>= \case
-              Just tkn@NtfToken {ntfServer} -> do
-                atomically $ incNtfServerStat c userId ntfServer ntfDelAttempts
-                tryAgentError (agentNtfDeleteSubscription c nSubId tkn) >>= \case
-                  Left e | temporaryOrHostError e -> throwE e
-                  _ -> continue
+        addAction (cmd, sub, ts) acc@(creates, checks, deletes, rotates) = case cmd of
+          NSACreate -> (sub : creates, checks, deletes, rotates)
+          NSACheck
+            | ts <= currTs -> (creates, sub : checks, deletes, rotates)
+            | otherwise -> acc
+          NSADelete -> (creates, checks, sub : deletes, rotates)
+          NSARotate -> (creates, checks, deletes, sub : rotates)
+    createSubs :: [NtfSubscription] -> AM' [NtfSubscription]
+    createSubs ntfSubs =
+      getNtfToken >>= \case
+        Just tkn@NtfToken {ntfServer, ntfTokenId = Just tknId, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
+          subsRqs_ <- zip ntfSubs <$> withStoreBatch c (\db -> map (getQueue db) ntfSubs)
+          let (errs1, subs_, newSubs_) = splitSubs tknId subsRqs_
+          incStatByUserId ntfServer ntfCreateAttempts subs_
+          case (L.nonEmpty subs_, L.nonEmpty newSubs_) of
+            (Just subs, Just newSubs) -> do
+              rs <- L.zip subs <$> agentNtfCreateSubscriptions c tkn newSubs
+              let (ntfSubs', errs2, nSubIds) = splitResults $ L.toList rs
+                  subs' = map fst nSubIds
+                  errs2' = map (first ntfSubConnId) errs2
+              incStatByUserId ntfServer ntfCreated subs'
+              ts <- liftIO getCurrentTime
+              int <- asks $ ntfSubFirstCheckInterval . config
+              let checkTs = addUTCTime int ts
+              (errs3, _) <- partitionErrs ntfSubConnId subs' <$> withStoreBatch' c (\db -> map (updateSubNSACheck db checkTs) nSubIds)
+              workerErrors c $ errs1 <> errs2' <> errs3
+              pure ntfSubs'
+            _ -> workerErrors c errs1 $> []
+        _ -> do
+          let errs = map (\sub -> (ntfSubConnId sub, INTERNAL "NSACreate - no active token")) ntfSubs
+          workerErrors c errs
+          pure []
+      where
+        getQueue :: DB.Connection -> NtfSubscription -> IO (Either AgentErrorType RcvQueue)
+        getQueue db NtfSubscription {connId} = first storeError <$> getPrimaryRcvQueue db connId
+        splitSubs :: NtfTokenId -> [(NtfSubscription, Either AgentErrorType RcvQueue)] -> ([(ConnId, AgentErrorType)], [NtfSubscription], [NewNtfEntity 'Subscription])
+        splitSubs tknId = foldr splitSub ([], [], [])
+          where
+            splitSub (sub, rq) (errs, subs, newSubs) = case rq of
+              Right RcvQueue {clientNtfCreds = Just creds} -> (errs, sub : subs, toNewSub sub creds : newSubs)
+              Right _ -> ((ntfSubConnId sub, INTERNAL "NSACreate - no notifier queue credentials") : errs, subs, newSubs)
+              Left e -> ((ntfSubConnId sub, e) : errs, subs, newSubs)
+            toNewSub NtfSubscription {smpServer} ClientNtfCreds {ntfPrivateKey, notifierId} =
+              NewNtfSub tknId (SMPQueueNtf smpServer notifierId) ntfPrivateKey
+        updateSubNSACheck :: DB.Connection -> UTCTime -> (NtfSubscription, NtfSubscriptionId) -> IO ()
+        updateSubNSACheck db checkTs (sub, nSubId) = updateNtfSubscription db sub {ntfSubId = Just nSubId, ntfSubStatus = NASCreated NSNew} (NSANtf NSACheck) checkTs
+    checkSubs :: [NtfSubscription] -> AM' [NtfSubscription]
+    checkSubs ntfSubs =
+      getNtfToken >>= \case
+        Just tkn@NtfToken {ntfServer, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
+          let (errs1, subs_, subIds_) = splitSubs ntfSubs
+          incStatByUserId ntfServer ntfCheckAttempts subs_
+          case (L.nonEmpty subs_, L.nonEmpty subIds_) of
+            (Just subs, Just subIds) -> do
+              rs <- L.zip subs <$> agentNtfCheckSubscriptions c tkn subIds
+              let (ntfSubs', errs2, nSubStatuses) = splitResults $ L.toList rs
+                  subs' = map fst nSubStatuses
+                  (errs2', authSubs) = partitionEithers $ map (\case (sub, NTF _ SMP.AUTH) -> Right sub; e -> Left $ first ntfSubConnId e) errs2
+              incStatByUserId ntfServer ntfChecked subs'
+              ts <- liftIO getCurrentTime
+              int <- asks $ ntfSubCheckInterval . config
+              let nextCheckTs = addUTCTime int ts
+              (errs3, srvs) <- partitionErrs ntfSubConnId subs' <$> withStoreBatch' c (\db -> map (updateSub db ntfServer ts nextCheckTs) nSubStatuses)
+              (errs4, srvs') <- partitionErrs ntfSubConnId authSubs <$> withStoreBatch' c (\db -> map (recreateNtfSub db ntfServer ts) authSubs)
+              mapM_ (getNtfSMPWorker True c) $ S.fromList (catMaybes srvs <> srvs')
+              workerErrors c $ errs1 <> errs2' <> errs3 <> errs4
+              pure ntfSubs'
+            _ -> workerErrors c errs1 $> []
+        _ -> do
+          let errs = map (\sub -> (ntfSubConnId sub, INTERNAL "NSACheck - no active token")) ntfSubs
+          workerErrors c errs
+          pure []
+      where
+        splitSubs :: [NtfSubscription] -> ([(ConnId, AgentErrorType)], [NtfSubscription], [NtfSubscriptionId])
+        splitSubs = foldr splitSub ([], [], [])
+          where
+            splitSub sub (errs, subs, subIds) = case sub of
+              NtfSubscription {ntfSubId = Just subId} -> (errs, sub : subs, subId : subIds)
+              _ -> ((ntfSubConnId sub, INTERNAL "NSACheck - no subscription ID") : errs, subs, subIds)
+        updateSub :: DB.Connection -> NtfServer -> UTCTime -> UTCTime -> (NtfSubscription, NtfSubStatus) -> IO (Maybe SMPServer)
+        updateSub db ntfServer ts nextCheckTs (sub, status)
+          | ntfShouldSubscribe status =
+              let sub' = sub {ntfSubStatus = NASCreated status}
+               in Nothing <$ updateNtfSubscription db sub' (NSANtf NSACheck) nextCheckTs
+          -- ntf server stopped subscribing to this queue
+          | otherwise = Just <$> recreateNtfSub db ntfServer ts sub
+        recreateNtfSub :: DB.Connection -> NtfServer -> UTCTime -> NtfSubscription -> IO SMPServer
+        recreateNtfSub db ntfServer ts sub@NtfSubscription {smpServer} =
+          let sub' = sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew}
+           in smpServer <$ updateNtfSubscription db sub' (NSASMP NSASmpKey) ts
+    incStatByUserId :: NtfServer -> (AgentNtfServerStats -> TVar Int) -> [NtfSubscription] -> AM' ()
+    incStatByUserId ntfServer sel ss =
+      forM_ (M.assocs userIdsCounts) $ \(userId, count) ->
+        atomically $ incNtfServerStat' c userId ntfServer sel count
+      where
+        userIdsCounts = foldl' (\acc NtfSubscription {userId} -> M.insertWith (+) userId 1 acc) M.empty ss
+    -- NSADelete and NSARotate are deprecated, but their processing is kept for legacy db records;
+    -- These actions are not batched
+    deleteSubs :: [NtfSubscription] -> AM' [NtfSubscription]
+    deleteSubs ntfSubs = do
+      retrySubs_ <- mapM (runCatching deleteSub) ntfSubs
+      pure $ catMaybes retrySubs_
+      where
+        deleteSub :: NtfSubscription -> AM (Maybe NtfSubscription)
+        deleteSub sub@NtfSubscription {smpServer} =
+          deleteNtfSub sub $ do
+            let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
+            ts <- liftIO getCurrentTime
+            withStore' c $ \db -> updateNtfSubscription db sub' (NSASMP NSASmpDelete) ts
+            lift . void $ getNtfSMPWorker True c smpServer
+    rotateSubs :: [NtfSubscription] -> AM' [NtfSubscription]
+    rotateSubs ntfSubs = do
+      retrySubs_ <- mapM (runCatching rotateSub) ntfSubs
+      pure $ catMaybes retrySubs_
+      where
+        rotateSub :: NtfSubscription -> AM (Maybe NtfSubscription)
+        rotateSub sub@NtfSubscription {connId} =
+          deleteNtfSub sub $ do
+            withStore' c $ \db -> deleteNtfSubscription db connId
+            ns <- asks ntfSupervisor
+            atomically $ writeTBQueue (ntfSubQ ns) (NSCCreate, [connId])
+    runCatching :: (NtfSubscription -> AM (Maybe NtfSubscription)) -> NtfSubscription -> AM' (Maybe NtfSubscription)
+    runCatching action sub@NtfSubscription {connId} =
+      fromRight Nothing
+        <$> runExceptT (action sub `catchAgentError` \e -> workerInternalError c connId (show e) $> Nothing)
+    -- deleteNtfSub is only used in NSADelete and NSARotate, so also deprecated
+    deleteNtfSub :: NtfSubscription -> AM () -> AM (Maybe NtfSubscription)
+    deleteNtfSub sub@NtfSubscription {userId, ntfSubId} continue = case ntfSubId of
+      Just nSubId ->
+        lift getNtfToken >>= \case
+          Just tkn@NtfToken {ntfServer} -> do
+            atomically $ incNtfServerStat c userId ntfServer ntfDelAttempts
+            tryAgentError (agentNtfDeleteSubscription c nSubId tkn) >>= \case
+              Right _ -> do
                 atomically $ incNtfServerStat c userId ntfServer ntfDeleted
-              Nothing -> continue
-          _ -> continue
-        updateSubNextCheck ts toStatus = do
-          checkInterval <- asks $ ntfSubCheckInterval . config
-          let nextCheckTs = addUTCTime checkInterval ts
-          updateSub (NASCreated toStatus) (NSANtf NSACheck) nextCheckTs
-        updateSub toStatus toAction actionTs' =
-          withStore' c $ \db ->
-            updateNtfSubscription db sub {ntfSubStatus = toStatus} toAction actionTs'
+                continue'
+              Left e
+                | temporaryOrHostError e -> pure $ Just sub -- don't continue, retry
+                | otherwise -> continue'
+          Nothing -> continue'
+      _ -> continue'
+      where
+        continue' = continue $> Nothing -- continue without retry
 
 runNtfSMPWorker :: AgentClient -> SMPServer -> Worker -> AM ()
 runNtfSMPWorker c srv Worker {doWork} = forever $ do
@@ -286,26 +373,14 @@ runNtfSMPWorker c srv Worker {doWork} = forever $ do
       withWorkItems c doWork (\db -> getNextNtfSubSMPActions db srv ntfBatchSize) $ \nextSubs -> do
         logInfo $ "runNtfSMPWorker - length nextSubs = " <> tshow (length nextSubs)
         let (creates, deletes) = splitActions nextSubs
-        retrySubActions creates createNotifierKeys
-        retrySubActions deletes deleteNotifierKeys
+        retrySubActions c creates createNotifierKeys
+        retrySubActions c deletes deleteNotifierKeys
     splitActions :: NonEmpty (NtfSubSMPAction, NtfSubscription) -> ([NtfSubscription], [NtfSubscription])
     splitActions = foldr addAction ([], [])
       where
-        addAction action (creates, deletes) = case action of
-          (NSASmpKey, sub) -> (sub : creates, deletes)
-          (NSASmpDelete, sub) -> (creates, sub : deletes)
-    retrySubActions :: [NtfSubscription] -> ([NtfSubscription] -> AM' [NtfSubscription]) -> AM ()
-    retrySubActions subs action = do
-      v <- newTVarIO subs
-      ri <- asks $ reconnectInterval . config
-      withRetryInterval ri $ \_ loop -> do
-        liftIO $ waitWhileSuspended c
-        liftIO $ waitForUserNetwork c
-        subs' <- readTVarIO v
-        retrySubs <- lift $ action subs'
-        unless (null retrySubs) $ do
-          atomically $ writeTVar v retrySubs
-          retryNetworkLoop c loop
+        addAction (cmd, sub) (creates, deletes) = case cmd of
+          NSASmpKey -> (sub : creates, deletes)
+          NSASmpDelete -> (creates, sub : deletes)
     createNotifierKeys :: [NtfSubscription] -> AM' [NtfSubscription]
     createNotifierKeys ntfSubs =
       getNtfToken >>= \case
@@ -363,32 +438,37 @@ runNtfSMPWorker c srv Worker {doWork} = forever $ do
           pure (sub, rq)
         deleteSub :: DB.Connection -> RcvQueue -> IO ()
         deleteSub db rq = deleteNtfSubscription db (qConnId rq)
-    --                                                (temporary errs, other errs, successes)
-    splitResults :: [(a, Either AgentErrorType r)] -> ([a], [(a, AgentErrorType)], [(a, r)])
-    splitResults = foldr' addRes ([], [], [])
-      where
-        addRes (a, r_) (as, errs, rs) = case r_ of
-          Right r -> (as, errs, (a, r) : rs)
-          Left e
-            | temporaryOrHostError e -> (a : as, errs, rs)
-            | otherwise -> (as, (a, e) : errs, rs)
 
-rescheduleAction :: TMVar () -> UTCTime -> UTCTime -> AM' Bool
-rescheduleAction doWork ts actionTs
-  | actionTs <= ts = pure False
-  | otherwise = do
-      void . atomically $ tryTakeTMVar doWork
-      void . forkIO $ do
-        liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime actionTs ts
-        atomically $ hasWorkToDo' doWork
-      pure True
+retrySubActions :: AgentClient -> [NtfSubscription] -> ([NtfSubscription] -> AM' [NtfSubscription]) -> AM ()
+retrySubActions _ [] _ = pure ()
+retrySubActions c subs action = do
+  v <- newTVarIO subs
+  ri <- asks $ reconnectInterval . config
+  withRetryInterval ri $ \_ loop -> do
+    liftIO $ waitWhileSuspended c
+    liftIO $ waitForUserNetwork c
+    subs' <- readTVarIO v
+    retrySubs <- lift $ action subs'
+    unless (null retrySubs) $ do
+      atomically $ writeTVar v retrySubs
+      retryNetworkLoop c loop
 
-retryOnError :: AgentClient -> Text -> AM () -> (AgentErrorType -> AM ()) -> AgentErrorType -> AM ()
-retryOnError c name loop done e = do
-  logError $ name <> " error: " <> tshow e
-  if temporaryOrHostError e
-    then retryNetworkLoop c loop
-    else done e
+--                                                (temporary errs, other errs, successes)
+splitResults :: [(a, Either AgentErrorType r)] -> ([a], [(a, AgentErrorType)], [(a, r)])
+splitResults = foldr addRes ([], [], [])
+  where
+    addRes (a, r_) (as, errs, rs) = case r_ of
+      Right r -> (as, errs, (a, r) : rs)
+      Left e
+        | temporaryOrHostError e -> (a : as, errs, rs)
+        | otherwise -> (as, (a, e) : errs, rs)
+
+rescheduleWork :: TMVar () -> UTCTime -> UTCTime -> AM' ()
+rescheduleWork doWork ts actionTs = do
+  void . atomically $ tryTakeTMVar doWork
+  void . forkIO $ do
+    liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime actionTs ts
+    atomically $ hasWorkToDo' doWork
 
 retryNetworkLoop :: AgentClient -> AM () -> AM ()
 retryNetworkLoop c loop = do
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 701e03af4..f86d45c20 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -160,7 +160,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     setNullNtfSubscriptionAction,
     deleteNtfSubscription,
     deleteNtfSubscription',
-    getNextNtfSubNTFAction,
+    getNextNtfSubNTFActions,
     markNtfSubActionNtfFailed_, -- exported for tests
     getNextNtfSubSMPActions,
     markNtfSubActionSMPFailed_, -- exported for tests
@@ -1627,14 +1627,14 @@ deleteNtfSubscription' :: DB.Connection -> ConnId -> IO ()
 deleteNtfSubscription' db connId = do
   DB.execute db "DELETE FROM ntf_subscriptions WHERE conn_id = ?" (Only connId)
 
-getNextNtfSubNTFAction :: DB.Connection -> NtfServer -> IO (Either StoreError (Maybe (NtfSubscription, NtfSubNTFAction, NtfActionTs)))
-getNextNtfSubNTFAction db ntfServer@(NtfServer ntfHost ntfPort _) =
-  getWorkItem "ntf NTF" getNtfConnId getNtfSubAction (markNtfSubActionNtfFailed_ db)
+getNextNtfSubNTFActions :: DB.Connection -> NtfServer -> Int -> IO (Either StoreError [Either StoreError (NtfSubNTFAction, NtfSubscription, NtfActionTs)])
+getNextNtfSubNTFActions db ntfServer@(NtfServer ntfHost ntfPort _) ntfBatchSize =
+  getWorkItems "ntf NTF" getNtfConnIds getNtfSubAction (markNtfSubActionNtfFailed_ db)
   where
-    getNtfConnId :: IO (Maybe ConnId)
-    getNtfConnId =
-      maybeFirstRow fromOnly $
-        DB.query
+    getNtfConnIds :: IO [ConnId]
+    getNtfConnIds =
+      map fromOnly
+        <$> DB.query
           db
           [sql|
             SELECT conn_id
@@ -1642,10 +1642,10 @@ getNextNtfSubNTFAction db ntfServer@(NtfServer ntfHost ntfPort _) =
             WHERE ntf_host = ? AND ntf_port = ? AND ntf_sub_action IS NOT NULL
               AND (ntf_failed = 0 OR updated_by_supervisor = 1)
             ORDER BY ntf_sub_action_ts ASC
-            LIMIT 1
+            LIMIT ?
           |]
-          (ntfHost, ntfPort)
-    getNtfSubAction :: ConnId -> IO (Either StoreError (NtfSubscription, NtfSubNTFAction, NtfActionTs))
+          (ntfHost, ntfPort, ntfBatchSize)
+    getNtfSubAction :: ConnId -> IO (Either StoreError (NtfSubNTFAction, NtfSubscription, NtfActionTs))
     getNtfSubAction connId = do
       markUpdatedByWorker db connId
       firstRow ntfSubAction err $
@@ -1665,7 +1665,7 @@ getNextNtfSubNTFAction db ntfServer@(NtfServer ntfHost ntfPort _) =
         ntfSubAction (userId, smpHost, smpPort, smpKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
           let smpServer = SMPServer smpHost smpPort smpKeyHash
               ntfSubscription = NtfSubscription {userId, connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
-           in (ntfSubscription, action, actionTs)
+           in (action, ntfSubscription, actionTs)
 
 markNtfSubActionNtfFailed_ :: DB.Connection -> ConnId -> IO ()
 markNtfSubActionNtfFailed_ db connId =
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 461bb9ee8..54a53e3c5 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -63,11 +63,13 @@ module Simplex.Messaging.Client
     forwardSMPTransmission,
     getSMPQueueInfo,
     sendProtocolCommand,
+    sendProtocolCommands,
 
     -- * Supporting types and client configuration
     ProtocolClientError (..),
     SMPClientError,
     ProxyClientError (..),
+    Response (..),
     unexpectedResponse,
     ProtocolClientConfig (..),
     NetworkConfig (..),
diff --git a/src/Simplex/Messaging/Notifications/Client.hs b/src/Simplex/Messaging/Notifications/Client.hs
index f2c07741f..ba90b1530 100644
--- a/src/Simplex/Messaging/Notifications/Client.hs
+++ b/src/Simplex/Messaging/Notifications/Client.hs
@@ -8,6 +8,8 @@ module Simplex.Messaging.Notifications.Client where
 
 import Control.Monad.Except
 import Control.Monad.Trans.Except
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import Data.Word (Word16)
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
@@ -56,12 +58,30 @@ ntfCreateSubscription c pKey newSub =
     NRSubId subId -> pure subId
     r -> throwE $ unexpectedResponse r
 
+ntfCreateSubscriptions :: NtfClient -> C.APrivateAuthKey -> NonEmpty (NewNtfEntity 'Subscription) -> IO (NonEmpty (Either NtfClientError NtfSubscriptionId))
+ntfCreateSubscriptions c pKey newSubs = L.map process <$> sendProtocolCommands c cs
+  where
+    cs = L.map (\newSub -> (Just pKey, NoEntity, NtfCmd SSubscription $ SNEW newSub)) newSubs
+    process (Response _ r) = case r of
+      Right (NRSubId subId) -> Right subId
+      Right r' -> Left $ unexpectedResponse r'
+      Left e -> Left e
+
 ntfCheckSubscription :: NtfClient -> C.APrivateAuthKey -> NtfSubscriptionId -> ExceptT NtfClientError IO NtfSubStatus
 ntfCheckSubscription c pKey subId =
   sendNtfCommand c (Just pKey) subId SCHK >>= \case
     NRSub stat -> pure stat
     r -> throwE $ unexpectedResponse r
 
+ntfCheckSubscriptions :: NtfClient -> C.APrivateAuthKey -> NonEmpty NtfSubscriptionId -> IO (NonEmpty (Either NtfClientError NtfSubStatus))
+ntfCheckSubscriptions c pKey subIds = L.map process <$> sendProtocolCommands c cs
+  where
+    cs = L.map (\subId -> (Just pKey, subId, NtfCmd SSubscription SCHK)) subIds
+    process (Response _ r) = case r of
+      Right (NRSub stat) -> Right stat
+      Right r' -> Left $ unexpectedResponse r'
+      Left e -> Left e
+
 ntfDeleteSubscription :: NtfClient -> C.APrivateAuthKey -> NtfSubscriptionId -> ExceptT NtfClientError IO ()
 ntfDeleteSubscription = okNtfCommand SDEL
 
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index acc7d57c6..42c24aeb8 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -19,6 +19,7 @@ import Control.Monad.Except
 import Control.Monad.Reader
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Either (partitionEithers)
 import Data.Functor (($>))
 import Data.IORef
 import Data.Int (Int64)
@@ -353,28 +354,29 @@ clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connecte
 
 receive :: Transport c => THandleNTF c 'TServer -> NtfServerClient -> M ()
 receive th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
-  ts <- liftIO $ tGet th
-  forM_ ts $ \t@(_, _, (corrId, entId, cmdOrError)) -> do
-    atomically . writeTVar rcvActiveAt =<< liftIO getSystemTime
-    logDebug "received transmission"
-    case cmdOrError of
-      Left e -> write sndQ (corrId, entId, NRErr e)
-      Right cmd ->
-        verifyNtfTransmission ((,C.cbNonce (SMP.bs corrId)) <$> thAuth) t cmd >>= \case
-          VRVerified req -> write rcvQ req
-          VRFailed -> write sndQ (corrId, entId, NRErr AUTH)
+  ts <- L.toList <$> liftIO (tGet th)
+  atomically . (writeTVar rcvActiveAt $!) =<< liftIO getSystemTime
+  (errs, cmds) <- partitionEithers <$> mapM cmdAction ts
+  write sndQ errs
+  write rcvQ cmds
   where
-    write q t = atomically $ writeTBQueue q t
+    cmdAction t@(_, _, (corrId, entId, cmdOrError)) =
+      case cmdOrError of
+        Left e -> pure $ Left (corrId, entId, NRErr e)
+        Right cmd ->
+          verified <$> verifyNtfTransmission ((,C.cbNonce (SMP.bs corrId)) <$> thAuth) t cmd
+          where
+            verified = \case
+              VRVerified req -> Right req
+              VRFailed -> Left (corrId, entId, NRErr AUTH)
+    write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
 
 send :: Transport c => THandleNTF c 'TServer -> NtfServerClient -> IO ()
 send h@THandle {params} NtfServerClient {sndQ, sndActiveAt} = forever $ do
-  t <- atomically $ readTBQueue sndQ
-  void . liftIO $ tPut h [Right (Nothing, encodeTransmission params t)]
+  ts <- atomically $ readTBQueue sndQ
+  void . liftIO $ tPut h $ L.map (\t -> Right (Nothing, encodeTransmission params t)) ts
   atomically . (writeTVar sndActiveAt $!) =<< liftIO getSystemTime
 
--- instance Show a => Show (TVar a) where
---   show x = unsafePerformIO $ show <$> readTVarIO x
-
 data VerificationResult = VRVerified NtfRequest | VRFailed
 
 verifyNtfTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> SignedTransmission ErrorType NtfCmd -> NtfCmd -> M VerificationResult
@@ -432,7 +434,7 @@ client :: NtfServerClient -> NtfSubscriber -> NtfPushServer -> M ()
 client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPushServer {pushQ, intervalNotifiers} =
   forever $
     atomically (readTBQueue rcvQ)
-      >>= processCommand
+      >>= mapM processCommand
       >>= atomically . writeTBQueue sndQ
   where
     processCommand :: NtfRequest -> M (Transmission NtfResponse)
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index c1e0981dc..8fd2a33ad 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -155,8 +155,8 @@ data NtfRequest
   | NtfReqPing CorrId NtfEntityId
 
 data NtfServerClient = NtfServerClient
-  { rcvQ :: TBQueue NtfRequest,
-    sndQ :: TBQueue (Transmission NtfResponse),
+  { rcvQ :: TBQueue (NonEmpty NtfRequest),
+    sndQ :: TBQueue (NonEmpty (Transmission NtfResponse)),
     ntfThParams :: THandleParams NTFVersion 'TServer,
     connected :: TVar Bool,
     rcvActiveAt :: TVar SystemTime,

From a9576935cf1967082f6d7997cce3cd6a634c4ef7 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 29 Sep 2024 18:54:04 +0100
Subject: [PATCH 132/195] 6.1.0.2

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index ce1c8efd4..3a6816e32 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.1.0.1
+version: 6.1.0.2
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 51da92aef..a39694074 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.1.0.1
+version:        6.1.0.2
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From e808825c95fd4d306700a9044a3dbeb5fcc0a307 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Mon, 30 Sep 2024 18:29:14 +0400
Subject: [PATCH 133/195] ntf: fix endless worker loop (#1345)

---
 src/Simplex/Messaging/Agent/Client.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 49198c65e..d2a2554fe 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1868,6 +1868,7 @@ withWork c doWork getWork action =
 withWorkItems :: AgentClient -> TMVar () -> (DB.Connection -> IO (Either StoreError [Either StoreError a])) -> (NonEmpty a -> AM ()) -> AM ()
 withWorkItems c doWork getWork action = do
   withStore' c getWork >>= \case
+    Right [] -> noWork
     Right rs -> do
       let (errs, items) = partitionEithers rs
       case L.nonEmpty items of

From da79d544cf990fb0638ae5434407d6a30724fb87 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 30 Sep 2024 18:27:14 +0100
Subject: [PATCH 134/195] 6.1.0.3

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index 3a6816e32..71340de64 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.1.0.2
+version: 6.1.0.3
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index a39694074..0ab658351 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.1.0.2
+version:        6.1.0.3
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 243548631a8037ba02b54503910dc209353c03f7 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 1 Oct 2024 16:30:14 +0400
Subject: [PATCH 135/195] ntf: repeat failed token deletions (#1346)

---
 simplexmq.cabal                               |  1 +
 src/Simplex/Messaging/Agent.hs                | 25 ++-----
 src/Simplex/Messaging/Agent/Client.hs         |  4 +-
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |  6 +-
 .../Messaging/Agent/NtfSubSupervisor.hs       | 56 ++++++++++++++-
 src/Simplex/Messaging/Agent/Store/SQLite.hs   | 71 +++++++++++++++++++
 .../Agent/Store/SQLite/Migrations.hs          |  4 +-
 .../M20240930_ntf_tokens_to_delete.hs         | 27 +++++++
 .../Store/SQLite/Migrations/agent_schema.sql  | 10 +++
 tests/AgentTests/SQLiteTests.hs               |  6 ++
 10 files changed, 183 insertions(+), 27 deletions(-)
 create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240930_ntf_tokens_to_delete.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 0ab658351..6510e1d61 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -135,6 +135,7 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
       Simplex.Messaging.Agent.TRcvQueues
       Simplex.Messaging.Client
       Simplex.Messaging.Client.Agent
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 3f375420e..5ca1b4be1 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1906,12 +1906,8 @@ registerNtfToken' c suppliedDeviceToken suppliedNtfMode =
               -- possible improvement: get updated token status from the server, or maybe TCRON could return the current status
               pure ntfTknStatus
           | otherwise -> replaceToken tknId
-        (Just tknId, Just NTADelete) -> do
-          agentNtfDeleteToken c tknId tkn
-          withStore' c (`removeNtfToken` tkn)
-          ns <- asks ntfSupervisor
-          atomically $ nsRemoveNtfToken ns
-          pure NTExpired
+        -- deprecated
+        (Just _tknId, Just NTADelete) -> deleteToken c tkn $> NTExpired
         _ -> pure ntfTknStatus
       withStore' c $ \db -> updateNtfMode db tkn suppliedNtfMode
       pure status
@@ -1985,7 +1981,7 @@ deleteNtfToken' c deviceToken =
   withStore' c getSavedNtfToken >>= \case
     Just tkn@NtfToken {deviceToken = savedDeviceToken} -> do
       when (deviceToken /= savedDeviceToken) $ logWarn "deleteNtfToken: different token"
-      deleteToken_ c tkn
+      deleteToken c tkn
       deleteNtfSubs c NSCSmpDelete
     _ -> throwE $ CMD PROHIBITED "deleteNtfToken: no token"
 
@@ -2020,20 +2016,6 @@ toggleConnectionNtfs' c connId enable = do
           let cmd = if enable then NSCCreate else NSCSmpDelete
           atomically $ sendNtfSubCommand ns (cmd, [connId])
 
-deleteToken_ :: AgentClient -> NtfToken -> AM ()
-deleteToken_ c@AgentClient {subQ} tkn@NtfToken {ntfTokenId, ntfTknStatus} = do
-  ns <- asks ntfSupervisor
-  forM_ ntfTokenId $ \tknId -> do
-    let ntfTknAction = Just NTADelete
-    withStore' c $ \db -> updateNtfToken db tkn ntfTknStatus ntfTknAction
-    atomically $ nsUpdateToken ns tkn {ntfTknStatus, ntfTknAction}
-    agentNtfDeleteToken c tknId tkn `catchAgentError` \e -> notify (ERR e) -- TODO cleanup task
-  withStore' c $ \db -> removeNtfToken db tkn
-  atomically $ nsRemoveNtfToken ns
-  where
-    notify :: forall e. AEntityI e => AEvent e -> AM ()
-    notify cmd = atomically $ writeTBQueue subQ ("", "", AEvt (sAEntity @e) cmd)
-
 withToken :: AgentClient -> NtfToken -> Maybe (NtfTknStatus, NtfTknAction) -> (NtfTknStatus, Maybe NtfTknAction) -> AM a -> AM NtfTknStatus
 withToken c tkn@NtfToken {deviceToken, ntfMode} from_ (toStatus, toAction_) f = do
   ns <- asks ntfSupervisor
@@ -2164,6 +2146,7 @@ cleanupManager c@AgentClient {subQ} = do
     run ERR $ withStore' c (`deleteRcvMsgHashesExpired` ttl)
     run ERR $ withStore' c (`deleteSndMsgsExpired` ttl)
     run ERR $ withStore' c (`deleteRatchetKeyHashesExpired` ttl)
+    run ERR $ withStore' c (`deleteExpiredNtfTokensToDelete` ttl)
     run RFERR deleteRcvFilesExpired
     run RFERR deleteRcvFilesDeleted
     run RFERR deleteRcvFilesTmpPaths
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index d2a2554fe..c2a3cab57 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1721,8 +1721,8 @@ agentNtfReplaceToken :: AgentClient -> NtfTokenId -> NtfToken -> DeviceToken ->
 agentNtfReplaceToken c tknId NtfToken {ntfServer, ntfPrivKey} token =
   withNtfClient c ntfServer tknId "TRPL" $ \ntf -> ntfReplaceToken ntf ntfPrivKey tknId token
 
-agentNtfDeleteToken :: AgentClient -> NtfTokenId -> NtfToken -> AM ()
-agentNtfDeleteToken c tknId NtfToken {ntfServer, ntfPrivKey} =
+agentNtfDeleteToken :: AgentClient -> NtfServer -> C.APrivateAuthKey -> NtfTokenId -> AM ()
+agentNtfDeleteToken c ntfServer ntfPrivKey tknId =
   withNtfClient c ntfServer tknId "TDEL" $ \ntf -> ntfDeleteToken ntf ntfPrivKey tknId
 
 agentNtfEnableCron :: AgentClient -> NtfTokenId -> NtfToken -> Word16 -> AM ()
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 1af330f41..069470f0b 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -259,7 +259,8 @@ data NtfSupervisor = NtfSupervisor
   { ntfTkn :: TVar (Maybe NtfToken),
     ntfSubQ :: TBQueue (NtfSupervisorCommand, NonEmpty ConnId),
     ntfWorkers :: TMap NtfServer Worker,
-    ntfSMPWorkers :: TMap SMPServer Worker
+    ntfSMPWorkers :: TMap SMPServer Worker,
+    ntfTknDelWorkers :: TMap NtfServer Worker
   }
 
 data NtfSupervisorCommand = NSCCreate | NSCSmpDelete | NSCDeleteSub
@@ -271,7 +272,8 @@ newNtfSubSupervisor qSize = do
   ntfSubQ <- newTBQueueIO qSize
   ntfWorkers <- TM.emptyIO
   ntfSMPWorkers <- TM.emptyIO
-  pure NtfSupervisor {ntfTkn, ntfSubQ, ntfWorkers, ntfSMPWorkers}
+  ntfTknDelWorkers <- TM.emptyIO
+  pure NtfSupervisor {ntfTkn, ntfSubQ, ntfWorkers, ntfSMPWorkers, ntfTknDelWorkers}
 
 data XFTPAgent = XFTPAgent
   { -- if set, XFTP file paths will be considered as relative to this directory
diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
index ff728eac3..f000de8be 100644
--- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
+++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs
@@ -15,6 +15,7 @@ module Simplex.Messaging.Agent.NtfSubSupervisor
     nsRemoveNtfToken,
     sendNtfSubCommand,
     instantNotifications,
+    deleteToken,
     closeNtfSupervisor,
     getNtfServer,
   )
@@ -58,6 +59,9 @@ import qualified UnliftIO.Exception as E
 runNtfSupervisor :: AgentClient -> AM' ()
 runNtfSupervisor c = do
   ns <- asks ntfSupervisor
+  runExceptT startTknDelete >>= \case
+    Left e -> notifyErr e
+    Right _ -> pure ()
   forever $ do
     cmd <- atomically . readTBQueue $ ntfSubQ ns
     handleErr . agentOperationBracket c AONtfNetwork waitUntilActive $
@@ -65,6 +69,10 @@ runNtfSupervisor c = do
         Left e -> notifyErr e
         Right _ -> return ()
   where
+    startTknDelete :: AM ()
+    startTknDelete = do
+      pendingDelServers <- withStore' c getPendingDelTknServers
+      lift . forM_ pendingDelServers $ getNtfTknDelWorker True c
     handleErr :: AM' () -> AM' ()
     handleErr = E.handle $ \(e :: E.SomeException) -> do
       logError $ "runNtfSupervisor error " <> tshow e
@@ -190,6 +198,11 @@ getNtfSMPWorker hasWork c server = do
   ws <- asks $ ntfSMPWorkers . ntfSupervisor
   getAgentWorker "ntf_smp" hasWork c server ws $ runNtfSMPWorker c server
 
+getNtfTknDelWorker :: Bool -> AgentClient -> NtfServer -> AM' Worker
+getNtfTknDelWorker hasWork c server = do
+  ws <- asks $ ntfTknDelWorkers . ntfSupervisor
+  getAgentWorker "ntf_tkn_del" hasWork c server ws $ runNtfTknDelWorker c server
+
 withTokenServer :: (NtfServer -> AM ()) -> AM ()
 withTokenServer action = lift getNtfToken >>= mapM_ (\NtfToken {ntfServer} -> action ntfServer)
 
@@ -207,7 +220,7 @@ runNtfWorker c srv Worker {doWork} =
         currTs <- liftIO getCurrentTime
         let (creates, checks, deletes, rotates) = splitActions currTs nextSubs
         if null creates && null checks && null deletes && null rotates
-          then 
+          then
             let (_, _, firstActionTs) = L.head nextSubs
              in lift $ rescheduleWork doWork currTs firstActionTs
           else do
@@ -522,10 +535,51 @@ instantNotifications = \case
   Just NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} -> True
   _ -> False
 
+deleteToken :: AgentClient -> NtfToken -> AM ()
+deleteToken c tkn@NtfToken {ntfServer, ntfTokenId, ntfPrivKey} = do
+  setToDelete <- withStore' c $ \db -> do
+    removeNtfToken db tkn
+    case ntfTokenId of
+      Just tknId -> addNtfTokenToDelete db ntfServer ntfPrivKey tknId $> True
+      Nothing -> pure False
+  ns <- asks ntfSupervisor
+  atomically $ nsRemoveNtfToken ns
+  when setToDelete $ void $ lift $ getNtfTknDelWorker True c ntfServer
+
+runNtfTknDelWorker :: AgentClient -> NtfServer -> Worker -> AM ()
+runNtfTknDelWorker c srv Worker {doWork} =
+  forever $ do
+    waitForWork doWork
+    ExceptT $ agentOperationBracket c AONtfNetwork throwWhenInactive $ runExceptT runNtfOperation
+  where
+    runNtfOperation :: AM ()
+    runNtfOperation =
+      withWork c doWork (`getNextNtfTokenToDelete` srv) $
+        \nextTknToDelete -> do
+          logInfo $ "runNtfTknDelWorker, nextTknToDelete " <> tshow nextTknToDelete
+          ri <- asks $ reconnectInterval . config
+          withRetryInterval ri $ \_ loop -> do
+            liftIO $ waitWhileSuspended c
+            liftIO $ waitForUserNetwork c
+            processTknToDelete nextTknToDelete `catchAgentError` retryTmpError loop nextTknToDelete
+    retryTmpError :: AM () -> NtfTokenToDelete -> AgentErrorType -> AM ()
+    retryTmpError loop (tknDbId, _, _) e = do
+      logError $ "ntf tkn del error: " <> tshow e
+      if temporaryOrHostError e
+        then retryNetworkLoop c loop
+        else do
+          withStore' c $ \db -> deleteNtfTokenToDelete db tknDbId
+          notifyInternalError' c (show e)
+    processTknToDelete :: NtfTokenToDelete -> AM ()
+    processTknToDelete (tknDbId, ntfPrivKey, tknId) = do
+      agentNtfDeleteToken c srv ntfPrivKey tknId
+      withStore' c $ \db -> deleteNtfTokenToDelete db tknDbId
+
 closeNtfSupervisor :: NtfSupervisor -> IO ()
 closeNtfSupervisor ns = do
   stopWorkers $ ntfWorkers ns
   stopWorkers $ ntfSMPWorkers ns
+  stopWorkers $ ntfTknDelWorkers ns
   where
     stopWorkers workers = atomically (swapTVar workers M.empty) >>= mapM_ (liftIO . cancelWorker)
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index f86d45c20..76e8a79f6 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -150,6 +150,13 @@ module Simplex.Messaging.Agent.Store.SQLite
     updateNtfMode,
     updateNtfToken,
     removeNtfToken,
+    addNtfTokenToDelete,
+    deleteExpiredNtfTokensToDelete,
+    NtfTokenToDelete,
+    getNextNtfTokenToDelete,
+    markNtfTokenToDeleteFailed_, -- exported for tests
+    getPendingDelTknServers,
+    deleteNtfTokenToDelete,
     -- Notification subscription persistence
     NtfSupervisorSub,
     getNtfSubscription,
@@ -1486,6 +1493,70 @@ removeNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer
     |]
     (provider, token, host, port)
 
+addNtfTokenToDelete :: DB.Connection -> NtfServer -> C.APrivateAuthKey -> NtfTokenId -> IO ()
+addNtfTokenToDelete db ProtocolServer {host, port, keyHash} ntfPrivKey tknId =
+  DB.execute db "INSERT INTO ntf_tokens_to_delete (ntf_host, ntf_port, ntf_key_hash, tkn_id, tkn_priv_key) VALUES (?,?,?,?,?)" (host, port, keyHash, tknId, ntfPrivKey)
+
+deleteExpiredNtfTokensToDelete :: DB.Connection -> NominalDiffTime -> IO ()
+deleteExpiredNtfTokensToDelete db ttl = do
+  cutoffTs <- addUTCTime (-ttl) <$> getCurrentTime
+  DB.execute db "DELETE FROM ntf_tokens_to_delete WHERE created_at < ?" (Only cutoffTs)
+
+type NtfTokenToDelete = (Int64, C.APrivateAuthKey, NtfTokenId)
+
+getNextNtfTokenToDelete :: DB.Connection -> NtfServer -> IO (Either StoreError (Maybe NtfTokenToDelete))
+getNextNtfTokenToDelete db (NtfServer ntfHost ntfPort _) =
+  getWorkItem "ntf tkn del" getNtfTknDbId getNtfTknToDelete (markNtfTokenToDeleteFailed_ db)
+  where
+    getNtfTknDbId :: IO (Maybe Int64)
+    getNtfTknDbId =
+      maybeFirstRow fromOnly $
+        DB.query
+          db
+          [sql|
+            SELECT ntf_token_to_delete_id
+            FROM ntf_tokens_to_delete
+            WHERE ntf_host = ? AND ntf_port = ?
+              AND del_failed = 0
+            ORDER BY created_at ASC
+            LIMIT 1
+          |]
+          (ntfHost, ntfPort)
+    getNtfTknToDelete :: Int64 -> IO (Either StoreError NtfTokenToDelete)
+    getNtfTknToDelete tknDbId =
+      firstRow ntfTokenToDelete err $
+        DB.query
+          db
+          [sql|
+            SELECT tkn_priv_key, tkn_id
+            FROM ntf_tokens_to_delete
+            WHERE ntf_token_to_delete_id = ?
+          |]
+          (Only tknDbId)
+      where
+        err = SEInternal $ "ntf token to delete " <> bshow tknDbId <> " returned []"
+        ntfTokenToDelete (tknPrivKey, tknId) = (tknDbId, tknPrivKey, tknId)
+
+markNtfTokenToDeleteFailed_ :: DB.Connection -> Int64 -> IO ()
+markNtfTokenToDeleteFailed_ db tknDbId =
+  DB.execute db "UPDATE ntf_tokens_to_delete SET del_failed = 1 where ntf_token_to_delete_id = ?" (Only tknDbId)
+
+getPendingDelTknServers :: DB.Connection -> IO [NtfServer]
+getPendingDelTknServers db =
+  map toNtfServer
+    <$> DB.query_
+      db
+      [sql|
+        SELECT DISTINCT ntf_host, ntf_port, ntf_key_hash
+        FROM ntf_tokens_to_delete
+      |]
+  where
+    toNtfServer (host, port, keyHash) = NtfServer host port keyHash
+
+deleteNtfTokenToDelete :: DB.Connection -> Int64 -> IO ()
+deleteNtfTokenToDelete db tknDbId =
+  DB.execute db "DELETE FROM ntf_tokens_to_delete WHERE ntf_token_to_delete_id = ?" (Only tknDbId)
+
 type NtfSupervisorSub = (NtfSubscription, Maybe (NtfSubAction, NtfActionTs))
 
 getNtfSubscription :: DB.Connection -> ConnId -> IO (Maybe NtfSupervisorSub)
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
index 8e17d9af6..97cc08b68 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
@@ -74,6 +74,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -116,7 +117,8 @@ schemaMigrations =
     ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
     ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
     ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
-    ("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats)
+    ("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats),
+    ("m20240930_ntf_tokens_to_delete", m20240930_ntf_tokens_to_delete, Just down_m20240930_ntf_tokens_to_delete)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240930_ntf_tokens_to_delete.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240930_ntf_tokens_to_delete.hs
new file mode 100644
index 000000000..53c421cc2
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240930_ntf_tokens_to_delete.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20240930_ntf_tokens_to_delete :: Query
+m20240930_ntf_tokens_to_delete =
+    [sql|
+CREATE TABLE ntf_tokens_to_delete (
+  ntf_token_to_delete_id INTEGER PRIMARY KEY,
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  ntf_key_hash BLOB NOT NULL,
+  tkn_id BLOB NOT NULL, -- token ID assigned by notifications server
+  tkn_priv_key BLOB NOT NULL, -- client's private key to sign token commands,
+  del_failed INTEGER DEFAULT 0,
+  created_at TEXT NOT NULL DEFAULT (datetime('now'))
+);
+|]
+
+down_m20240930_ntf_tokens_to_delete :: Query
+down_m20240930_ntf_tokens_to_delete =
+    [sql|
+DROP TABLE ntf_tokens_to_delete;
+|]
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
index 80af08989..c7e458862 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
@@ -403,6 +403,16 @@ CREATE TABLE servers_stats(
   created_at TEXT NOT NULL DEFAULT(datetime('now')),
   updated_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
+CREATE TABLE ntf_tokens_to_delete(
+  ntf_token_to_delete_id INTEGER PRIMARY KEY,
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  ntf_key_hash BLOB NOT NULL,
+  tkn_id BLOB NOT NULL, -- token ID assigned by notifications server
+  tkn_priv_key BLOB NOT NULL, -- client's private key to sign token commands,
+del_failed INTEGER DEFAULT 0,
+created_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);
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index 22023cc96..fedb7cdb6 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -141,6 +141,7 @@ storeTests = do
         it "should getNextDeletedSndChunkReplica" testGetNextDeletedSndChunkReplica
         it "should markNtfSubActionNtfFailed_" testMarkNtfSubActionNtfFailed
         it "should markNtfSubActionSMPFailed_" testMarkNtfSubActionSMPFailed
+        it "should markNtfTokenToDeleteFailed_" testMarkNtfTokenToDeleteFailed
   describe "open/close store" $ do
     it "should close and re-open" testCloseReopenStore
     it "should close and re-open encrypted store" testCloseReopenEncryptedStore
@@ -838,3 +839,8 @@ testMarkNtfSubActionSMPFailed :: SQLiteStore -> Expectation
 testMarkNtfSubActionSMPFailed st = do
   withTransaction st $ \db -> do
     markNtfSubActionSMPFailed_ db "abc"
+
+testMarkNtfTokenToDeleteFailed :: SQLiteStore -> Expectation
+testMarkNtfTokenToDeleteFailed st = do
+  withTransaction st $ \db -> do
+    markNtfTokenToDeleteFailed_ db 1

From 2ab0c2a7c6c56344130d9bfc7e44092cb9b3b275 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 1 Oct 2024 22:28:01 +0100
Subject: [PATCH 136/195] smp server: fix notifiers lost when compacting store
 log (#1347)

---
 src/Simplex/FileTransfer/Server/Store.hs               | 1 +
 src/Simplex/FileTransfer/Server/StoreLog.hs            | 1 +
 src/Simplex/Messaging/Notifications/Server/StoreLog.hs | 3 +++
 src/Simplex/Messaging/Server/StoreLog.hs               | 4 +++-
 4 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/src/Simplex/FileTransfer/Server/Store.hs b/src/Simplex/FileTransfer/Server/Store.hs
index 10c34819f..46513ea96 100644
--- a/src/Simplex/FileTransfer/Server/Store.hs
+++ b/src/Simplex/FileTransfer/Server/Store.hs
@@ -54,6 +54,7 @@ fileTimePrecision :: Int64
 fileTimePrecision = 3600 -- truncate creation time to 1 hour
 
 data FileRecipient = FileRecipient RecipientId RcvPublicAuthKey
+  deriving (Show)
 
 instance StrEncoding FileRecipient where
   strEncode (FileRecipient rId rKey) = strEncode rId <> ":" <> strEncode rKey
diff --git a/src/Simplex/FileTransfer/Server/StoreLog.hs b/src/Simplex/FileTransfer/Server/StoreLog.hs
index 9d3919c2c..675e4efdb 100644
--- a/src/Simplex/FileTransfer/Server/StoreLog.hs
+++ b/src/Simplex/FileTransfer/Server/StoreLog.hs
@@ -44,6 +44,7 @@ data FileStoreLogRecord
   | AddRecipients SenderId (NonEmpty FileRecipient)
   | DeleteFile SenderId
   | AckFile RecipientId
+  deriving (Show)
 
 instance StrEncoding FileStoreLogRecord where
   strEncode = \case
diff --git a/src/Simplex/Messaging/Notifications/Server/StoreLog.hs b/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
index d43700ad3..d11c01f76 100644
--- a/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
@@ -50,6 +50,7 @@ data NtfStoreLogRecord
   | CreateSubscription NtfSubRec
   | SubscriptionStatus NtfSubscriptionId NtfSubStatus
   | DeleteSubscription NtfSubscriptionId
+  deriving (Show)
 
 data NtfTknRec = NtfTknRec
   { ntfTknId :: NtfTokenId,
@@ -61,6 +62,7 @@ data NtfTknRec = NtfTknRec
     tknRegCode :: NtfRegCode,
     tknCronInterval :: Word16
   }
+  deriving (Show)
 
 mkTknData :: NtfTknRec -> STM NtfTknData
 mkTknData NtfTknRec {ntfTknId, token, tknStatus = status, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval = cronInt} = do
@@ -81,6 +83,7 @@ data NtfSubRec = NtfSubRec
     tokenId :: NtfTokenId,
     subStatus :: NtfSubStatus
   }
+  deriving (Show)
 
 mkSubData :: NtfSubRec -> STM NtfSubData
 mkSubData NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus = status} = do
diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs
index c47b06eb5..cfe2cd82e 100644
--- a/src/Simplex/Messaging/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Server/StoreLog.hs
@@ -55,6 +55,7 @@ data StoreLogRecord
   | DeleteQueue QueueId
   | DeleteNotifier QueueId
   | UpdateTime QueueId RoundedSystemTime
+  deriving (Show)
 
 data SLRTag
   = CreateQueue_
@@ -74,10 +75,11 @@ instance StrEncoding QueueRec where
         "sid=" <> strEncode senderId,
         "sk=" <> strEncode senderKey
       ]
-      <> if sndSecure then " sndSecure=" <> strEncode sndSecure else ""
+      <> sndSecureStr
       <> maybe "" notifierStr notifier
       <> maybe "" updatedAtStr updatedAt
     where
+      sndSecureStr = if sndSecure then " sndSecure=" <> strEncode sndSecure else ""
       notifierStr ntfCreds = " notifier=" <> strEncode ntfCreds
       updatedAtStr t = " updated_at=" <> strEncode t
 

From cf559ee43ff30a1996965f944103afefaec70102 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 1 Oct 2024 22:28:01 +0100
Subject: [PATCH 137/195] smp server: fix notifiers lost when compacting store
 log (#1347)

---
 src/Simplex/FileTransfer/Server/Store.hs               | 1 +
 src/Simplex/FileTransfer/Server/StoreLog.hs            | 1 +
 src/Simplex/Messaging/Notifications/Server/StoreLog.hs | 3 +++
 src/Simplex/Messaging/Server/StoreLog.hs               | 4 +++-
 4 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/src/Simplex/FileTransfer/Server/Store.hs b/src/Simplex/FileTransfer/Server/Store.hs
index 10c34819f..46513ea96 100644
--- a/src/Simplex/FileTransfer/Server/Store.hs
+++ b/src/Simplex/FileTransfer/Server/Store.hs
@@ -54,6 +54,7 @@ fileTimePrecision :: Int64
 fileTimePrecision = 3600 -- truncate creation time to 1 hour
 
 data FileRecipient = FileRecipient RecipientId RcvPublicAuthKey
+  deriving (Show)
 
 instance StrEncoding FileRecipient where
   strEncode (FileRecipient rId rKey) = strEncode rId <> ":" <> strEncode rKey
diff --git a/src/Simplex/FileTransfer/Server/StoreLog.hs b/src/Simplex/FileTransfer/Server/StoreLog.hs
index 9d3919c2c..675e4efdb 100644
--- a/src/Simplex/FileTransfer/Server/StoreLog.hs
+++ b/src/Simplex/FileTransfer/Server/StoreLog.hs
@@ -44,6 +44,7 @@ data FileStoreLogRecord
   | AddRecipients SenderId (NonEmpty FileRecipient)
   | DeleteFile SenderId
   | AckFile RecipientId
+  deriving (Show)
 
 instance StrEncoding FileStoreLogRecord where
   strEncode = \case
diff --git a/src/Simplex/Messaging/Notifications/Server/StoreLog.hs b/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
index d43700ad3..d11c01f76 100644
--- a/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
@@ -50,6 +50,7 @@ data NtfStoreLogRecord
   | CreateSubscription NtfSubRec
   | SubscriptionStatus NtfSubscriptionId NtfSubStatus
   | DeleteSubscription NtfSubscriptionId
+  deriving (Show)
 
 data NtfTknRec = NtfTknRec
   { ntfTknId :: NtfTokenId,
@@ -61,6 +62,7 @@ data NtfTknRec = NtfTknRec
     tknRegCode :: NtfRegCode,
     tknCronInterval :: Word16
   }
+  deriving (Show)
 
 mkTknData :: NtfTknRec -> STM NtfTknData
 mkTknData NtfTknRec {ntfTknId, token, tknStatus = status, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode, tknCronInterval = cronInt} = do
@@ -81,6 +83,7 @@ data NtfSubRec = NtfSubRec
     tokenId :: NtfTokenId,
     subStatus :: NtfSubStatus
   }
+  deriving (Show)
 
 mkSubData :: NtfSubRec -> STM NtfSubData
 mkSubData NtfSubRec {ntfSubId, smpQueue, notifierKey, tokenId, subStatus = status} = do
diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs
index c47b06eb5..cfe2cd82e 100644
--- a/src/Simplex/Messaging/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Server/StoreLog.hs
@@ -55,6 +55,7 @@ data StoreLogRecord
   | DeleteQueue QueueId
   | DeleteNotifier QueueId
   | UpdateTime QueueId RoundedSystemTime
+  deriving (Show)
 
 data SLRTag
   = CreateQueue_
@@ -74,10 +75,11 @@ instance StrEncoding QueueRec where
         "sid=" <> strEncode senderId,
         "sk=" <> strEncode senderKey
       ]
-      <> if sndSecure then " sndSecure=" <> strEncode sndSecure else ""
+      <> sndSecureStr
       <> maybe "" notifierStr notifier
       <> maybe "" updatedAtStr updatedAt
     where
+      sndSecureStr = if sndSecure then " sndSecure=" <> strEncode sndSecure else ""
       notifierStr ntfCreds = " notifier=" <> strEncode ntfCreds
       updatedAtStr t = " updated_at=" <> strEncode t
 

From 7488923fc3fb67d3c448ff4700f0a28d787bd2b0 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 2 Oct 2024 09:24:29 +0100
Subject: [PATCH 138/195] 6.0.6.0

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index 39054ec77..467a3221e 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.0.5.0
+version: 6.0.6.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 33743c8a4..0af4831ac 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.0.5.0
+version:        6.0.6.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 0ba3e6987283e56c0d4c46ab841314de7b404d00 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 2 Oct 2024 09:49:43 +0100
Subject: [PATCH 139/195] Revert "smp server: persist notifications to avoid
 losing them when ntf server is offline (#1336)"

This reverts commit 0739f7b702877a8beffd0d92129813fa72c40984.
---
 simplexmq.cabal                               |   1 -
 src/Simplex/Messaging/Notifications/Server.hs |   5 +-
 src/Simplex/Messaging/Server.hs               | 171 +++-------
 src/Simplex/Messaging/Server/Env/STM.hs       |  20 +-
 src/Simplex/Messaging/Server/Main.hs          |  24 +-
 src/Simplex/Messaging/Server/NtfStore.hs      |  77 -----
 src/Simplex/Messaging/Server/Stats.hs         |  20 --
 src/Simplex/Messaging/TMap.hs                 |   5 -
 tests/AgentTests/NotificationTests.hs         | 315 +++++++++---------
 tests/CoreTests/BatchingTests.hs              | 244 ++++++--------
 tests/NtfClient.hs                            |  54 +--
 tests/NtfServerTests.hs                       |  18 +-
 tests/SMPClient.hs                            |  19 +-
 tests/SMPProxyTests.hs                        |   8 +-
 tests/ServerTests.hs                          |   6 +-
 15 files changed, 356 insertions(+), 631 deletions(-)
 delete mode 100644 src/Simplex/Messaging/Server/NtfStore.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 6510e1d61..63088ee4b 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -174,7 +174,6 @@ library
       Simplex.Messaging.Server.Main
       Simplex.Messaging.Server.MsgStore
       Simplex.Messaging.Server.MsgStore.STM
-      Simplex.Messaging.Server.NtfStore
       Simplex.Messaging.Server.QueueStore
       Simplex.Messaging.Server.QueueStore.QueueInfo
       Simplex.Messaging.Server.QueueStore.STM
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 42c24aeb8..54be77a71 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -220,8 +220,9 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
               NtfPushServer {pushQ} <- asks pushServer
               stats <- asks serverStats
               liftIO $ updatePeriodStats (activeSubs stats) ntfId
-              atomically (findNtfSubscriptionToken st smpQueue)
-                >>= mapM_ (\tkn -> atomically (writeTBQueue pushQ (tkn, PNMessage (PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| []))))
+              atomically $
+                findNtfSubscriptionToken st smpQueue
+                  >>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage (PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| [])))
               incNtfStat ntfReceived
             Right SMP.END ->
               whenM (atomically $ activeClientSession' ca sessionId srv) $
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 54fef3ab3..bf96b6deb 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -58,7 +58,7 @@ import Data.IORef
 import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
-import Data.List (foldl', intercalate, mapAccumR)
+import Data.List (intercalate, mapAccumR)
 import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
@@ -88,7 +88,6 @@ import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
 import Simplex.Messaging.Server.MsgStore.STM
-import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.Server.QueueStore.STM as QS
@@ -138,16 +137,13 @@ smpServer :: TMVar Bool -> ServerConfig -> Maybe AttachHTTP -> M ()
 smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHTTP_ = do
   s <- asks server
   pa <- asks proxyAgent
-  expiredMsgs <- restoreServerMessages
-  expiredNtfs <- restoreServerNtfs
-  restoreServerStats expiredMsgs expiredNtfs
+  expired <- restoreServerMessages
+  restoreServerStats expired
   raceAny_
     ( serverThread s "server subscribedQ" subscribedQ subscribers subClients pendingSubEvents subscriptions cancelSub
         : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubClients pendingNtfSubEvents ntfSubscriptions (\_ -> pure ())
-        : deliverNtfsThread s
         : sendPendingEvtsThread s
         : receiveFromProxyAgent pa
-        : expireNtfsThread cfg
         : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
     )
     `finally` withLock' (savingLock s) "final" (saveServer False >> closeServer)
@@ -175,7 +171,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
     fromTLSCredentials (_, pk) = C.x509ToPrivate (pk, []) >>= C.privKey
 
     saveServer :: Bool -> M ()
-    saveServer keepMsgs = withLog closeStoreLog >> saveServerMessages keepMsgs >> saveServerNtfs >> saveServerStats
+    saveServer keepMsgs = withLog closeStoreLog >> saveServerMessages keepMsgs >> saveServerStats
 
     closeServer :: M ()
     closeServer = asks (smpAgent . proxyAgent) >>= liftIO . closeSMPClientAgent
@@ -234,31 +230,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
         -- remove client from server's subscribed cients
         removeWhenNoSubs c = whenM (null <$> readTVar (clientSubs c)) $ modifyTVar' (subClnts s) $ IM.delete (clientId c)
 
-    deliverNtfsThread :: Server -> M ()
-    deliverNtfsThread Server {ntfSubClients} = do
-      ntfInt <- asks $ ntfDeliveryInterval . config
-      ns <- asks ntfStore
-      stats <- asks serverStats
-      liftIO $ forever $ do
-        threadDelay ntfInt
-        readTVarIO ntfSubClients >>= mapM_ (deliverNtfs ns stats)
-      where
-        deliverNtfs ns stats Client {clientId, ntfSubscriptions, sndQ, connected} = whenM currentClient $
-          readTVarIO ntfSubscriptions >>= \subs -> do
-            ts_ <- foldM addNtfs [] (M.keys subs)
-            mapM_ (atomically . writeTBQueue sndQ) $ L.nonEmpty ts_
-            updateNtfStats $ length ts_
-          where
-            currentClient = (&&) <$> readTVarIO connected <*> (IM.member clientId <$> readTVarIO ntfSubClients)
-            addNtfs :: [Transmission BrokerMsg] -> NotifierId -> IO [Transmission BrokerMsg]
-            addNtfs acc nId =
-              (foldl' (\acc' ntf -> nmsg nId ntf : acc') acc) -- reverses, to order by time
-                <$> flushNtfs ns nId
-            nmsg nId MsgNtf {ntfNonce, ntfEncMeta} = (CorrId "", nId, NMSG ntfNonce ntfEncMeta)
-            updateNtfStats len = when (len > 0) $ liftIO $ do
-              atomicModifyIORef'_ (msgNtfs stats) (+ len)
-              atomicModifyIORef'_ (msgNtfsB stats) (+ (len `div` 80 + 1)) -- up to 80 NMSG in the batch
-
     sendPendingEvtsThread :: Server -> M ()
     sendPendingEvtsThread s = do
       endInt <- asks $ pendingENDInterval . config
@@ -288,9 +259,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
             updateEndStats = do
               stats <- asks serverStats
               let len = L.length qEvts
-              when (len > 0) $ liftIO $ do
-                atomicModifyIORef'_ (qSubEnd stats) (+ len)
-                atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs or DELDs in the batch
+              liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
+              liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs or DELDs in the batch
 
     receiveFromProxyAgent :: ProxyAgent -> M ()
     receiveFromProxyAgent ProxyAgent {smpAgent = SMPClientAgent {agentQ}} =
@@ -324,18 +294,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
           deleted <- liftIO $ deleteExpiredMsgs q old
           liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
 
-    expireNtfsThread :: ServerConfig -> M ()
-    expireNtfsThread ServerConfig {notificationExpiration = expCfg} = do
-      ns <- asks ntfStore
-      let interval = checkInterval expCfg * 1000000
-      stats <- asks serverStats
-      labelMyThread "expireNtfsThread"
-      liftIO $ forever $ do
-        threadDelay' interval
-        old <- expireBeforeEpoch expCfg
-        expired <- deleteExpiredNtfs ns old
-        when (expired > 0) $ atomicModifyIORef'_ (msgNtfExpired stats) (+ expired)
-
     serverStatsThread_ :: ServerConfig -> [M ()]
     serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime, serverStatsLogFile} =
       [logServerStats logStatsStartTime interval serverStatsLogFile]
@@ -393,10 +351,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
           msgRecvNtf' <- atomicSwapIORef msgRecvNtf 0
           psNtf <- liftIO $ periodStatCounts activeQueuesNtf ts
           msgNtfs' <- atomicSwapIORef (msgNtfs ss) 0
-          msgNtfsB' <- atomicSwapIORef (msgNtfsB ss) 0
           msgNtfNoSub' <- atomicSwapIORef (msgNtfNoSub ss) 0
           msgNtfLost' <- atomicSwapIORef (msgNtfLost ss) 0
-          msgNtfExpired' <- atomicSwapIORef (msgNtfExpired ss) 0
           pRelays' <- getResetProxyStatsData pRelays
           pRelaysOwn' <- getResetProxyStatsData pRelaysOwn
           pMsgFwds' <- getResetProxyStatsData pMsgFwds
@@ -468,9 +424,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                        show qSubEnd',
                        show qSubEndB',
                        show ntfDeletedB',
-                       show ntfSubB',
-                       show msgNtfsB',
-                       show msgNtfExpired'
+                       show ntfSubB'
                      ]
               )
         liftIO $ threadDelay' interval
@@ -580,9 +534,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                 hPutStrLn h $ "other GET events (auth, duplicate, prohibited): " <> show gets
                 putStat "msgSentNtf" msgSentNtf
                 putStat "msgRecvNtf" msgRecvNtf
-                putStat "msgNtfs" msgNtfs
-                putStat "msgNtfsB" msgNtfsB
-                putStat "msgNtfExpired" msgNtfExpired
                 putStat "qCount" qCount
                 putStat "msgCount" msgCount
                 putProxyStat "pRelays" pRelays
@@ -981,7 +932,7 @@ forkClient Client {endThreads, endThreadSeq} label action = do
   mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId
 
 client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
-client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers} = do
+client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers, notifiers} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
   forever $
     atomically (readTBQueue rcvQ)
@@ -1184,7 +1135,6 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           liftIO (deleteQueueNotifier st entId) >>= \case
             Right (Just nId) -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              asks ntfStore >>= liftIO . (`deleteNtfs` nId)
               atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
               incStat . ntfDeleted =<< asks serverStats
               pure ok
@@ -1326,14 +1276,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               Message {msgFlags} -> do
                 stats <- asks serverStats
                 incStat $ msgRecv stats
-                if isGet
-                  then incStat $ msgRecvGet stats
-                  else pure () -- TODO skip notification delivery for delivered message  
-                  -- skipping delivery fails tests, it should be counted in msgNtfSkipped
-                  -- forM_ (notifierId <$> notifier qr) $ \nId -> do
-                  --   ns <- asks ntfStore
-                  --   atomically $ TM.lookup nId ns >>=
-                  --     mapM_ (\MsgNtf {ntfMsgId} -> when (msgId == msgId') $ TM.delete nId ns)
+                when isGet $ incStat $ msgRecvGet stats
                 liftIO $ atomicModifyIORef'_ (msgCount stats) (subtract 1)
                 liftIO $ updatePeriodStats (activeQueues stats) entId
                 when (notification msgFlags) $ do
@@ -1367,7 +1310,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                         Just (msg, wasEmpty) -> time "SEND ok" $ do
                           when wasEmpty $ liftIO $ tryDeliverMessage msg
                           when (notification msgFlags) $ do
-                            mapM_ (`enqueueNotification` msg) (notifier qr)
+                            mapM_ (`trySendNotification` msg) (notifier qr)
                             incStat $ msgSentNtf stats
                             liftIO $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
                           incStat $ msgSent stats
@@ -1452,20 +1395,39 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                             deliver q s
                             writeTVar st NoSub
 
-            enqueueNotification :: NtfCreds -> Message -> M ()
-            enqueueNotification _ MessageQuota {} = pure ()
-            enqueueNotification NtfCreds {notifierId = nId, rcvNtfDhSecret} Message {msgId, msgTs} = do
-              -- stats <- asks serverStats
-              ns <- asks ntfStore
-              ntf <- mkMessageNotification msgId msgTs rcvNtfDhSecret
-              liftIO $ storeNtf ns nId ntf
+            trySendNotification :: NtfCreds -> Message -> M ()
+            trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg = do
+              stats <- asks serverStats
+              liftIO (TM.lookupIO notifierId notifiers) >>= \case
+                Nothing -> do
+                  incStat $ msgNtfNoSub stats
+                  logWarn "No notification subscription"
+                Just ntfClnt -> do
+                  let updateStats True = incStat $ msgNtfs stats
+                      updateStats _ = do
+                        incStat $ msgNtfLost stats
+                        logWarn "Dropped message notification"
+                  writeNtf notifierId msg rcvNtfDhSecret ntfClnt >>= mapM_ updateStats
 
-            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> M MsgNtf
+            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> TVar Client -> M (Maybe Bool)
+            writeNtf nId msg rcvNtfDhSecret ntfClnt = case msg of
+              Message {msgId, msgTs} -> Just <$> do
+                (nmsgNonce, encNMsgMeta) <- mkMessageNotification msgId msgTs rcvNtfDhSecret
+                -- must be in one STM transaction to avoid the queue becoming full between the check and writing
+                atomically $ do
+                  Client {sndQ = q} <- readTVar ntfClnt
+                  ifM
+                    (isFullTBQueue q)
+                    (pure $ False)
+                    (True <$ writeTBQueue q [(CorrId "", nId, NMSG nmsgNonce encNMsgMeta)])
+              _ -> pure Nothing
+
+            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> M (C.CbNonce, EncNMsgMeta)
             mkMessageNotification msgId msgTs rcvNtfDhSecret = do
-              ntfNonce <- atomically . C.randomCbNonce =<< asks random
+              cbNonce <- atomically . C.randomCbNonce =<< asks random
               let msgMeta = NMsgMeta {msgId, msgTs}
-                  encNMsgMeta = C.cbEncrypt rcvNtfDhSecret ntfNonce (smpEncode msgMeta) 128
-              pure $ MsgNtf {ntfMsgId = msgId, ntfTs = msgTs, ntfNonce, ntfEncMeta = fromRight "" encNMsgMeta}
+                  encNMsgMeta = C.cbEncrypt rcvNtfDhSecret cbNonce (smpEncode msgMeta) 128
+              pure . (cbNonce,) $ fromRight "" encNMsgMeta
 
         processForwardedCommand :: EncFwdTransmission -> M BrokerMsg
         processForwardedCommand (EncFwdTransmission s) = fmap (either ERR id) . runExceptT $ do
@@ -1566,10 +1528,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                 -- queue is usually deleted by the same client that is currently subscribed,
                 -- we delete subscription here, so the client with no subscriptions can be disconnected.
                 TM.delete entId subscriptions
-              forM_ (notifierId <$> notifier q) $ \nId -> do
+              forM_ (notifierId <$> notifier q) $ \nId ->
                 -- queue is deleted by a different client from the one subscribed to notifications,
                 -- so we don't need to remove subscription from the current client.
-                asks ntfStore >>= liftIO . (`deleteNtfs` nId)
                 atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
               updateDeletedStats q
               pure ok
@@ -1696,50 +1657,6 @@ restoreServerMessages =
             msgErr :: Show e => String -> e -> String
             msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
 
-saveServerNtfs :: M ()
-saveServerNtfs = asks (storeNtfsFile . config) >>= mapM_ saveNtfs
-  where
-    saveNtfs f = do
-      logInfo $ "saving notifications to file " <> T.pack f
-      NtfStore ns <- asks ntfStore
-      liftIO . withFile f WriteMode $ \h ->
-        readTVarIO ns >>= mapM_ (saveQueueNtfs h) . M.assocs
-      logInfo "notifications saved"
-      where
-        -- reverse on save, to save notifications in order, will become reversed again when restoring.
-        saveQueueNtfs h (nId, v) = BLD.hPutBuilder h . encodeNtfs nId . reverse =<< readTVarIO v
-        encodeNtfs nId = mconcat . map (\ntf -> BLD.byteString (strEncode $ NLRv1 nId ntf) <> BLD.char8 '\n')
-
-restoreServerNtfs :: M Int
-restoreServerNtfs =
-  asks (storeNtfsFile . config) >>= \case
-    Just f -> ifM (doesFileExist f) (restoreNtfs f) (pure 0)
-    Nothing -> pure 0
-  where
-    restoreNtfs f = do
-      logInfo $ "restoring notifications from file " <> T.pack f
-      ns <- asks ntfStore
-      old <- asks (notificationExpiration . config) >>= liftIO . expireBeforeEpoch
-      runExceptT (liftIO (LB.readFile f) >>= foldM (restoreNtf ns old) 0 . LB.lines) >>= \case
-        Left e -> do
-          logError . T.pack $ "error restoring notifications: " <> e
-          liftIO exitFailure
-        Right expired -> do
-          renameFile f $ f <> ".bak"
-          logInfo "notifications restored"
-          pure expired
-      where
-        restoreNtf ns old !expired s' = do
-          NLRv1 nId ntf <- liftEither . first (ntfErr "parsing") $ strDecode s
-          liftIO $ addToNtfs nId ntf
-          where
-            s = LB.toStrict s'
-            addToNtfs nId ntf@MsgNtf {ntfTs}
-              | systemSeconds ntfTs < old = pure (expired + 1)
-              | otherwise = storeNtf ns nId ntf $> expired
-            ntfErr :: Show e => String -> e -> String
-            ntfErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
-
 saveServerStats :: M ()
 saveServerStats =
   asks (serverStatsBackupFile . config)
@@ -1750,8 +1667,8 @@ saveServerStats =
       B.writeFile f $ strEncode stats
       logInfo "server stats saved"
 
-restoreServerStats :: Int -> Int -> M ()
-restoreServerStats expiredMsgs expiredNtfs = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
+restoreServerStats :: Int -> M ()
+restoreServerStats expiredWhileRestoring = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
   where
     restoreStats f = whenM (doesFileExist f) $ do
       logInfo $ "restoring server stats from file " <> T.pack f
@@ -1760,7 +1677,7 @@ restoreServerStats expiredMsgs expiredNtfs = asks (serverStatsBackupFile . confi
           s <- asks serverStats
           _qCount <- fmap M.size . readTVarIO . queues =<< asks queueStore
           _msgCount <- liftIO . foldM (\(!n) q -> (n +) <$> getQueueSize q) 0 =<< readTVarIO =<< asks msgStore
-          liftIO $ setServerStats s d {_qCount, _msgCount, _msgExpired = _msgExpired d + expiredMsgs, _msgNtfExpired = _msgNtfExpired d + expiredNtfs}
+          liftIO $ setServerStats s d {_qCount, _msgCount, _msgExpired = _msgExpired d + expiredWhileRestoring}
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
           when (_qCount /= statsQCount) $ logWarn $ "Queue count differs: stats: " <> tshow statsQCount <> ", store: " <> tshow _qCount
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index a485ab73e..05ed7da53 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -38,7 +38,6 @@ import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.MsgStore.STM
-import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.QueueStore (NtfCreds (..), QueueRec (..))
 import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.Stats
@@ -62,7 +61,6 @@ data ServerConfig = ServerConfig
     msgIdBytes :: Int,
     storeLogFile :: Maybe FilePath,
     storeMsgsFile :: Maybe FilePath,
-    storeNtfsFile :: Maybe FilePath,
     -- | set to False to prohibit creating new queues
     allowNewQueues :: Bool,
     -- | simple password that the clients need to pass in handshake to be able to create new queues
@@ -72,8 +70,6 @@ data ServerConfig = ServerConfig
     controlPortAdminAuth :: Maybe BasicAuth,
     -- | time after which the messages can be removed from the queues and check interval, seconds
     messageExpiration :: Maybe ExpirationConfig,
-    -- | notification expiration interval (seconds)
-    notificationExpiration :: ExpirationConfig,
     -- | time after which the socket with inactive client can be disconnected (without any messages or commands, incl. PING),
     -- and check interval, seconds
     inactiveClientExpiration :: Maybe ExpirationConfig,
@@ -86,8 +82,6 @@ data ServerConfig = ServerConfig
     serverStatsLogFile :: FilePath,
     -- | file to save and restore stats
     serverStatsBackupFile :: Maybe FilePath,
-    -- | notification delivery interval
-    ntfDeliveryInterval :: Int,
     -- | interval between sending pending END events to unsubscribed clients, seconds
     pendingENDInterval :: Int,
     smpCredentials :: ServerCredentials,
@@ -116,16 +110,6 @@ defaultMessageExpiration =
       checkInterval = 43200 -- seconds, 12 hours
     }
 
-defNtfExpirationHours :: Int64
-defNtfExpirationHours = 24
-
-defaultNtfExpiration :: ExpirationConfig
-defaultNtfExpiration =
-  ExpirationConfig
-    { ttl = defNtfExpirationHours * 3600, -- seconds
-      checkInterval = 3600 -- seconds, 1 hour
-    }
-
 defaultInactiveClientExpiration :: ExpirationConfig
 defaultInactiveClientExpiration =
   ExpirationConfig
@@ -143,7 +127,6 @@ data Env = Env
     serverIdentity :: KeyHash,
     queueStore :: QueueStore,
     msgStore :: STMMsgStore,
-    ntfStore :: NtfStore,
     random :: TVar ChaChaDRG,
     storeLog :: Maybe (StoreLog 'WriteMode),
     tlsServerCreds :: T.Credential,
@@ -246,7 +229,6 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAg
   server <- newServer
   queueStore <- newQueueStore
   msgStore <- newMsgStore
-  ntfStore <- NtfStore <$> TM.emptyIO
   random <- C.newRandom
   storeLog <-
     forM storeLogFile $ \f -> do
@@ -262,7 +244,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAg
   clientSeq <- newTVarIO 0
   clients <- newTVarIO mempty
   proxyAgent <- newSMPProxyAgent smpAgentCfg random
-  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, ntfStore, random, storeLog, tlsServerCreds, httpServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
+  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerCreds, httpServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
   where
     getCredentials protocol creds = do
       files <- missingCreds
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index ca4a5ed60..bcd96c170 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -38,7 +38,7 @@ import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
 import Simplex.Messaging.Server (AttachHTTP, runSMPServer)
 import Simplex.Messaging.Server.CLI
-import Simplex.Messaging.Server.Env.STM
+import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defMsgExpirationDays, defaultInactiveClientExpiration, defaultMessageExpiration, defaultProxyClientConcurrency)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedServerSMPRelayVRange)
@@ -154,8 +154,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 <> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
                    \# they are preserved in the .bak file until the next restart.\n"
                 <> ("restore_messages: " <> onOff enableStoreLog <> "\n")
-                <> ("expire_messages_days: " <> tshow defMsgExpirationDays <> "\n")
-                <> ("expire_ntfs_hours: " <> tshow defNtfExpirationHours <> "\n\n")
+                <> ("expire_messages_days: " <> tshow defMsgExpirationDays <> "\n\n")
                 <> "# Log daily server statistics to CSV file\n"
                 <> ("log_stats: " <> onOff logStats <> "\n\n")
                 <> "[AUTH]\n\
@@ -269,11 +268,6 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
         enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
         logStats = settingIsOn "STORE_LOG" "log_stats" ini
         c = combine cfgPath . ($ defaultX509Config)
-        restoreMessagesFile path = case iniOnOff "STORE_LOG" "restore_messages" ini of
-          Just True -> Just path
-          Just False -> Nothing
-          -- if the setting is not set, it is enabled when store log is enabled
-          _ -> enableStoreLog $> path
         transports = iniTransports ini
         sharedHTTP = any (\(_, _, addHTTP) -> addHTTP) transports
         serverConfig =
@@ -292,8 +286,13 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                   },
               httpCredentials = (\WebHttpsParams {key, cert} -> ServerCredentials {caCertificateFile = Nothing, privateKeyFile = key, certificateFile = cert}) <$> webHttpsParams',
               storeLogFile = enableStoreLog $> storeLogFilePath,
-              storeMsgsFile = restoreMessagesFile $ combine logPath "smp-server-messages.log",
-              storeNtfsFile = restoreMessagesFile $ combine logPath "smp-server-ntfs.log",
+              storeMsgsFile =
+                let messagesPath = combine logPath "smp-server-messages.log"
+                 in case iniOnOff "STORE_LOG" "restore_messages" ini of
+                      Just True -> Just messagesPath
+                      Just False -> Nothing
+                      -- if the setting is not set, it is enabled when store log is enabled
+                      _ -> enableStoreLog $> messagesPath,
               -- allow creating new queues by default
               allowNewQueues = fromMaybe True $ iniOnOff "AUTH" "new_queues" ini,
               newQueueBasicAuth = either error id <$!> strDecodeIni "AUTH" "create_password" ini,
@@ -304,10 +303,6 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                   defaultMessageExpiration
                     { ttl = 86400 * readIniDefault defMsgExpirationDays "STORE_LOG" "expire_messages_days" ini
                     },
-              notificationExpiration =
-                defaultNtfExpiration
-                  { ttl = 3600 * readIniDefault defNtfExpirationHours "STORE_LOG" "expire_ntfs_hours" ini
-                  },
               inactiveClientExpiration =
                 settingIsOn "INACTIVE_CLIENTS" "disconnect" ini
                   $> ExpirationConfig
@@ -319,7 +314,6 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               serverStatsLogFile = combine logPath "smp-server-stats.daily.log",
               serverStatsBackupFile = logStats $> combine logPath "smp-server-stats.log",
               pendingENDInterval = 15000000, -- 15 seconds
-              ntfDeliveryInterval = 3000000, -- 3 seconds
               smpServerVRange = supportedServerSMPRelayVRange,
               transportConfig =
                 defaultTransportServerConfig
diff --git a/src/Simplex/Messaging/Server/NtfStore.hs b/src/Simplex/Messaging/Server/NtfStore.hs
deleted file mode 100644
index ded2bd85d..000000000
--- a/src/Simplex/Messaging/Server/NtfStore.hs
+++ /dev/null
@@ -1,77 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Simplex.Messaging.Server.NtfStore where
-
-import Control.Concurrent.STM
-import Control.Monad (foldM)
-import Data.Int (Int64)
-import qualified Data.Map.Strict as M
-import Data.Time.Clock.System (SystemTime (..))
-import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (EncNMsgMeta, MsgId, NotifierId)
-import Simplex.Messaging.TMap (TMap)
-import qualified Simplex.Messaging.TMap as TM
-
-newtype NtfStore = NtfStore (TMap NotifierId (TVar [MsgNtf]))
-
-data MsgNtf = MsgNtf
-  { ntfMsgId :: MsgId,
-    ntfTs :: SystemTime,
-    ntfNonce :: C.CbNonce,
-    ntfEncMeta :: EncNMsgMeta
-  }
-
-storeNtf :: NtfStore -> NotifierId -> MsgNtf -> IO ()
-storeNtf (NtfStore ns) nId ntf = do
-  TM.lookupIO nId ns >>= atomically . maybe newNtfs (`modifyTVar'` (ntf :))
-  -- TODO coalesce messages here once the client is updated to process multiple messages
-  -- for single notification.
-  -- when (isJust prevNtf) $ incStat $ msgNtfReplaced stats
-  where
-    newNtfs = TM.lookup nId ns >>= maybe (TM.insertM nId (newTVar [ntf]) ns) (`modifyTVar'` (ntf :))
-
-deleteNtfs :: NtfStore -> NotifierId -> IO ()
-deleteNtfs (NtfStore ns) nId = atomically $ TM.delete nId ns
-
-flushNtfs :: NtfStore -> NotifierId -> IO [MsgNtf]
-flushNtfs (NtfStore ns) nId = do
-  TM.lookupIO nId ns >>= maybe (pure []) swapNtfs
-  where
-    swapNtfs v =
-      readTVarIO v >>= \case
-        [] -> pure []
-        -- if notifications available, atomically swap with empty array
-        _ -> atomically (swapTVar v [])
-
-deleteExpiredNtfs :: NtfStore -> Int64 -> IO Int
-deleteExpiredNtfs (NtfStore ns) old =
-  foldM (\expired -> fmap (expired +) . expireQueue) 0 . M.keys =<< readTVarIO ns
-  where
-    expireQueue nId = TM.lookupIO nId ns >>= maybe (pure 0) expire
-    expire v = readTVarIO v >>= \case
-      [] -> pure 0
-      _ ->
-        atomically $ readTVar v >>= \case
-          [] -> pure 0
-          -- check the last message first, it is the earliest
-          ntfs | systemSeconds (ntfTs $ last $ ntfs) < old -> do
-            let !ntfs' = filter (\MsgNtf {ntfTs = ts} -> systemSeconds ts >= old) ntfs
-            writeTVar v ntfs'
-            pure $! length ntfs - length ntfs'
-          _ -> pure 0
-
-data NtfLogRecord = NLRv1 NotifierId MsgNtf
-
-instance StrEncoding MsgNtf where
-  strEncode MsgNtf {ntfMsgId, ntfTs, ntfNonce, ntfEncMeta} = strEncode (ntfMsgId, ntfTs, ntfNonce, ntfEncMeta)
-  strP = do
-    (ntfMsgId, ntfTs, ntfNonce, ntfEncMeta) <- strP
-    pure MsgNtf {ntfMsgId, ntfTs, ntfNonce, ntfEncMeta}
-
-instance StrEncoding NtfLogRecord where
-  strEncode (NLRv1 nId ntf) = strEncode (Str "v1", nId, ntf)
-  strP = "v1 " *> (NLRv1 <$> strP_ <*> strP)
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index 49078d2d9..097ddb607 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -67,10 +67,8 @@ data ServerStats = ServerStats
     msgRecvNtf :: IORef Int, -- received messages with NTF flag
     activeQueuesNtf :: PeriodStats,
     msgNtfs :: IORef Int, -- messages notications delivered to NTF server (<= msgSentNtf)
-    msgNtfsB :: IORef Int, -- messages notication batches delivered to NTF server
     msgNtfNoSub :: IORef Int, -- no subscriber to notifications (e.g., NTF server not connected)
     msgNtfLost :: IORef Int, -- notification is lost because NTF delivery queue is full
-    msgNtfExpired :: IORef Int, -- expired
     pRelays :: ProxyStats,
     pRelaysOwn :: ProxyStats,
     pMsgFwds :: ProxyStats,
@@ -119,10 +117,8 @@ data ServerStatsData = ServerStatsData
     _msgRecvNtf :: Int,
     _activeQueuesNtf :: PeriodStatsData,
     _msgNtfs :: Int,
-    _msgNtfsB :: Int,
     _msgNtfNoSub :: Int,
     _msgNtfLost :: Int,
-    _msgNtfExpired :: Int,
     _pRelays :: ProxyStatsData,
     _pRelaysOwn :: ProxyStatsData,
     _pMsgFwds :: ProxyStatsData,
@@ -173,10 +169,8 @@ newServerStats ts = do
   msgRecvNtf <- newIORef 0
   activeQueuesNtf <- newPeriodStats
   msgNtfs <- newIORef 0
-  msgNtfsB <- newIORef 0
   msgNtfNoSub <- newIORef 0
   msgNtfLost <- newIORef 0
-  msgNtfExpired <- newIORef 0
   pRelays <- newProxyStats
   pRelaysOwn <- newProxyStats
   pMsgFwds <- newProxyStats
@@ -224,10 +218,8 @@ newServerStats ts = do
         msgRecvNtf,
         activeQueuesNtf,
         msgNtfs,
-        msgNtfsB,
         msgNtfNoSub,
         msgNtfLost,
-        msgNtfExpired,
         pRelays,
         pRelaysOwn,
         pMsgFwds,
@@ -277,10 +269,8 @@ getServerStatsData s = do
   _msgRecvNtf <- readIORef $ msgRecvNtf s
   _activeQueuesNtf <- getPeriodStatsData $ activeQueuesNtf s
   _msgNtfs <- readIORef $ msgNtfs s
-  _msgNtfsB <- readIORef $ msgNtfsB s
   _msgNtfNoSub <- readIORef $ msgNtfNoSub s
   _msgNtfLost <- readIORef $ msgNtfLost s
-  _msgNtfExpired <- readIORef $ msgNtfExpired s
   _pRelays <- getProxyStatsData $ pRelays s
   _pRelaysOwn <- getProxyStatsData $ pRelaysOwn s
   _pMsgFwds <- getProxyStatsData $ pMsgFwds s
@@ -328,10 +318,8 @@ getServerStatsData s = do
         _msgRecvNtf,
         _activeQueuesNtf,
         _msgNtfs,
-        _msgNtfsB,
         _msgNtfNoSub,
         _msgNtfLost,
-        _msgNtfExpired,
         _pRelays,
         _pRelaysOwn,
         _pMsgFwds,
@@ -382,10 +370,8 @@ setServerStats s d = do
   writeIORef (msgRecvNtf s) $! _msgRecvNtf d
   setPeriodStats (activeQueuesNtf s) (_activeQueuesNtf d)
   writeIORef (msgNtfs s) $! _msgNtfs d
-  writeIORef (msgNtfsB s) $! _msgNtfsB d
   writeIORef (msgNtfNoSub s) $! _msgNtfNoSub d
   writeIORef (msgNtfLost s) $! _msgNtfLost d
-  writeIORef (msgNtfExpired s) $! _msgNtfExpired d
   setProxyStats (pRelays s) $! _pRelays d
   setProxyStats (pRelaysOwn s) $! _pRelaysOwn d
   setProxyStats (pMsgFwds s) $! _pMsgFwds d
@@ -434,10 +420,8 @@ instance StrEncoding ServerStatsData where
         "msgSentNtf=" <> strEncode (_msgSentNtf d),
         "msgRecvNtf=" <> strEncode (_msgRecvNtf d),
         "msgNtfs=" <> strEncode (_msgNtfs d),
-        "msgNtfsB=" <> strEncode (_msgNtfsB d),
         "msgNtfNoSub=" <> strEncode (_msgNtfNoSub d),
         "msgNtfLost=" <> strEncode (_msgNtfLost d),
-        "msgNtfExpired=" <> strEncode (_msgNtfExpired d),
         "activeQueues:",
         strEncode (_activeQueues d),
         "activeQueuesNtf:",
@@ -491,10 +475,8 @@ instance StrEncoding ServerStatsData where
     _msgSentNtf <- opt "msgSentNtf="
     _msgRecvNtf <- opt "msgRecvNtf="
     _msgNtfs <- opt "msgNtfs="
-    _msgNtfsB <- opt "msgNtfsB="
     _msgNtfNoSub <- opt "msgNtfNoSub="
     _msgNtfLost <- opt "msgNtfLost="
-    _msgNtfExpired <- opt "msgNtfExpired="
     _activeQueues <-
       optional ("activeQueues:" <* A.endOfLine) >>= \case
         Just _ -> strP <* optional A.endOfLine
@@ -554,10 +536,8 @@ instance StrEncoding ServerStatsData where
           _msgSentNtf,
           _msgRecvNtf,
           _msgNtfs,
-          _msgNtfsB,
           _msgNtfNoSub,
           _msgNtfLost,
-          _msgNtfExpired,
           _activeQueues,
           _activeQueuesNtf,
           _pRelays,
diff --git a/src/Simplex/Messaging/TMap.hs b/src/Simplex/Messaging/TMap.hs
index 02d20b695..1bc9bcb60 100644
--- a/src/Simplex/Messaging/TMap.hs
+++ b/src/Simplex/Messaging/TMap.hs
@@ -9,7 +9,6 @@ module Simplex.Messaging.TMap
     member,
     memberIO,
     insert,
-    insertM,
     delete,
     lookupInsert,
     lookupDelete,
@@ -63,10 +62,6 @@ insert :: Ord k => k -> a -> TMap k a -> STM ()
 insert k v m = modifyTVar' m $ M.insert k v
 {-# INLINE insert #-}
 
-insertM :: Ord k => k -> STM a -> TMap k a -> STM ()
-insertM k f m = modifyTVar' m . M.insert k =<< f
-{-# INLINE insertM #-}
-
 delete :: Ord k => k -> TMap k a -> STM ()
 delete k m = modifyTVar' m $ M.delete k
 {-# INLINE delete #-}
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 272c6d6d6..40071873c 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -54,7 +54,7 @@ import Data.Text.Encoding (encodeUtf8)
 import Database.SQLite.Simple.QQ (sql)
 import NtfClient
 import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testNtfServer, testNtfServer2)
-import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
+import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore')
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, Env (..), InitialAgentServers)
@@ -134,8 +134,9 @@ notificationTests t = do
           withNtfServer t $ testChangeToken apns
   describe "Notifications server store log" $
     it "should save and restore tokens and subscriptions" $
-      withAPNSMockServer $ \apns ->
-        testNotificationsStoreLog t apns
+      withSmpServer t $
+        withAPNSMockServer $ \apns ->
+          testNotificationsStoreLog t apns
   describe "Notifications after SMP server restart" $
     it "should resume subscriptions after SMP server is restarted" $
       withAPNSMockServer $ \apns ->
@@ -182,14 +183,15 @@ runNtfTestCfg t baseId smpCfg ntfCfg aCfg bCfg runTest = do
   threadDelay 100000
 
 testNotificationToken :: APNSMockServer -> IO ()
-testNotificationToken apns = do
+testNotificationToken APNSMockServer {apnsQ} = do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
-      getMockNotification apns tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+      atomically $ readTBQueue apnsQ
     verification <- ntfData .-> "verification"
     nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    liftIO $ sendApnsResponse APNSRespOk
     verifyNtfToken a tkn nonce verification
     NTActive <- checkNtfToken a tkn
     deleteNtfToken a tkn
@@ -206,44 +208,48 @@ v .-> key = do
 -- logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 testNtfTokenRepeatRegistration :: APNSMockServer -> IO ()
-testNtfTokenRepeatRegistration apns = do
+testNtfTokenRepeatRegistration APNSMockServer {apnsQ} = do
   -- setLogLevel LogError -- LogDebug
   -- withGlobalLogging logCfg $ do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
-      getMockNotification apns tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+      atomically $ readTBQueue apnsQ
     verification <- ntfData .-> "verification"
     nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    liftIO $ sendApnsResponse APNSRespOk
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
-      getMockNotification apns tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
+      atomically $ readTBQueue apnsQ
     _ <- ntfData' .-> "verification"
     _ <- C.cbNonce <$> ntfData' .-> "nonce"
+    liftIO $ sendApnsResponse' APNSRespOk
     -- can still use the first verification code, it is the same after decryption
     verifyNtfToken a tkn nonce verification
     NTActive <- checkNtfToken a tkn
     pure ()
 
 testNtfTokenSecondRegistration :: APNSMockServer -> IO ()
-testNtfTokenSecondRegistration apns =
+testNtfTokenSecondRegistration APNSMockServer {apnsQ} =
   -- setLogLevel LogError -- LogDebug
   -- withGlobalLogging logCfg $ do
   withAgentClients2 $ \a a' -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
-      getMockNotification apns tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+      atomically $ readTBQueue apnsQ
     verification <- ntfData .-> "verification"
     nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    liftIO $ sendApnsResponse APNSRespOk
     verifyNtfToken a tkn nonce verification
 
     NTRegistered <- registerNtfToken a' tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
-      getMockNotification apns tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
+      atomically $ readTBQueue apnsQ
     verification' <- ntfData' .-> "verification"
     nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
+    liftIO $ sendApnsResponse' APNSRespOk
 
     -- at this point the first token is still active
     NTActive <- checkNtfToken a tkn
@@ -259,13 +265,14 @@ testNtfTokenSecondRegistration apns =
     pure ()
 
 testNtfTokenServerRestart :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestart t apns = do
+testNtfTokenServerRestart t APNSMockServer {apnsQ} = do
   let tkn = DeviceToken PPApnsTest "abcd"
   ntfData <- withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
-        getMockNotification apns tkn
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
       pure ntfData
   -- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server
   threadDelay 1000000
@@ -280,13 +287,14 @@ testNtfTokenServerRestart t apns = do
       pure ()
 
 testNtfTokenServerRestartReverify :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReverify t apns = do
+testNtfTokenServerRestartReverify t APNSMockServer {apnsQ} = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a -> do
     ntfData <- withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
-        getMockNotification apns tkn
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
       pure ntfData
     runRight_ $ do
       verification <- ntfData .-> "verification"
@@ -303,13 +311,14 @@ testNtfTokenServerRestartReverify t apns = do
       pure ()
 
 testNtfTokenServerRestartReverifyTimeout :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReverifyTimeout t apns = do
+testNtfTokenServerRestartReverifyTimeout t APNSMockServer {apnsQ} = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
     (nonce, verification) <- withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
-        getMockNotification apns tkn
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
       verification <- ntfData .-> "verification"
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a tkn nonce verification
@@ -338,14 +347,14 @@ testNtfTokenServerRestartReverifyTimeout t apns = do
       pure ()
 
 testNtfTokenServerRestartReregister :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReregister t apns = do
+testNtfTokenServerRestartReregister t APNSMockServer {apnsQ} = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <-
-        getMockNotification apns tkn
-      pure ()
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
   -- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server
   threadDelay 1000000
   withAgent 2 agentCfg initAgentServers testDB $ \a' ->
@@ -353,8 +362,9 @@ testNtfTokenServerRestartReregister t apns = do
     -- so that repeat registration happens when client is restarted.
     withNtfServerStoreLog t $ \_ -> runRight_ $ do
       NTRegistered <- registerNtfToken a' tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
-        getMockNotification apns tkn
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
       verification <- ntfData .-> "verification"
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a' tkn nonce verification
@@ -362,14 +372,14 @@ testNtfTokenServerRestartReregister t apns = do
       pure ()
 
 testNtfTokenServerRestartReregisterTimeout :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReregisterTimeout t apns = do
+testNtfTokenServerRestartReregisterTimeout t APNSMockServer {apnsQ} = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
     withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <-
-        getMockNotification apns tkn
-      pure ()
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
     -- this emulates the situation when server registered token but the client did not receive the response
     withTransaction store $ \db ->
       DB.execute
@@ -388,8 +398,9 @@ testNtfTokenServerRestartReregisterTimeout t apns = do
     -- so that repeat registration happens when client is restarted.
     withNtfServerStoreLog t $ \_ -> runRight_ $ do
       NTRegistered <- registerNtfToken a' tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
-        getMockNotification apns tkn
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+        atomically $ readTBQueue apnsQ
+      liftIO $ sendApnsResponse APNSRespOk
       verification <- ntfData .-> "verification"
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a' tkn nonce verification
@@ -403,17 +414,18 @@ getTestNtfTokenPort a =
     Nothing -> error "no active NtfToken"
 
 testNtfTokenMultipleServers :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenMultipleServers t apns = do
+testNtfTokenMultipleServers t APNSMockServer {apnsQ} = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers2 testDB $ \a ->
     withNtfServerThreadOn t ntfTestPort $ \ntf ->
       withNtfServerThreadOn t ntfTestPort2 $ \ntf2 -> runRight_ $ do
         -- register a new token, the agent picks a server and stores its choice
         NTRegistered <- registerNtfToken a tkn NMPeriodic
-        APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
-          getMockNotification apns tkn
+        APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+          atomically $ readTBQueue apnsQ
         verification <- ntfData .-> "verification"
         nonce <- C.cbNonce <$> ntfData .-> "nonce"
+        liftIO $ sendApnsResponse APNSRespOk
         verifyNtfToken a tkn nonce verification
         NTActive <- checkNtfToken a tkn
         -- shut down the "other" server
@@ -427,10 +439,10 @@ testNtfTokenMultipleServers t apns = do
         pure ()
 
 testNtfTokenChangeServers :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenChangeServers t apns =
+testNtfTokenChangeServers t APNSMockServer {apnsQ} =
   withNtfServerThreadOn t ntfTestPort $ \ntf -> do
     tkn1 <- withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight $ do
-      tkn <- registerTestToken a "abcd" NMInstant apns
+      tkn <- registerTestToken a "abcd" NMInstant apnsQ
       NTActive <- checkNtfToken a tkn
       liftIO $ setNtfServers a [testNtfServer2]
       NTActive <- checkNtfToken a tkn -- still works on old server
@@ -445,15 +457,15 @@ testNtfTokenChangeServers t apns =
         liftIO $ setNtfServers a [testNtfServer2] -- just change configured server list
         getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort -- not yet changed
         -- trigger token replace
-        tkn2 <- registerTestToken a "xyzw" NMInstant apns
+        tkn2 <- registerTestToken a "xyzw" NMInstant apnsQ
         getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort -- not yet changed
         deleteNtfToken a tkn2 -- force server switch
-        Left BROKER {brokerErr = NETWORK} <- tryError $ registerTestToken a "qwer" NMInstant apns -- ok, it's down for now
+        Left BROKER {brokerErr = NETWORK} <- tryError $ registerTestToken a "qwer" NMInstant apnsQ -- ok, it's down for now
         getTestNtfTokenPort a >>= \port2 -> liftIO $ port2 `shouldBe` ntfTestPort2 -- but the token got updated
       killThread ntf
       withNtfServerOn t ntfTestPort2 $ runRight_ $ do
         liftIO $ threadDelay 1000000 -- for notification server to reconnect
-        tkn <- registerTestToken a "qwer" NMInstant apns
+        tkn <- registerTestToken a "qwer" NMInstant apnsQ
         checkNtfToken a tkn >>= \r -> liftIO $ r `shouldBe` NTActive
 
 testRunNTFServerTests :: ATransport -> NtfServer -> IO (Maybe ProtocolTestFailure)
@@ -463,7 +475,7 @@ testRunNTFServerTests t srv =
       testProtocolServer a 1 $ ProtoServerWithAuth srv Nothing
 
 testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
-testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
+testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
   (bobId, aliceId, nonce, message) <- runRight $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -476,10 +488,11 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
     -- register notification token
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken alice tkn NMInstant
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
-      getMockNotification apns tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+      atomically $ readTBQueue apnsQ
     verification <- ntfData .-> "verification"
     vNonce <- C.cbNonce <$> ntfData .-> "nonce"
+    liftIO $ sendApnsResponse APNSRespOk
     verifyNtfToken alice tkn vNonce verification
     NTActive <- checkNtfToken alice tkn
     -- send message
@@ -487,7 +500,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
     -- notification
-    (nonce, message) <- messageNotification apns tkn
+    (nonce, message) <- messageNotification apnsQ
     pure (bobId, aliceId, nonce, message)
 
   -- alice client already has subscription for the connection
@@ -520,64 +533,65 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
     2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
     get bob ##> ("", aliceId, SENT $ baseId + 2)
     -- no notifications should follow
-    noNotification alice apns
+    noNotification apnsQ
   where
     msgId = subtract baseId
 
 testNotificationSubscriptionNewConnection :: HasCallStack => APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
-testNotificationSubscriptionNewConnection apns baseId alice bob =
+testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} baseId alice bob =
   runRight_ $ do
     -- alice registers notification token
-    DeviceToken {} <- registerTestToken alice "abcd" NMInstant apns
+    DeviceToken {} <- registerTestToken alice "abcd" NMInstant apnsQ
     -- bob registers notification token
-    DeviceToken {} <- registerTestToken bob "bcde" NMInstant apns
+    DeviceToken {} <- registerTestToken bob "bcde" NMInstant apnsQ
     -- establish connection
     liftIO $ threadDelay 50000
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
     liftIO $ threadDelay 1000000
     (aliceId, _sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
     liftIO $ threadDelay 750000
-    void $ messageNotificationData alice apns
+    void $ messageNotificationData alice apnsQ
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     liftIO $ threadDelay 500000
     allowConnection alice bobId confId "alice's connInfo"
-    void $ messageNotificationData bob apns
+    void $ messageNotificationData bob apnsQ
     get bob ##> ("", aliceId, INFO "alice's connInfo")
-    when (baseId == 3) $ void $ messageNotificationData alice apns
+    when (baseId == 3) $ void $ messageNotificationData alice apnsQ
     get alice ##> ("", bobId, CON)
-    when (baseId == 3) $ void $ messageNotificationData bob apns
+    when (baseId == 3) $ void $ messageNotificationData bob apnsQ
     get bob ##> ("", aliceId, CON)
     -- bob sends message
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
-    void $ messageNotificationData alice apns
+    void $ messageNotificationData alice apnsQ
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 1) Nothing
     -- alice sends message
     2 <- msgId <$> sendMessage alice bobId (SMP.MsgFlags True) "hey there"
     get alice ##> ("", bobId, SENT $ baseId + 2)
-    void $ messageNotificationData bob apns
+    void $ messageNotificationData bob apnsQ
     get bob =##> \case ("", c, Msg "hey there") -> c == aliceId; _ -> False
     ackMessage bob aliceId (baseId + 2) Nothing
     -- no unexpected notifications should follow
-    noNotifications apns
+    noNotification apnsQ
   where
     msgId = subtract baseId
 
-registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> APNSMockServer -> ExceptT AgentErrorType IO DeviceToken
-registerTestToken a token mode apns = do
+registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO DeviceToken
+registerTestToken a token mode apnsQ = do
   let tkn = DeviceToken PPApnsTest token
   NTRegistered <- registerNtfToken a tkn mode
-  Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
-    timeout 1000000 $ getMockNotification apns tkn
+  Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
+    timeout 1000000 . atomically $ readTBQueue apnsQ
   verification' <- ntfData' .-> "verification"
   nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
+  liftIO $ sendApnsResponse' APNSRespOk
   verifyNtfToken a tkn nonce' verification'
   NTActive <- checkNtfToken a tkn
   pure tkn
 
-testChangeNotificationsMode :: HasCallStack => APNSMockServer -> IO ()
-testChangeNotificationsMode apns =
+testChangeNotificationsMode :: APNSMockServer -> IO ()
+testChangeNotificationsMode APNSMockServer {apnsQ} =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -589,12 +603,12 @@ testChangeNotificationsMode apns =
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, CON)
     -- register notification token, set mode to NMInstant
-    tkn <- registerTestToken alice "abcd" NMInstant apns
+    tkn <- registerTestToken alice "abcd" NMInstant apnsQ
     -- send message, receive notification
     liftIO $ threadDelay 500000
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
-    void $ messageNotificationData alice apns
+    void $ messageNotificationData alice apnsQ
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 1) Nothing
     -- set mode to NMPeriodic
@@ -603,7 +617,7 @@ testChangeNotificationsMode apns =
     liftIO $ threadDelay 750000
     2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
     get bob ##> ("", aliceId, SENT $ baseId + 2)
-    noNotification alice apns
+    noNotification apnsQ
     get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 2) Nothing
     -- set mode to NMInstant
@@ -612,7 +626,7 @@ testChangeNotificationsMode apns =
     liftIO $ threadDelay 500000
     3 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello there"
     get bob ##> ("", aliceId, SENT $ baseId + 3)
-    void $ messageNotificationData alice apns
+    void $ messageNotificationData alice apnsQ
     get alice =##> \case ("", c, Msg "hello there") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 3) Nothing
     -- turn off notifications
@@ -621,26 +635,26 @@ testChangeNotificationsMode apns =
     liftIO $ threadDelay 500000
     4 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "why hello there"
     get bob ##> ("", aliceId, SENT $ baseId + 4)
-    noNotifications apns
+    noNotification apnsQ
     get alice =##> \case ("", c, Msg "why hello there") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 4) Nothing
     -- turn on notifications, set mode to NMInstant
-    void $ registerTestToken alice "abcd" NMInstant apns
+    void $ registerTestToken alice "abcd" NMInstant apnsQ
     -- send message, receive notification
     liftIO $ threadDelay 500000
     5 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hey"
     get bob ##> ("", aliceId, SENT $ baseId + 5)
-    void $ messageNotificationData alice apns
+    void $ messageNotificationData alice apnsQ
     get alice =##> \case ("", c, Msg "hey") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 5) Nothing
     -- no notifications should follow
-    noNotification alice apns
+    noNotification apnsQ
   where
     baseId = 1
     msgId = subtract baseId
 
 testChangeToken :: APNSMockServer -> IO ()
-testChangeToken apns = withAgent 1 agentCfg initAgentServers testDB2 $ \bob -> do
+testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers testDB2 $ \bob -> do
   (aliceId, bobId) <- withAgent 2 agentCfg initAgentServers testDB $ \alice -> runRight $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -652,12 +666,12 @@ testChangeToken apns = withAgent 1 agentCfg initAgentServers testDB2 $ \bob -> d
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, CON)
     -- register notification token, set mode to NMInstant
-    void $ registerTestToken alice "abcd" NMInstant apns
+    void $ registerTestToken alice "abcd" NMInstant apnsQ
     -- send message, receive notification
     liftIO $ threadDelay 500000
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
-    void $ messageNotificationData alice apns
+    void $ messageNotificationData alice apnsQ
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 1) Nothing
     pure (aliceId, bobId)
@@ -665,66 +679,53 @@ testChangeToken apns = withAgent 1 agentCfg initAgentServers testDB2 $ \bob -> d
   withAgent 3 agentCfg initAgentServers testDB $ \alice1 -> runRight_ $ do
     subscribeConnection alice1 bobId
     -- change notification token
-    void $ registerTestToken alice1 "bcde" NMInstant apns
+    void $ registerTestToken alice1 "bcde" NMInstant apnsQ
     -- send message, receive notification
     liftIO $ threadDelay 500000
     2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello there"
     get bob ##> ("", aliceId, SENT $ baseId + 2)
-    void $ messageNotificationData alice1 apns
+    void $ messageNotificationData alice1 apnsQ
     get alice1 =##> \case ("", c, Msg "hello there") -> c == bobId; _ -> False
     ackMessage alice1 bobId (baseId + 2) Nothing
     -- no notifications should follow
-    noNotification alice1 apns
+    noNotification apnsQ
   where
     baseId = 1
     msgId = subtract baseId
 
 testNotificationsStoreLog :: ATransport -> APNSMockServer -> IO ()
-testNotificationsStoreLog t apns = withAgentClients2 $ \alice bob -> do
-  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
-    (aliceId, bobId) <- withNtfServerStoreLog t $ \threadId -> runRight $ do
-      (aliceId, bobId) <- makeConnection alice bob
-      _ <- registerTestToken alice "abcd" NMInstant apns
-      liftIO $ threadDelay 250000
-      2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
-      get bob ##> ("", aliceId, SENT 2)
-      void $ messageNotificationData alice apns
-      get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
-      ackMessage alice bobId 2 Nothing
-      liftIO $ killThread threadId
-      pure (aliceId, bobId)
-
-    liftIO $ threadDelay 250000
-
-    withNtfServerStoreLog t $ \threadId -> runRight_ $ do
-      liftIO $ threadDelay 250000
-      3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
-      get bob ##> ("", aliceId, SENT 3)
-      void $ messageNotificationData alice apns
-      get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
-      ackMessage alice bobId 3 Nothing
-      liftIO $ killThread threadId
-
-    runRight_ $ do
-      4 <- sendMessage bob aliceId (SMP.MsgFlags True) "message 4"
-      get bob ##> ("", aliceId, SENT 4)
-      get alice =##> \case ("", c, Msg "message 4") -> c == bobId; _ -> False
-      ackMessage alice bobId 4 Nothing
-      noNotifications apns
-
-  withSmpServerStoreMsgLogOn t testPort $ \_ ->
-    withNtfServerStoreLog t $ \_ -> runRight_ $ do
-      void $ messageNotificationData alice apns
-
-testNotificationsSMPRestart :: ATransport -> APNSMockServer -> IO ()
-testNotificationsSMPRestart t apns = withAgentClients2 $ \alice bob -> do
-  (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \threadId -> runRight $ do
+testNotificationsStoreLog t APNSMockServer {apnsQ} = withAgentClients2 $ \alice bob -> do
+  (aliceId, bobId) <- withNtfServerStoreLog t $ \threadId -> runRight $ do
     (aliceId, bobId) <- makeConnection alice bob
-    _ <- registerTestToken alice "abcd" NMInstant apns
+    _ <- registerTestToken alice "abcd" NMInstant apnsQ
     liftIO $ threadDelay 250000
     2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT 2)
-    void $ messageNotificationData alice apns
+    void $ messageNotificationData alice apnsQ
+    get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
+    ackMessage alice bobId 2 Nothing
+    liftIO $ killThread threadId
+    pure (aliceId, bobId)
+
+  liftIO $ threadDelay 250000
+
+  withNtfServerStoreLog t $ \threadId -> runRight_ $ do
+    liftIO $ threadDelay 250000
+    3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
+    get bob ##> ("", aliceId, SENT 3)
+    void $ messageNotificationData alice apnsQ
+    get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
+    liftIO $ killThread threadId
+
+testNotificationsSMPRestart :: ATransport -> APNSMockServer -> IO ()
+testNotificationsSMPRestart t APNSMockServer {apnsQ} = withAgentClients2 $ \alice bob -> do
+  (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \threadId -> runRight $ do
+    (aliceId, bobId) <- makeConnection alice bob
+    _ <- registerTestToken alice "abcd" NMInstant apnsQ
+    liftIO $ threadDelay 250000
+    2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
+    get bob ##> ("", aliceId, SENT 2)
+    void $ messageNotificationData alice apnsQ
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId 2 Nothing
     liftIO $ killThread threadId
@@ -740,22 +741,22 @@ testNotificationsSMPRestart t apns = withAgentClients2 $ \alice bob -> do
     liftIO $ threadDelay 1000000
     3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
     get bob ##> ("", aliceId, SENT 3)
-    _ <- messageNotificationData alice apns
+    _ <- messageNotificationData alice apnsQ
     get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
     liftIO $ killThread threadId
 
 testNotificationsSMPRestartBatch :: Int -> ATransport -> APNSMockServer -> IO ()
-testNotificationsSMPRestartBatch n t apns =
+testNotificationsSMPRestartBatch n t APNSMockServer {apnsQ} =
   withAgentClientsCfgServers2 agentCfg agentCfg initAgentServers2 $ \a b -> do
     threadDelay 1000000
     conns <- runServers $ do
       conns <- replicateM (n :: Int) $ makeConnection a b
-      _ <- registerTestToken a "abcd" NMInstant apns
+      _ <- registerTestToken a "abcd" NMInstant apnsQ
       liftIO $ threadDelay 5000000
       forM_ conns $ \(aliceId, bobId) -> do
         msgId <- sendMessage b aliceId (SMP.MsgFlags True) "hello"
         get b ##> ("", aliceId, SENT msgId)
-        void $ messageNotificationData a apns
+        void $ messageNotificationData a apnsQ
         get a =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
         ackMessage a bobId msgId Nothing
       pure conns
@@ -779,7 +780,7 @@ testNotificationsSMPRestartBatch n t apns =
       forM_ conns $ \(aliceId, bobId) -> do
         msgId <- sendMessage b aliceId (SMP.MsgFlags True) "hello again"
         get b ##> ("", aliceId, SENT msgId)
-        _ <- messageNotificationData a apns
+        _ <- messageNotificationData a apnsQ
         get a =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
   where
     runServers :: ExceptT AgentErrorType IO a -> IO a
@@ -791,16 +792,16 @@ testNotificationsSMPRestartBatch n t apns =
         pure res
 
 testSwitchNotifications :: InitialAgentServers -> APNSMockServer -> IO ()
-testSwitchNotifications servers apns =
+testSwitchNotifications servers APNSMockServer {apnsQ} =
   withAgentClientsCfgServers2 agentCfg agentCfg servers $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
     exchangeGreetings a bId b aId
-    _ <- registerTestToken a "abcd" NMInstant apns
+    _ <- registerTestToken a "abcd" NMInstant apnsQ
     liftIO $ threadDelay 250000
     let testMessage msg = do
           msgId <- sendMessage b aId (SMP.MsgFlags True) msg
           get b ##> ("", aId, SENT msgId)
-          void $ messageNotificationData a apns
+          void $ messageNotificationData a apnsQ
           get a =##> \case ("", c, Msg msg') -> c == bId && msg == msg'; _ -> False
           ackMessage a bId msgId Nothing
     testMessage "hello"
@@ -810,80 +811,74 @@ testSwitchNotifications servers apns =
     testMessage "hello again"
 
 testNotificationsOldToken :: APNSMockServer -> IO ()
-testNotificationsOldToken apns =
+testNotificationsOldToken APNSMockServer {apnsQ} =
   withAgentClients3 $ \a b c -> runRight_ $ do
     (abId, baId) <- makeConnection a b
-    let testMessageAB = testMessage_ apns a abId b baId
-    _ <- registerTestToken a "abcd" NMInstant apns
+    let testMessageAB = testMessage_ apnsQ a abId b baId
+    _ <- registerTestToken a "abcd" NMInstant apnsQ
     liftIO $ threadDelay 250000
     testMessageAB "hello"
     -- change server
     liftIO $ setNtfServers a [testNtfServer2] -- server 2 isn't running now, don't use
     -- replacing token keeps server
-    _ <- registerTestToken a "xyzw" NMInstant apns
+    _ <- registerTestToken a "xyzw" NMInstant apnsQ
     getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort
     testMessageAB "still there"
     -- new connections keep server
     (acId, caId) <- makeConnection a c
-    let testMessageAC = testMessage_ apns a acId c caId
+    let testMessageAC = testMessage_ apnsQ a acId c caId
     testMessageAC "greetings"
 
 testNotificationsNewToken :: APNSMockServer -> ThreadId -> IO ()
-testNotificationsNewToken apns oldNtf =
+testNotificationsNewToken APNSMockServer {apnsQ} oldNtf =
   withAgentClients3 $ \a b c -> runRight_ $ do
     (abId, baId) <- makeConnection a b
-    let testMessageAB = testMessage_ apns a abId b baId
-    tkn <- registerTestToken a "abcd" NMInstant apns
+    let testMessageAB = testMessage_ apnsQ a abId b baId
+    tkn <- registerTestToken a "abcd" NMInstant apnsQ
     getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort
     liftIO $ threadDelay 250000
     testMessageAB "hello"
     -- switch
     liftIO $ setNtfServers a [testNtfServer2]
     deleteNtfToken a tkn
-    _ <- registerTestToken a "abcd" NMInstant apns
+    _ <- registerTestToken a "abcd" NMInstant apnsQ
     getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort2
     liftIO $ threadDelay 250000
     liftIO $ killThread oldNtf
     -- -- back to work
     testMessageAB "hello again"
     (acId, caId) <- makeConnection a c
-    let testMessageAC = testMessage_ apns a acId c caId
+    let testMessageAC = testMessage_ apnsQ a acId c caId
     testMessageAC "greetings"
 
-testMessage_ :: HasCallStack => APNSMockServer -> AgentClient -> ConnId -> AgentClient -> ConnId -> SMP.MsgBody -> ExceptT AgentErrorType IO ()
-testMessage_ apns a aId b bId msg = do
+testMessage_ :: HasCallStack => TBQueue APNSMockRequest -> AgentClient -> ConnId -> AgentClient -> ConnId -> SMP.MsgBody -> ExceptT AgentErrorType IO ()
+testMessage_ apnsQ a aId b bId msg = do
   msgId <- sendMessage b aId (SMP.MsgFlags True) msg
   get b ##> ("", aId, SENT msgId)
-  void $ messageNotificationData a apns
+  void $ messageNotificationData a apnsQ
   get a =##> \case ("", c, Msg msg') -> c == bId && msg == msg'; _ -> False
   ackMessage a bId msgId Nothing
 
-messageNotification :: HasCallStack => APNSMockServer -> DeviceToken -> ExceptT AgentErrorType IO (C.CbNonce, ByteString)
-messageNotification apns tkn = do
-  500000 `timeout` getMockNotification apns tkn >>= \case
+messageNotification :: HasCallStack => TBQueue APNSMockRequest -> ExceptT AgentErrorType IO (C.CbNonce, ByteString)
+messageNotification apnsQ = do
+  1000000 `timeout` atomically (readTBQueue apnsQ) >>= \case
     Nothing -> error "no notification"
-    Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}} -> do
+    Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}, sendApnsResponse} -> do
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       message <- ntfData .-> "message"
+      liftIO $ sendApnsResponse APNSRespOk
       pure (nonce, message)
     _ -> error "bad notification"
 
-messageNotificationData :: HasCallStack => AgentClient -> APNSMockServer -> ExceptT AgentErrorType IO PNMessageData
-messageNotificationData c apns = do
-  NtfToken {deviceToken, ntfDhSecret = Just dhSecret} <- getNtfTokenData c
-  (nonce, message) <- messageNotification apns deviceToken
+messageNotificationData :: HasCallStack => AgentClient -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO PNMessageData
+messageNotificationData c apnsQ = do
+  (nonce, message) <- messageNotification apnsQ
+  NtfToken {ntfDhSecret = Just dhSecret} <- getNtfTokenData c
   Right pnMsgs <- liftEither . first INTERNAL $ Right . parseAll pnMessagesP =<< first show (C.cbDecrypt dhSecret nonce message)
   pure $ L.last pnMsgs
 
-noNotification :: AgentClient -> APNSMockServer -> ExceptT AgentErrorType IO ()
-noNotification c apns = do
-  NtfToken {deviceToken} <- getNtfTokenData c
-  500000 `timeout` getMockNotification apns deviceToken >>= \case
-    Nothing -> pure ()
-    _ -> error "unexpected notification"
-
-noNotifications :: APNSMockServer -> ExceptT AgentErrorType IO ()
-noNotifications apns = do
-  500000 `timeout` getAnyMockNotification apns >>= \case
+noNotification :: TBQueue APNSMockRequest -> ExceptT AgentErrorType IO ()
+noNotification apnsQ = do
+  500000 `timeout` atomically (readTBQueue apnsQ) >>= \case
     Nothing -> pure ()
     _ -> error "unexpected notification"
diff --git a/tests/CoreTests/BatchingTests.hs b/tests/CoreTests/BatchingTests.hs
index e2427b565..a12cbf1ea 100644
--- a/tests/CoreTests/BatchingTests.hs
+++ b/tests/CoreTests/BatchingTests.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -15,13 +14,11 @@ import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString as B
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.List.NonEmpty as L
-import Data.Time.Clock.System (SystemTime, getSystemTime)
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
 import qualified Data.X509.File as XF
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport
 import Test.Hspec
@@ -29,30 +26,29 @@ import Test.Hspec
 batchingTests :: Spec
 batchingTests = do
   describe "batchTransmissions" $ do
-    describe "SMP v6 (previous)" $ do
-      it "should batch with 107 subscriptions per batch" testBatchSubscriptionsV6
-      it "should break on message that does not fit" testBatchWithMessageV6
-      it "should break on large message" testBatchWithLargeMessageV6
-    describe "SMP current" $ do
-      it "should batch with 136 subscriptions per batch" testBatchSubscriptions
+    describe "SMP v6 (current)" $ do
+      it "should batch with 107 subscriptions per batch" testBatchSubscriptions
       it "should break on message that does not fit" testBatchWithMessage
       it "should break on large message" testBatchWithLargeMessage
+    describe "v7 (next)" $ do
+      it "should batch with 136 subscriptions per batch" testBatchSubscriptionsV7
+      it "should break on message that does not fit" testBatchWithMessageV7
+      it "should break on large message" testBatchWithLargeMessageV7
   describe "batchTransmissions'" $ do
-    describe "SMP v6 (previous)" $ do
-      it "should batch with 107 subscriptions per batch" testClientBatchSubscriptionsV6
-      it "should break on message that does not fit" testClientBatchWithMessageV6
-      it "should break on large message" testClientBatchWithLargeMessageV6
-    describe "SMP current" $ do
-      it "should batch with 136 subscriptions per batch" testClientBatchSubscriptions
-      it "should batch with 255 ENDs per batch" testClientBatchENDs
-      it "should batch with 80 NMSGs per batch" testClientBatchNMSGs
+    describe "SMP v6 (current)" $ do
+      it "should batch with 107 subscriptions per batch" testClientBatchSubscriptions
       it "should break on message that does not fit" testClientBatchWithMessage
       it "should break on large message" testClientBatchWithLargeMessage
+    describe "v7 (next)" $ do
+      it "should batch with 136 subscriptions per batch" testClientBatchSubscriptionsV7
+      it "should batch with N ENDs per batch" testClientBatchENDs
+      it "should break on message that does not fit" testClientBatchWithMessageV7
+      it "should break on large message" testClientBatchWithLargeMessageV7
 
-testBatchSubscriptionsV6 :: IO ()
-testBatchSubscriptionsV6 = do
+testBatchSubscriptions :: IO ()
+testBatchSubscriptions = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs <- replicateM 250 $ randomSUBv6 sessId
+  subs <- replicateM 250 $ randomSUB sessId
   let batches1 = batchTransmissions False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   length batches1 `shouldBe` 250
@@ -62,10 +58,10 @@ testBatchSubscriptionsV6 = do
   (n1, n2, n3) `shouldBe` (36, 107, 107)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testBatchSubscriptions :: IO ()
-testBatchSubscriptions = do
+testBatchSubscriptionsV7 :: IO ()
+testBatchSubscriptionsV7 = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs <- replicateM 300 $ randomSUB sessId
+  subs <- replicateM 300 $ randomSUBv7 sessId
   let batches1 = batchTransmissions False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   length batches1 `shouldBe` 300
@@ -75,22 +71,6 @@ testBatchSubscriptions = do
   (n1, n2, n3) `shouldBe` (28, 136, 136)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testBatchWithMessageV6 :: IO ()
-testBatchWithMessageV6 = do
-  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs1 <- replicateM 60 $ randomSUBv6 sessId
-  send <- randomSENDv6 sessId 8000
-  subs2 <- replicateM 40 $ randomSUBv6 sessId
-  let cmds = subs1 <> [send] <> subs2
-      batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
-  all lenOk1 batches1 `shouldBe` True
-  length batches1 `shouldBe` 101
-  let batches = batchTransmissions True smpBlockSize $ L.fromList cmds
-  length batches `shouldBe` 2
-  [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _] <- pure batches
-  (n1, n2) `shouldBe` (47, 54)
-  all lenOk [s1, s2] `shouldBe` True
-
 testBatchWithMessage :: IO ()
 testBatchWithMessage = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
@@ -104,15 +84,31 @@ testBatchWithMessage = do
   let batches = batchTransmissions True smpBlockSize $ L.fromList cmds
   length batches `shouldBe` 2
   [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _] <- pure batches
+  (n1, n2) `shouldBe` (47, 54)
+  all lenOk [s1, s2] `shouldBe` True
+
+testBatchWithMessageV7 :: IO ()
+testBatchWithMessageV7 = do
+  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
+  subs1 <- replicateM 60 $ randomSUBv7 sessId
+  send <- randomSENDv7 sessId 8000
+  subs2 <- replicateM 40 $ randomSUBv7 sessId
+  let cmds = subs1 <> [send] <> subs2
+      batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
+  all lenOk1 batches1 `shouldBe` True
+  length batches1 `shouldBe` 101
+  let batches = batchTransmissions True smpBlockSize $ L.fromList cmds
+  length batches `shouldBe` 2
+  [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _] <- pure batches
   (n1, n2) `shouldBe` (32, 69)
   all lenOk [s1, s2] `shouldBe` True
 
-testBatchWithLargeMessageV6 :: IO ()
-testBatchWithLargeMessageV6 = do
+testBatchWithLargeMessage :: IO ()
+testBatchWithLargeMessage = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs1 <- replicateM 50 $ randomSUBv6 sessId
-  send <- randomSENDv6 sessId 17000
-  subs2 <- replicateM 150 $ randomSUBv6 sessId
+  subs1 <- replicateM 50 $ randomSUB sessId
+  send <- randomSEND sessId 17000
+  subs2 <- replicateM 150 $ randomSUB sessId
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -126,12 +122,12 @@ testBatchWithLargeMessageV6 = do
   (n1, n2, n3) `shouldBe` (50, 43, 107)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testBatchWithLargeMessage :: IO ()
-testBatchWithLargeMessage = do
+testBatchWithLargeMessageV7 :: IO ()
+testBatchWithLargeMessageV7 = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs1 <- replicateM 60 $ randomSUB sessId
-  send <- randomSEND sessId 17000
-  subs2 <- replicateM 150 $ randomSUB sessId
+  subs1 <- replicateM 60 $ randomSUBv7 sessId
+  send <- randomSENDv7 sessId 17000
+  subs2 <- replicateM 150 $ randomSUBv7 sessId
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -145,10 +141,10 @@ testBatchWithLargeMessage = do
   (n1, n2, n3) `shouldBe` (60, 14, 136)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testClientBatchSubscriptionsV6 :: IO ()
-testClientBatchSubscriptionsV6 = do
-  client <- testClientStubV6
-  subs <- replicateM 250 $ randomSUBCmdV6 client
+testClientBatchSubscriptions :: IO ()
+testClientBatchSubscriptions = do
+  client <- testClientStub
+  subs <- replicateM 250 $ randomSUBCmd client
   let batches1 = batchTransmissions' False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   let batches = batchTransmissions' True smpBlockSize $ L.fromList subs
@@ -158,10 +154,10 @@ testClientBatchSubscriptionsV6 = do
   (length rs1, length rs2, length rs3) `shouldBe` (36, 107, 107)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testClientBatchSubscriptions :: IO ()
-testClientBatchSubscriptions = do
-  client <- testClientStub
-  subs <- replicateM 300 $ randomSUBCmd client
+testClientBatchSubscriptionsV7 :: IO ()
+testClientBatchSubscriptionsV7 = do
+  client <- clientStubV7
+  subs <- replicateM 300 $ randomSUBCmdV7 client
   let batches1 = batchTransmissions' False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   let batches = batchTransmissions' True smpBlockSize $ L.fromList subs
@@ -173,7 +169,7 @@ testClientBatchSubscriptions = do
 
 testClientBatchENDs :: IO ()
 testClientBatchENDs = do
-  client <- testClientStub
+  client <- clientStubV7
   ends <- replicateM 300 randomENDCmd
   let ends' = map (\t -> Right (Nothing, encodeTransmission (thParams client) t)) ends
       batches1 = batchTransmissions False smpBlockSize $ L.fromList ends'
@@ -185,38 +181,6 @@ testClientBatchENDs = do
   (length rs1, length rs2) `shouldBe` (45, 255)
   all lenOk [s1, s2] `shouldBe` True
 
-testClientBatchNMSGs :: IO ()
-testClientBatchNMSGs = do
-  client <- testClientStub
-  ts <- getSystemTime
-  ntfs <- replicateM 200 $ randomNMSGCmd ts
-  let ntfs' = map (\t -> Right (Nothing, encodeTransmission (thParams client) t)) ntfs
-      batches1 = batchTransmissions False smpBlockSize $ L.fromList ntfs'
-  all lenOk1 batches1 `shouldBe` True
-  let batches = batchTransmissions True smpBlockSize $ L.fromList ntfs'
-  length batches `shouldBe` 3
-  [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2, TBTransmissions s3 n3 rs3] <- pure batches
-  (n1, n2, n3) `shouldBe` (40, 80, 80)
-  (length rs1, length rs2, length rs3) `shouldBe` (40, 80, 80)
-  all lenOk [s1, s2, s3] `shouldBe` True
-
-testClientBatchWithMessageV6 :: IO ()
-testClientBatchWithMessageV6 = do
-  client <- testClientStubV6
-  subs1 <- replicateM 60 $ randomSUBCmdV6 client
-  send <- randomSENDCmdV6 client 8000
-  subs2 <- replicateM 40 $ randomSUBCmdV6 client
-  let cmds = subs1 <> [send] <> subs2
-      batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
-  all lenOk1 batches1 `shouldBe` True
-  length batches1 `shouldBe` 101
-  let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds
-  length batches `shouldBe` 2
-  [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2] <- pure batches
-  (n1, n2) `shouldBe` (47, 54)
-  (length rs1, length rs2) `shouldBe` (47, 54)
-  all lenOk [s1, s2] `shouldBe` True
-
 testClientBatchWithMessage :: IO ()
 testClientBatchWithMessage = do
   client <- testClientStub
@@ -230,16 +194,33 @@ testClientBatchWithMessage = do
   let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds
   length batches `shouldBe` 2
   [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2] <- pure batches
+  (n1, n2) `shouldBe` (47, 54)
+  (length rs1, length rs2) `shouldBe` (47, 54)
+  all lenOk [s1, s2] `shouldBe` True
+
+testClientBatchWithMessageV7 :: IO ()
+testClientBatchWithMessageV7 = do
+  client <- clientStubV7
+  subs1 <- replicateM 60 $ randomSUBCmdV7 client
+  send <- randomSENDCmdV7 client 8000
+  subs2 <- replicateM 40 $ randomSUBCmdV7 client
+  let cmds = subs1 <> [send] <> subs2
+      batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
+  all lenOk1 batches1 `shouldBe` True
+  length batches1 `shouldBe` 101
+  let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds
+  length batches `shouldBe` 2
+  [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2] <- pure batches
   (n1, n2) `shouldBe` (32, 69)
   (length rs1, length rs2) `shouldBe` (32, 69)
   all lenOk [s1, s2] `shouldBe` True
 
-testClientBatchWithLargeMessageV6 :: IO ()
-testClientBatchWithLargeMessageV6 = do
-  client <- testClientStubV6
-  subs1 <- replicateM 50 $ randomSUBCmdV6 client
-  send <- randomSENDCmdV6 client 17000
-  subs2 <- replicateM 150 $ randomSUBCmdV6 client
+testClientBatchWithLargeMessage :: IO ()
+testClientBatchWithLargeMessage = do
+  client <- testClientStub
+  subs1 <- replicateM 50 $ randomSUBCmd client
+  send <- randomSENDCmd client 17000
+  subs2 <- replicateM 150 $ randomSUBCmd client
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -263,12 +244,12 @@ testClientBatchWithLargeMessageV6 = do
   (length rs1', length rs2') `shouldBe` (93, 107)
   all lenOk [s1', s2'] `shouldBe` True
 
-testClientBatchWithLargeMessage :: IO ()
-testClientBatchWithLargeMessage = do
-  client <- testClientStub
-  subs1 <- replicateM 60 $ randomSUBCmd client
-  send <- randomSENDCmd client 17000
-  subs2 <- replicateM 150 $ randomSUBCmd client
+testClientBatchWithLargeMessageV7 :: IO ()
+testClientBatchWithLargeMessageV7 = do
+  client <- clientStubV7
+  subs1 <- replicateM 60 $ randomSUBCmdV7 client
+  send <- randomSENDCmdV7 client 17000
+  subs2 <- replicateM 150 $ randomSUBCmdV7 client
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -292,25 +273,25 @@ testClientBatchWithLargeMessage = do
   (length rs1', length rs2') `shouldBe` (74, 136)
   all lenOk [s1', s2'] `shouldBe` True
 
-testClientStubV6 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
-testClientStubV6 = do
-  g <- C.newRandom
-  sessId <- atomically $ C.randomBytes 32 g
-  smpClientStub g sessId subModeSMPVersion Nothing
-
 testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
 testClientStub = do
   g <- C.newRandom
   sessId <- atomically $ C.randomBytes 32 g
-  (rKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
-  thAuth_ <- testTHandleAuth currentClientSMPRelayVersion g rKey
-  smpClientStub g sessId currentClientSMPRelayVersion thAuth_
+  smpClientStub g sessId subModeSMPVersion Nothing
 
-randomSUBv6 :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSUBv6 = randomSUB_ C.SEd25519 subModeSMPVersion
+clientStubV7 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
+clientStubV7 = do
+  g <- C.newRandom
+  sessId <- atomically $ C.randomBytes 32 g
+  (rKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
+  thAuth_ <- testTHandleAuth authCmdsSMPVersion g rKey
+  smpClientStub g sessId authCmdsSMPVersion thAuth_
 
 randomSUB :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSUB = randomSUB_ C.SEd25519 currentClientSMPRelayVersion
+randomSUB = randomSUB_ C.SEd25519 subModeSMPVersion
+
+randomSUBv7 :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
+randomSUBv7 = randomSUB_ C.SEd25519 authCmdsSMPVersion
 
 randomSUB_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> VersionSMP -> ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSUB_ a v sessId = do
@@ -323,11 +304,11 @@ randomSUB_ a v sessId = do
       TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId rId, Cmd SRecipient SUB)
   pure $ (,tToSend) <$> authTransmission thAuth_ (Just rpKey) nonce tForAuth
 
-randomSUBCmdV6 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
-randomSUBCmdV6 = randomSUBCmd_ C.SEd25519
-
 randomSUBCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
-randomSUBCmd = randomSUBCmd_ C.SEd25519 -- same as v6
+randomSUBCmd = randomSUBCmd_ C.SEd25519
+
+randomSUBCmdV7 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
+randomSUBCmdV7 = randomSUBCmd_ C.SEd25519 -- same as v6
 
 randomSUBCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
 randomSUBCmd_ a c = do
@@ -342,22 +323,11 @@ randomENDCmd = do
   rId <- atomically $ C.randomBytes 24 g
   pure (CorrId "", EntityId rId, END)
 
-randomNMSGCmd :: SystemTime -> IO (Transmission BrokerMsg)
-randomNMSGCmd ts = do
-  g <- C.newRandom
-  nId <- atomically $ C.randomBytes 24 g
-  msgId <- atomically $ C.randomBytes 24 g
-  (k, pk) <- atomically $ C.generateKeyPair g
-  nonce <- atomically $ C.randomCbNonce g
-  let msgMeta = NMsgMeta {msgId, msgTs = ts}
-  Right encNMsgMeta <- pure $ C.cbEncrypt (C.dh' k pk) nonce (smpEncode msgMeta) 128
-  pure (CorrId "", EntityId nId, NMSG nonce encNMsgMeta)
-
-randomSENDv6 :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSENDv6 = randomSEND_ C.SEd25519 subModeSMPVersion
-
 randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSEND = randomSEND_ C.SX25519 currentClientSMPRelayVersion
+randomSEND = randomSEND_ C.SEd25519 subModeSMPVersion
+
+randomSENDv7 :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
+randomSENDv7 = randomSEND_ C.SX25519 authCmdsSMPVersion
 
 randomSEND_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> VersionSMP -> ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSEND_ a v sessId len = do
@@ -395,11 +365,11 @@ testTHandleAuth v g (C.APublicAuthKey a serverPeerPubKey) = case a of
     pure $ Just THAuthClient {serverPeerPubKey, serverCertKey, sessSecret = Nothing}
   _ -> pure Nothing
 
-randomSENDCmdV6 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
-randomSENDCmdV6 = randomSENDCmd_ C.SEd25519
-
 randomSENDCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
-randomSENDCmd = randomSENDCmd_ C.SX25519
+randomSENDCmd = randomSENDCmd_ C.SEd25519
+
+randomSENDCmdV7 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
+randomSENDCmdV7 = randomSENDCmd_ C.SX25519
 
 randomSENDCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
 randomSENDCmd_ a c len = do
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index 6c38af721..87ff797f0 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -7,7 +7,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
@@ -15,18 +14,14 @@
 
 module NtfClient where
 
-import Control.Concurrent.STM (retry)
 import Control.Monad
 import Control.Monad.Except (runExceptT)
-import Control.Monad.IO.Class
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Types as JT
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
 import Data.List.NonEmpty (NonEmpty)
-import qualified Data.Map.Strict as M
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Network.HTTP.Types (Status)
@@ -38,14 +33,13 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost,
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfResponse)
+import Simplex.Messaging.Notifications.Protocol (NtfResponse)
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
 import Simplex.Messaging.Notifications.Server.Env
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
 import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol
-import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), http2TLSParams)
@@ -89,9 +83,9 @@ ntfServerCfg =
     { transports = [],
       subIdBytes = 24,
       regCodeBytes = 32,
-      clientQSize = 2,
-      subQSize = 2,
-      pushQSize = 2,
+      clientQSize = 1,
+      subQSize = 1,
+      pushQSize = 1,
       smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 0},
       apnsConfig =
         defaultAPNSPushClientConfig
@@ -130,7 +124,7 @@ ntfServerCfgVPrev =
 withNtfServerStoreLog :: ATransport -> (ThreadId -> IO a) -> IO a
 withNtfServerStoreLog t = withNtfServerCfg ntfServerCfg {storeLogFile = Just ntfTestStoreLogFile, transports = [(ntfTestPort, t, False)]}
 
-withNtfServerThreadOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
+withNtfServerThreadOn :: ATransport -> ServiceName -> (ThreadId -> IO a) -> IO a
 withNtfServerThreadOn t port' = withNtfServerCfg ntfServerCfg {transports = [(port', t, False)]}
 
 withNtfServerCfg :: HasCallStack => NtfServerConfig -> (ThreadId -> IO a) -> IO a
@@ -142,10 +136,10 @@ withNtfServerCfg cfg@NtfServerConfig {transports} =
         (\started -> runNtfServerBlocking started cfg)
         (pure ())
 
-withNtfServerOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => IO a) -> IO a
+withNtfServerOn :: ATransport -> ServiceName -> IO a -> IO a
 withNtfServerOn t port' = withNtfServerThreadOn t port' . const
 
-withNtfServer :: HasCallStack => ATransport -> (HasCallStack => IO a) -> IO a
+withNtfServer :: ATransport -> IO a -> IO a
 withNtfServer t = withNtfServerOn t ntfTestPort
 
 runNtfTest :: forall c a. Transport c => (THandleNTF c 'TClient -> IO a) -> IO a
@@ -172,21 +166,22 @@ ntfTest :: Transport c => TProxy c -> (THandleNTF c 'TClient -> IO ()) -> Expect
 ntfTest _ test' = runNtfTest test' `shouldReturn` ()
 
 data APNSMockRequest = APNSMockRequest
-  { notification :: APNSNotification
+  { notification :: APNSNotification,
+    sendApnsResponse :: APNSMockResponse -> IO ()
   }
 
 data APNSMockResponse = APNSRespOk | APNSRespError Status Text
 
 data APNSMockServer = APNSMockServer
   { action :: Async (),
-    notifications :: TM.TMap ByteString (TBQueue APNSMockRequest),
+    apnsQ :: TBQueue APNSMockRequest,
     http2Server :: HTTP2Server
   }
 
 apnsMockServerConfig :: HTTP2ServerConfig
 apnsMockServerConfig =
   HTTP2ServerConfig
-    { qSize = 2,
+    { qSize = 1,
       http2Port = apnsTestPort,
       bufferSize = 16384,
       bodyHeadSize = 16384,
@@ -229,36 +224,23 @@ deriving instance ToJSON APNSErrorResponse
 getAPNSMockServer :: HTTP2ServerConfig -> IO APNSMockServer
 getAPNSMockServer config@HTTP2ServerConfig {qSize} = do
   http2Server <- getHTTP2Server config Nothing
-  notifications <- TM.emptyIO
-  action <- async $ runAPNSMockServer notifications http2Server
-  pure APNSMockServer {action, notifications, http2Server}
+  apnsQ <- newTBQueueIO qSize
+  action <- async $ runAPNSMockServer apnsQ http2Server
+  pure APNSMockServer {action, apnsQ, http2Server}
   where
-    runAPNSMockServer notifications HTTP2Server {reqQ} = forever $ do
-      HTTP2Request {request, reqBody = HTTP2Body {bodyHead}, sendResponse} <- atomically $ readTBQueue reqQ
+    runAPNSMockServer apnsQ HTTP2Server {reqQ} = forever $ do
+      HTTP2Request {reqBody = HTTP2Body {bodyHead}, sendResponse} <- atomically $ readTBQueue reqQ
       let sendApnsResponse = \case
             APNSRespOk -> sendResponse $ H.responseNoBody N.ok200 []
             APNSRespError status reason ->
               sendResponse . H.responseBuilder status [] . lazyByteString $ J.encode APNSErrorResponse {reason}
       case J.decodeStrict' bodyHead of
-        Just notification -> do
-          Just token <- pure $ B.stripPrefix "/3/device/" =<< H.requestPath request
-          q <- atomically $ TM.lookup token notifications >>= maybe (newTokenQueue token) pure
-          atomically $ writeTBQueue q APNSMockRequest {notification}
-          sendApnsResponse APNSRespOk
-          where
-            newTokenQueue token = newTBQueue qSize >>= \q -> TM.insert token q notifications >> pure q
+        Just notification ->
+          atomically $ writeTBQueue apnsQ APNSMockRequest {notification, sendApnsResponse}
         _ -> do
           putStrLn $ "runAPNSMockServer J.decodeStrict' error, reqBody: " <> show bodyHead
           sendApnsResponse $ APNSRespError N.badRequest400 "bad_request_body"
 
-getMockNotification :: MonadIO m => APNSMockServer -> DeviceToken -> m APNSMockRequest
-getMockNotification APNSMockServer {notifications} (DeviceToken _ token) = do
-  atomically $ TM.lookup token notifications >>= maybe retry readTBQueue
-
-getAnyMockNotification :: MonadIO m => APNSMockServer -> m APNSMockRequest
-getAnyMockNotification APNSMockServer {notifications} = do
-  atomically $ readTVar notifications >>= mapM readTBQueue . M.elems >>= \case [] -> retry; ntf : _ -> pure ntf
-
 closeAPNSMockServer :: APNSMockServer -> IO ()
 closeAPNSMockServer APNSMockServer {action, http2Server} = do
   closeHTTP2Server http2Server
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index b9560976d..e3349e9a3 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -104,15 +104,16 @@ testNotificationSubscription (ATransport t) =
     (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
     let tkn = DeviceToken PPApnsTest "abcd"
-    withAPNSMockServer $ \apns ->
+    withAPNSMockServer $ \APNSMockServer {apnsQ} ->
       smpTest2 t $ \rh sh ->
         ntfTest t $ \nh -> do
           -- create queue
           (sId, rId, rKey, rcvDhSecret) <- createAndSecureQueue rh sPub
           -- register and verify token
           RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
-          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
-            getMockNotification apns tkn
+          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse = send} <-
+            atomically $ readTBQueue apnsQ
+          send APNSRespOk
           let dhSecret = C.dh' ntfDh dhPriv
               Right verification = ntfData .-> "verification"
               Right nonce = C.cbNonce <$> ntfData .-> "nonce"
@@ -130,7 +131,7 @@ testNotificationSubscription (ATransport t) =
           threadDelay 50000
           Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello")
           -- receive notification
-          APNSMockRequest {notification} <- getMockNotification apns tkn
+          APNSMockRequest {notification, sendApnsResponse = send'} <- atomically $ readTBQueue apnsQ
           let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData'} = notification
               Right nonce' = C.cbNonce <$> ntfData' .-> "nonce"
               Right message = ntfData' .-> "message"
@@ -141,6 +142,7 @@ testNotificationSubscription (ATransport t) =
               Right NMsgMeta {msgId, msgTs} = parse smpP (AP.INTERNAL "error parsing NMsgMeta") nMsgMeta
           smpServer `shouldBe` srv
           notifierId `shouldBe` nId
+          send' APNSRespOk
           -- receive message
           Resp "" _ (MSG RcvMessage {msgId = mId1, msgBody = EncRcvMsgBody body}) <- tGet1 rh
           Right ClientRcvMsgBody {msgTs = mTs, msgBody} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret (C.cbNonce mId1) body)
@@ -152,8 +154,9 @@ testNotificationSubscription (ATransport t) =
           let tkn' = DeviceToken PPApnsTest "efgh"
           RespNtf "7" tId' NROk <- signSendRecvNtf nh tknKey ("7", tId, TRPL tkn')
           tId `shouldBe` tId'
-          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}} <-
-            getMockNotification apns tkn'
+          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}, sendApnsResponse = send2} <-
+            atomically $ readTBQueue apnsQ
+          send2 APNSRespOk
           let Right verification2 = ntfData2 .-> "verification"
               Right nonce2 = C.cbNonce <$> ntfData2 .-> "nonce"
               Right code2 = NtfRegCode <$> C.cbDecrypt dhSecret nonce2 verification2
@@ -161,7 +164,7 @@ testNotificationSubscription (ATransport t) =
           RespNtf "8a" _ (NRTkn NTActive) <- signSendRecvNtf nh tknKey ("8a", tId, TCHK)
           -- send message
           Resp "9" _ OK <- signSendRecv sh sKey ("9", sId, _SEND' "hello 2")
-          APNSMockRequest {notification = notification3} <- getMockNotification apns tkn'
+          APNSMockRequest {notification = notification3, sendApnsResponse = send3} <- atomically $ readTBQueue apnsQ
           let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData3} = notification3
               Right nonce3 = C.cbNonce <$> ntfData3 .-> "nonce"
               Right message3 = ntfData3 .-> "message"
@@ -170,3 +173,4 @@ testNotificationSubscription (ATransport t) =
               APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} = L.last pnMsgs2
           smpServer3 `shouldBe` srv
           notifierId3 `shouldBe` nId
+          send3 APNSRespOk
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 273cc90ad..970be7174 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -62,12 +62,6 @@ testStoreMsgsFile = "tests/tmp/smp-server-messages.log"
 testStoreMsgsFile2 :: FilePath
 testStoreMsgsFile2 = "tests/tmp/smp-server-messages.log.2"
 
-testStoreNtfsFile :: FilePath
-testStoreNtfsFile = "tests/tmp/smp-server-ntfs.log"
-
-testStoreNtfsFile2 :: FilePath
-testStoreNtfsFile2 = "tests/tmp/smp-server-ntfs.log.2"
-
 testServerStatsBackupFile :: FilePath
 testServerStatsBackupFile = "tests/tmp/smp-server-stats.log"
 
@@ -110,20 +104,17 @@ cfg =
       msgIdBytes = 24,
       storeLogFile = Nothing,
       storeMsgsFile = Nothing,
-      storeNtfsFile = Nothing,
       allowNewQueues = True,
       newQueueBasicAuth = Nothing,
       controlPortUserAuth = Nothing,
       controlPortAdminAuth = Nothing,
       messageExpiration = Just defaultMessageExpiration,
-      notificationExpiration = defaultNtfExpiration,
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
       logStatsInterval = Nothing,
       logStatsStartTime = 0,
       serverStatsLogFile = "tests/smp-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
       pendingENDInterval = 500000,
-      ntfDeliveryInterval = 200000,
       smpCredentials =
         ServerCredentials
           { caCertificateFile = Just "tests/fixtures/ca.crt",
@@ -168,15 +159,7 @@ proxyVRangeV8 :: VersionRangeSMP
 proxyVRangeV8 = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion
 
 withSmpServerStoreMsgLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
-withSmpServerStoreMsgLogOn t =
-  withSmpServerConfigOn
-    t
-    cfg
-      { storeLogFile = Just testStoreLogFile,
-        storeMsgsFile = Just testStoreMsgsFile,
-        storeNtfsFile = Just testStoreNtfsFile,
-        serverStatsBackupFile = Just testServerStatsBackupFile
-      }
+withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, serverStatsBackupFile = Just testServerStatsBackupFile}
 
 withSmpServerStoreLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withSmpServerStoreLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, serverStatsBackupFile = Just testServerStatsBackupFile}
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 2025ff911..6fe10b38b 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -375,11 +375,11 @@ agentViaProxyRetryOffline = do
             ackMessage alice bobId (baseId + 4) Nothing
   where
     withServer :: (ThreadId -> IO a) -> IO a
-    withServer = withServer_ testStoreLogFile testStoreMsgsFile testStoreNtfsFile testPort
+    withServer = withServer_ testStoreLogFile testStoreMsgsFile testPort
     withServer2 :: (ThreadId -> IO a) -> IO a
-    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsFile2 testStoreNtfsFile2 testPort2
-    withServer_ storeLog storeMsgs storeNtfs port =
-      withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just storeLog, storeMsgsFile = Just storeMsgs, storeNtfsFile = Just storeNtfs} port
+    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsFile2 testPort2
+    withServer_ storeLog storeMsgs port =
+      withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just storeLog, storeMsgsFile = Just storeMsgs} port
     a `up` cId = nGet a =##> \case ("", "", UP _ [c]) -> c == cId; _ -> False
     a `down` cId = nGet a =##> \case ("", "", DOWN _ [c]) -> c == cId; _ -> False
     aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index d1ba7c67f..0a1729ab8 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -615,7 +615,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 2
     logSize testStoreMsgsFile `shouldReturn` 5
-    logSize testServerStatsBackupFile `shouldReturn` 74
+    logSize testServerStatsBackupFile `shouldReturn` 72
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
 
@@ -633,7 +633,7 @@ testRestoreMessages at@(ATransport t) =
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
     logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 74
+    logSize testServerStatsBackupFile `shouldReturn` 72
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
@@ -652,7 +652,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     logSize testStoreMsgsFile `shouldReturn` 0
-    logSize testServerStatsBackupFile `shouldReturn` 74
+    logSize testServerStatsBackupFile `shouldReturn` 72
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
 

From 04e4a37d85d511aebc1772035d96c7a2e5a738ca Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 2 Oct 2024 09:51:29 +0100
Subject: [PATCH 140/195] 6.1.0.4

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index 71340de64..d6bca13ae 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.1.0.3
+version: 6.1.0.4
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 63088ee4b..f637aa41d 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.1.0.3
+version:        6.1.0.4
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 61b2b9df1ad40d88c5e5094ab58bbf71bde53784 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 2 Oct 2024 12:23:46 +0100
Subject: [PATCH 141/195] Re-commit: smp server: persist notifications to avoid
 losing them when ntf server is offline (#1336)

This reverts commit 0ba3e6987283e56c0d4c46ab841314de7b404d00.
---
 simplexmq.cabal                               |   1 +
 src/Simplex/Messaging/Notifications/Server.hs |   5 +-
 src/Simplex/Messaging/Server.hs               | 171 +++++++---
 src/Simplex/Messaging/Server/Env/STM.hs       |  20 +-
 src/Simplex/Messaging/Server/Main.hs          |  24 +-
 src/Simplex/Messaging/Server/NtfStore.hs      |  77 +++++
 src/Simplex/Messaging/Server/Stats.hs         |  20 ++
 src/Simplex/Messaging/TMap.hs                 |   5 +
 tests/AgentTests/NotificationTests.hs         | 305 +++++++++---------
 tests/CoreTests/BatchingTests.hs              | 240 ++++++++------
 tests/NtfClient.hs                            |  54 ++--
 tests/NtfServerTests.hs                       |  18 +-
 tests/SMPClient.hs                            |  19 +-
 tests/SMPProxyTests.hs                        |   8 +-
 tests/ServerTests.hs                          |   6 +-
 15 files changed, 624 insertions(+), 349 deletions(-)
 create mode 100644 src/Simplex/Messaging/Server/NtfStore.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index f637aa41d..43e18ff5c 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -174,6 +174,7 @@ library
       Simplex.Messaging.Server.Main
       Simplex.Messaging.Server.MsgStore
       Simplex.Messaging.Server.MsgStore.STM
+      Simplex.Messaging.Server.NtfStore
       Simplex.Messaging.Server.QueueStore
       Simplex.Messaging.Server.QueueStore.QueueInfo
       Simplex.Messaging.Server.QueueStore.STM
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 54be77a71..42c24aeb8 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -220,9 +220,8 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
               NtfPushServer {pushQ} <- asks pushServer
               stats <- asks serverStats
               liftIO $ updatePeriodStats (activeSubs stats) ntfId
-              atomically $
-                findNtfSubscriptionToken st smpQueue
-                  >>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage (PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| [])))
+              atomically (findNtfSubscriptionToken st smpQueue)
+                >>= mapM_ (\tkn -> atomically (writeTBQueue pushQ (tkn, PNMessage (PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| []))))
               incNtfStat ntfReceived
             Right SMP.END ->
               whenM (atomically $ activeClientSession' ca sessionId srv) $
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index bf96b6deb..54fef3ab3 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -58,7 +58,7 @@ import Data.IORef
 import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
-import Data.List (intercalate, mapAccumR)
+import Data.List (foldl', intercalate, mapAccumR)
 import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
@@ -88,6 +88,7 @@ import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
 import Simplex.Messaging.Server.MsgStore.STM
+import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.Server.QueueStore.STM as QS
@@ -137,13 +138,16 @@ smpServer :: TMVar Bool -> ServerConfig -> Maybe AttachHTTP -> M ()
 smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHTTP_ = do
   s <- asks server
   pa <- asks proxyAgent
-  expired <- restoreServerMessages
-  restoreServerStats expired
+  expiredMsgs <- restoreServerMessages
+  expiredNtfs <- restoreServerNtfs
+  restoreServerStats expiredMsgs expiredNtfs
   raceAny_
     ( serverThread s "server subscribedQ" subscribedQ subscribers subClients pendingSubEvents subscriptions cancelSub
         : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubClients pendingNtfSubEvents ntfSubscriptions (\_ -> pure ())
+        : deliverNtfsThread s
         : sendPendingEvtsThread s
         : receiveFromProxyAgent pa
+        : expireNtfsThread cfg
         : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
     )
     `finally` withLock' (savingLock s) "final" (saveServer False >> closeServer)
@@ -171,7 +175,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
     fromTLSCredentials (_, pk) = C.x509ToPrivate (pk, []) >>= C.privKey
 
     saveServer :: Bool -> M ()
-    saveServer keepMsgs = withLog closeStoreLog >> saveServerMessages keepMsgs >> saveServerStats
+    saveServer keepMsgs = withLog closeStoreLog >> saveServerMessages keepMsgs >> saveServerNtfs >> saveServerStats
 
     closeServer :: M ()
     closeServer = asks (smpAgent . proxyAgent) >>= liftIO . closeSMPClientAgent
@@ -230,6 +234,31 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
         -- remove client from server's subscribed cients
         removeWhenNoSubs c = whenM (null <$> readTVar (clientSubs c)) $ modifyTVar' (subClnts s) $ IM.delete (clientId c)
 
+    deliverNtfsThread :: Server -> M ()
+    deliverNtfsThread Server {ntfSubClients} = do
+      ntfInt <- asks $ ntfDeliveryInterval . config
+      ns <- asks ntfStore
+      stats <- asks serverStats
+      liftIO $ forever $ do
+        threadDelay ntfInt
+        readTVarIO ntfSubClients >>= mapM_ (deliverNtfs ns stats)
+      where
+        deliverNtfs ns stats Client {clientId, ntfSubscriptions, sndQ, connected} = whenM currentClient $
+          readTVarIO ntfSubscriptions >>= \subs -> do
+            ts_ <- foldM addNtfs [] (M.keys subs)
+            mapM_ (atomically . writeTBQueue sndQ) $ L.nonEmpty ts_
+            updateNtfStats $ length ts_
+          where
+            currentClient = (&&) <$> readTVarIO connected <*> (IM.member clientId <$> readTVarIO ntfSubClients)
+            addNtfs :: [Transmission BrokerMsg] -> NotifierId -> IO [Transmission BrokerMsg]
+            addNtfs acc nId =
+              (foldl' (\acc' ntf -> nmsg nId ntf : acc') acc) -- reverses, to order by time
+                <$> flushNtfs ns nId
+            nmsg nId MsgNtf {ntfNonce, ntfEncMeta} = (CorrId "", nId, NMSG ntfNonce ntfEncMeta)
+            updateNtfStats len = when (len > 0) $ liftIO $ do
+              atomicModifyIORef'_ (msgNtfs stats) (+ len)
+              atomicModifyIORef'_ (msgNtfsB stats) (+ (len `div` 80 + 1)) -- up to 80 NMSG in the batch
+
     sendPendingEvtsThread :: Server -> M ()
     sendPendingEvtsThread s = do
       endInt <- asks $ pendingENDInterval . config
@@ -259,8 +288,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
             updateEndStats = do
               stats <- asks serverStats
               let len = L.length qEvts
-              liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
-              liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs or DELDs in the batch
+              when (len > 0) $ liftIO $ do
+                atomicModifyIORef'_ (qSubEnd stats) (+ len)
+                atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs or DELDs in the batch
 
     receiveFromProxyAgent :: ProxyAgent -> M ()
     receiveFromProxyAgent ProxyAgent {smpAgent = SMPClientAgent {agentQ}} =
@@ -294,6 +324,18 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
           deleted <- liftIO $ deleteExpiredMsgs q old
           liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
 
+    expireNtfsThread :: ServerConfig -> M ()
+    expireNtfsThread ServerConfig {notificationExpiration = expCfg} = do
+      ns <- asks ntfStore
+      let interval = checkInterval expCfg * 1000000
+      stats <- asks serverStats
+      labelMyThread "expireNtfsThread"
+      liftIO $ forever $ do
+        threadDelay' interval
+        old <- expireBeforeEpoch expCfg
+        expired <- deleteExpiredNtfs ns old
+        when (expired > 0) $ atomicModifyIORef'_ (msgNtfExpired stats) (+ expired)
+
     serverStatsThread_ :: ServerConfig -> [M ()]
     serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime, serverStatsLogFile} =
       [logServerStats logStatsStartTime interval serverStatsLogFile]
@@ -351,8 +393,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
           msgRecvNtf' <- atomicSwapIORef msgRecvNtf 0
           psNtf <- liftIO $ periodStatCounts activeQueuesNtf ts
           msgNtfs' <- atomicSwapIORef (msgNtfs ss) 0
+          msgNtfsB' <- atomicSwapIORef (msgNtfsB ss) 0
           msgNtfNoSub' <- atomicSwapIORef (msgNtfNoSub ss) 0
           msgNtfLost' <- atomicSwapIORef (msgNtfLost ss) 0
+          msgNtfExpired' <- atomicSwapIORef (msgNtfExpired ss) 0
           pRelays' <- getResetProxyStatsData pRelays
           pRelaysOwn' <- getResetProxyStatsData pRelaysOwn
           pMsgFwds' <- getResetProxyStatsData pMsgFwds
@@ -424,7 +468,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                        show qSubEnd',
                        show qSubEndB',
                        show ntfDeletedB',
-                       show ntfSubB'
+                       show ntfSubB',
+                       show msgNtfsB',
+                       show msgNtfExpired'
                      ]
               )
         liftIO $ threadDelay' interval
@@ -534,6 +580,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                 hPutStrLn h $ "other GET events (auth, duplicate, prohibited): " <> show gets
                 putStat "msgSentNtf" msgSentNtf
                 putStat "msgRecvNtf" msgRecvNtf
+                putStat "msgNtfs" msgNtfs
+                putStat "msgNtfsB" msgNtfsB
+                putStat "msgNtfExpired" msgNtfExpired
                 putStat "qCount" qCount
                 putStat "msgCount" msgCount
                 putProxyStat "pRelays" pRelays
@@ -932,7 +981,7 @@ forkClient Client {endThreads, endThreadSeq} label action = do
   mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId
 
 client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
-client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers, notifiers} = do
+client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
   forever $
     atomically (readTBQueue rcvQ)
@@ -1135,6 +1184,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           liftIO (deleteQueueNotifier st entId) >>= \case
             Right (Just nId) -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
+              asks ntfStore >>= liftIO . (`deleteNtfs` nId)
               atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
               incStat . ntfDeleted =<< asks serverStats
               pure ok
@@ -1276,7 +1326,14 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               Message {msgFlags} -> do
                 stats <- asks serverStats
                 incStat $ msgRecv stats
-                when isGet $ incStat $ msgRecvGet stats
+                if isGet
+                  then incStat $ msgRecvGet stats
+                  else pure () -- TODO skip notification delivery for delivered message  
+                  -- skipping delivery fails tests, it should be counted in msgNtfSkipped
+                  -- forM_ (notifierId <$> notifier qr) $ \nId -> do
+                  --   ns <- asks ntfStore
+                  --   atomically $ TM.lookup nId ns >>=
+                  --     mapM_ (\MsgNtf {ntfMsgId} -> when (msgId == msgId') $ TM.delete nId ns)
                 liftIO $ atomicModifyIORef'_ (msgCount stats) (subtract 1)
                 liftIO $ updatePeriodStats (activeQueues stats) entId
                 when (notification msgFlags) $ do
@@ -1310,7 +1367,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                         Just (msg, wasEmpty) -> time "SEND ok" $ do
                           when wasEmpty $ liftIO $ tryDeliverMessage msg
                           when (notification msgFlags) $ do
-                            mapM_ (`trySendNotification` msg) (notifier qr)
+                            mapM_ (`enqueueNotification` msg) (notifier qr)
                             incStat $ msgSentNtf stats
                             liftIO $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
                           incStat $ msgSent stats
@@ -1395,39 +1452,20 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                             deliver q s
                             writeTVar st NoSub
 
-            trySendNotification :: NtfCreds -> Message -> M ()
-            trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg = do
-              stats <- asks serverStats
-              liftIO (TM.lookupIO notifierId notifiers) >>= \case
-                Nothing -> do
-                  incStat $ msgNtfNoSub stats
-                  logWarn "No notification subscription"
-                Just ntfClnt -> do
-                  let updateStats True = incStat $ msgNtfs stats
-                      updateStats _ = do
-                        incStat $ msgNtfLost stats
-                        logWarn "Dropped message notification"
-                  writeNtf notifierId msg rcvNtfDhSecret ntfClnt >>= mapM_ updateStats
+            enqueueNotification :: NtfCreds -> Message -> M ()
+            enqueueNotification _ MessageQuota {} = pure ()
+            enqueueNotification NtfCreds {notifierId = nId, rcvNtfDhSecret} Message {msgId, msgTs} = do
+              -- stats <- asks serverStats
+              ns <- asks ntfStore
+              ntf <- mkMessageNotification msgId msgTs rcvNtfDhSecret
+              liftIO $ storeNtf ns nId ntf
 
-            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> TVar Client -> M (Maybe Bool)
-            writeNtf nId msg rcvNtfDhSecret ntfClnt = case msg of
-              Message {msgId, msgTs} -> Just <$> do
-                (nmsgNonce, encNMsgMeta) <- mkMessageNotification msgId msgTs rcvNtfDhSecret
-                -- must be in one STM transaction to avoid the queue becoming full between the check and writing
-                atomically $ do
-                  Client {sndQ = q} <- readTVar ntfClnt
-                  ifM
-                    (isFullTBQueue q)
-                    (pure $ False)
-                    (True <$ writeTBQueue q [(CorrId "", nId, NMSG nmsgNonce encNMsgMeta)])
-              _ -> pure Nothing
-
-            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> M (C.CbNonce, EncNMsgMeta)
+            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> M MsgNtf
             mkMessageNotification msgId msgTs rcvNtfDhSecret = do
-              cbNonce <- atomically . C.randomCbNonce =<< asks random
+              ntfNonce <- atomically . C.randomCbNonce =<< asks random
               let msgMeta = NMsgMeta {msgId, msgTs}
-                  encNMsgMeta = C.cbEncrypt rcvNtfDhSecret cbNonce (smpEncode msgMeta) 128
-              pure . (cbNonce,) $ fromRight "" encNMsgMeta
+                  encNMsgMeta = C.cbEncrypt rcvNtfDhSecret ntfNonce (smpEncode msgMeta) 128
+              pure $ MsgNtf {ntfMsgId = msgId, ntfTs = msgTs, ntfNonce, ntfEncMeta = fromRight "" encNMsgMeta}
 
         processForwardedCommand :: EncFwdTransmission -> M BrokerMsg
         processForwardedCommand (EncFwdTransmission s) = fmap (either ERR id) . runExceptT $ do
@@ -1528,9 +1566,10 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                 -- queue is usually deleted by the same client that is currently subscribed,
                 -- we delete subscription here, so the client with no subscriptions can be disconnected.
                 TM.delete entId subscriptions
-              forM_ (notifierId <$> notifier q) $ \nId ->
+              forM_ (notifierId <$> notifier q) $ \nId -> do
                 -- queue is deleted by a different client from the one subscribed to notifications,
                 -- so we don't need to remove subscription from the current client.
+                asks ntfStore >>= liftIO . (`deleteNtfs` nId)
                 atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
               updateDeletedStats q
               pure ok
@@ -1657,6 +1696,50 @@ restoreServerMessages =
             msgErr :: Show e => String -> e -> String
             msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
 
+saveServerNtfs :: M ()
+saveServerNtfs = asks (storeNtfsFile . config) >>= mapM_ saveNtfs
+  where
+    saveNtfs f = do
+      logInfo $ "saving notifications to file " <> T.pack f
+      NtfStore ns <- asks ntfStore
+      liftIO . withFile f WriteMode $ \h ->
+        readTVarIO ns >>= mapM_ (saveQueueNtfs h) . M.assocs
+      logInfo "notifications saved"
+      where
+        -- reverse on save, to save notifications in order, will become reversed again when restoring.
+        saveQueueNtfs h (nId, v) = BLD.hPutBuilder h . encodeNtfs nId . reverse =<< readTVarIO v
+        encodeNtfs nId = mconcat . map (\ntf -> BLD.byteString (strEncode $ NLRv1 nId ntf) <> BLD.char8 '\n')
+
+restoreServerNtfs :: M Int
+restoreServerNtfs =
+  asks (storeNtfsFile . config) >>= \case
+    Just f -> ifM (doesFileExist f) (restoreNtfs f) (pure 0)
+    Nothing -> pure 0
+  where
+    restoreNtfs f = do
+      logInfo $ "restoring notifications from file " <> T.pack f
+      ns <- asks ntfStore
+      old <- asks (notificationExpiration . config) >>= liftIO . expireBeforeEpoch
+      runExceptT (liftIO (LB.readFile f) >>= foldM (restoreNtf ns old) 0 . LB.lines) >>= \case
+        Left e -> do
+          logError . T.pack $ "error restoring notifications: " <> e
+          liftIO exitFailure
+        Right expired -> do
+          renameFile f $ f <> ".bak"
+          logInfo "notifications restored"
+          pure expired
+      where
+        restoreNtf ns old !expired s' = do
+          NLRv1 nId ntf <- liftEither . first (ntfErr "parsing") $ strDecode s
+          liftIO $ addToNtfs nId ntf
+          where
+            s = LB.toStrict s'
+            addToNtfs nId ntf@MsgNtf {ntfTs}
+              | systemSeconds ntfTs < old = pure (expired + 1)
+              | otherwise = storeNtf ns nId ntf $> expired
+            ntfErr :: Show e => String -> e -> String
+            ntfErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
+
 saveServerStats :: M ()
 saveServerStats =
   asks (serverStatsBackupFile . config)
@@ -1667,8 +1750,8 @@ saveServerStats =
       B.writeFile f $ strEncode stats
       logInfo "server stats saved"
 
-restoreServerStats :: Int -> M ()
-restoreServerStats expiredWhileRestoring = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
+restoreServerStats :: Int -> Int -> M ()
+restoreServerStats expiredMsgs expiredNtfs = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
   where
     restoreStats f = whenM (doesFileExist f) $ do
       logInfo $ "restoring server stats from file " <> T.pack f
@@ -1677,7 +1760,7 @@ restoreServerStats expiredWhileRestoring = asks (serverStatsBackupFile . config)
           s <- asks serverStats
           _qCount <- fmap M.size . readTVarIO . queues =<< asks queueStore
           _msgCount <- liftIO . foldM (\(!n) q -> (n +) <$> getQueueSize q) 0 =<< readTVarIO =<< asks msgStore
-          liftIO $ setServerStats s d {_qCount, _msgCount, _msgExpired = _msgExpired d + expiredWhileRestoring}
+          liftIO $ setServerStats s d {_qCount, _msgCount, _msgExpired = _msgExpired d + expiredMsgs, _msgNtfExpired = _msgNtfExpired d + expiredNtfs}
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
           when (_qCount /= statsQCount) $ logWarn $ "Queue count differs: stats: " <> tshow statsQCount <> ", store: " <> tshow _qCount
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 05ed7da53..a485ab73e 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -38,6 +38,7 @@ import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.MsgStore.STM
+import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.QueueStore (NtfCreds (..), QueueRec (..))
 import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.Stats
@@ -61,6 +62,7 @@ data ServerConfig = ServerConfig
     msgIdBytes :: Int,
     storeLogFile :: Maybe FilePath,
     storeMsgsFile :: Maybe FilePath,
+    storeNtfsFile :: Maybe FilePath,
     -- | set to False to prohibit creating new queues
     allowNewQueues :: Bool,
     -- | simple password that the clients need to pass in handshake to be able to create new queues
@@ -70,6 +72,8 @@ data ServerConfig = ServerConfig
     controlPortAdminAuth :: Maybe BasicAuth,
     -- | time after which the messages can be removed from the queues and check interval, seconds
     messageExpiration :: Maybe ExpirationConfig,
+    -- | notification expiration interval (seconds)
+    notificationExpiration :: ExpirationConfig,
     -- | time after which the socket with inactive client can be disconnected (without any messages or commands, incl. PING),
     -- and check interval, seconds
     inactiveClientExpiration :: Maybe ExpirationConfig,
@@ -82,6 +86,8 @@ data ServerConfig = ServerConfig
     serverStatsLogFile :: FilePath,
     -- | file to save and restore stats
     serverStatsBackupFile :: Maybe FilePath,
+    -- | notification delivery interval
+    ntfDeliveryInterval :: Int,
     -- | interval between sending pending END events to unsubscribed clients, seconds
     pendingENDInterval :: Int,
     smpCredentials :: ServerCredentials,
@@ -110,6 +116,16 @@ defaultMessageExpiration =
       checkInterval = 43200 -- seconds, 12 hours
     }
 
+defNtfExpirationHours :: Int64
+defNtfExpirationHours = 24
+
+defaultNtfExpiration :: ExpirationConfig
+defaultNtfExpiration =
+  ExpirationConfig
+    { ttl = defNtfExpirationHours * 3600, -- seconds
+      checkInterval = 3600 -- seconds, 1 hour
+    }
+
 defaultInactiveClientExpiration :: ExpirationConfig
 defaultInactiveClientExpiration =
   ExpirationConfig
@@ -127,6 +143,7 @@ data Env = Env
     serverIdentity :: KeyHash,
     queueStore :: QueueStore,
     msgStore :: STMMsgStore,
+    ntfStore :: NtfStore,
     random :: TVar ChaChaDRG,
     storeLog :: Maybe (StoreLog 'WriteMode),
     tlsServerCreds :: T.Credential,
@@ -229,6 +246,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAg
   server <- newServer
   queueStore <- newQueueStore
   msgStore <- newMsgStore
+  ntfStore <- NtfStore <$> TM.emptyIO
   random <- C.newRandom
   storeLog <-
     forM storeLogFile $ \f -> do
@@ -244,7 +262,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAg
   clientSeq <- newTVarIO 0
   clients <- newTVarIO mempty
   proxyAgent <- newSMPProxyAgent smpAgentCfg random
-  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerCreds, httpServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
+  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, ntfStore, random, storeLog, tlsServerCreds, httpServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
   where
     getCredentials protocol creds = do
       files <- missingCreds
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index bcd96c170..ca4a5ed60 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -38,7 +38,7 @@ import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
 import Simplex.Messaging.Server (AttachHTTP, runSMPServer)
 import Simplex.Messaging.Server.CLI
-import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defMsgExpirationDays, defaultInactiveClientExpiration, defaultMessageExpiration, defaultProxyClientConcurrency)
+import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedServerSMPRelayVRange)
@@ -154,7 +154,8 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 <> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
                    \# they are preserved in the .bak file until the next restart.\n"
                 <> ("restore_messages: " <> onOff enableStoreLog <> "\n")
-                <> ("expire_messages_days: " <> tshow defMsgExpirationDays <> "\n\n")
+                <> ("expire_messages_days: " <> tshow defMsgExpirationDays <> "\n")
+                <> ("expire_ntfs_hours: " <> tshow defNtfExpirationHours <> "\n\n")
                 <> "# Log daily server statistics to CSV file\n"
                 <> ("log_stats: " <> onOff logStats <> "\n\n")
                 <> "[AUTH]\n\
@@ -268,6 +269,11 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
         enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
         logStats = settingIsOn "STORE_LOG" "log_stats" ini
         c = combine cfgPath . ($ defaultX509Config)
+        restoreMessagesFile path = case iniOnOff "STORE_LOG" "restore_messages" ini of
+          Just True -> Just path
+          Just False -> Nothing
+          -- if the setting is not set, it is enabled when store log is enabled
+          _ -> enableStoreLog $> path
         transports = iniTransports ini
         sharedHTTP = any (\(_, _, addHTTP) -> addHTTP) transports
         serverConfig =
@@ -286,13 +292,8 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                   },
               httpCredentials = (\WebHttpsParams {key, cert} -> ServerCredentials {caCertificateFile = Nothing, privateKeyFile = key, certificateFile = cert}) <$> webHttpsParams',
               storeLogFile = enableStoreLog $> storeLogFilePath,
-              storeMsgsFile =
-                let messagesPath = combine logPath "smp-server-messages.log"
-                 in case iniOnOff "STORE_LOG" "restore_messages" ini of
-                      Just True -> Just messagesPath
-                      Just False -> Nothing
-                      -- if the setting is not set, it is enabled when store log is enabled
-                      _ -> enableStoreLog $> messagesPath,
+              storeMsgsFile = restoreMessagesFile $ combine logPath "smp-server-messages.log",
+              storeNtfsFile = restoreMessagesFile $ combine logPath "smp-server-ntfs.log",
               -- allow creating new queues by default
               allowNewQueues = fromMaybe True $ iniOnOff "AUTH" "new_queues" ini,
               newQueueBasicAuth = either error id <$!> strDecodeIni "AUTH" "create_password" ini,
@@ -303,6 +304,10 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                   defaultMessageExpiration
                     { ttl = 86400 * readIniDefault defMsgExpirationDays "STORE_LOG" "expire_messages_days" ini
                     },
+              notificationExpiration =
+                defaultNtfExpiration
+                  { ttl = 3600 * readIniDefault defNtfExpirationHours "STORE_LOG" "expire_ntfs_hours" ini
+                  },
               inactiveClientExpiration =
                 settingIsOn "INACTIVE_CLIENTS" "disconnect" ini
                   $> ExpirationConfig
@@ -314,6 +319,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               serverStatsLogFile = combine logPath "smp-server-stats.daily.log",
               serverStatsBackupFile = logStats $> combine logPath "smp-server-stats.log",
               pendingENDInterval = 15000000, -- 15 seconds
+              ntfDeliveryInterval = 3000000, -- 3 seconds
               smpServerVRange = supportedServerSMPRelayVRange,
               transportConfig =
                 defaultTransportServerConfig
diff --git a/src/Simplex/Messaging/Server/NtfStore.hs b/src/Simplex/Messaging/Server/NtfStore.hs
new file mode 100644
index 000000000..ded2bd85d
--- /dev/null
+++ b/src/Simplex/Messaging/Server/NtfStore.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Messaging.Server.NtfStore where
+
+import Control.Concurrent.STM
+import Control.Monad (foldM)
+import Data.Int (Int64)
+import qualified Data.Map.Strict as M
+import Data.Time.Clock.System (SystemTime (..))
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (EncNMsgMeta, MsgId, NotifierId)
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
+
+newtype NtfStore = NtfStore (TMap NotifierId (TVar [MsgNtf]))
+
+data MsgNtf = MsgNtf
+  { ntfMsgId :: MsgId,
+    ntfTs :: SystemTime,
+    ntfNonce :: C.CbNonce,
+    ntfEncMeta :: EncNMsgMeta
+  }
+
+storeNtf :: NtfStore -> NotifierId -> MsgNtf -> IO ()
+storeNtf (NtfStore ns) nId ntf = do
+  TM.lookupIO nId ns >>= atomically . maybe newNtfs (`modifyTVar'` (ntf :))
+  -- TODO coalesce messages here once the client is updated to process multiple messages
+  -- for single notification.
+  -- when (isJust prevNtf) $ incStat $ msgNtfReplaced stats
+  where
+    newNtfs = TM.lookup nId ns >>= maybe (TM.insertM nId (newTVar [ntf]) ns) (`modifyTVar'` (ntf :))
+
+deleteNtfs :: NtfStore -> NotifierId -> IO ()
+deleteNtfs (NtfStore ns) nId = atomically $ TM.delete nId ns
+
+flushNtfs :: NtfStore -> NotifierId -> IO [MsgNtf]
+flushNtfs (NtfStore ns) nId = do
+  TM.lookupIO nId ns >>= maybe (pure []) swapNtfs
+  where
+    swapNtfs v =
+      readTVarIO v >>= \case
+        [] -> pure []
+        -- if notifications available, atomically swap with empty array
+        _ -> atomically (swapTVar v [])
+
+deleteExpiredNtfs :: NtfStore -> Int64 -> IO Int
+deleteExpiredNtfs (NtfStore ns) old =
+  foldM (\expired -> fmap (expired +) . expireQueue) 0 . M.keys =<< readTVarIO ns
+  where
+    expireQueue nId = TM.lookupIO nId ns >>= maybe (pure 0) expire
+    expire v = readTVarIO v >>= \case
+      [] -> pure 0
+      _ ->
+        atomically $ readTVar v >>= \case
+          [] -> pure 0
+          -- check the last message first, it is the earliest
+          ntfs | systemSeconds (ntfTs $ last $ ntfs) < old -> do
+            let !ntfs' = filter (\MsgNtf {ntfTs = ts} -> systemSeconds ts >= old) ntfs
+            writeTVar v ntfs'
+            pure $! length ntfs - length ntfs'
+          _ -> pure 0
+
+data NtfLogRecord = NLRv1 NotifierId MsgNtf
+
+instance StrEncoding MsgNtf where
+  strEncode MsgNtf {ntfMsgId, ntfTs, ntfNonce, ntfEncMeta} = strEncode (ntfMsgId, ntfTs, ntfNonce, ntfEncMeta)
+  strP = do
+    (ntfMsgId, ntfTs, ntfNonce, ntfEncMeta) <- strP
+    pure MsgNtf {ntfMsgId, ntfTs, ntfNonce, ntfEncMeta}
+
+instance StrEncoding NtfLogRecord where
+  strEncode (NLRv1 nId ntf) = strEncode (Str "v1", nId, ntf)
+  strP = "v1 " *> (NLRv1 <$> strP_ <*> strP)
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index 097ddb607..49078d2d9 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -67,8 +67,10 @@ data ServerStats = ServerStats
     msgRecvNtf :: IORef Int, -- received messages with NTF flag
     activeQueuesNtf :: PeriodStats,
     msgNtfs :: IORef Int, -- messages notications delivered to NTF server (<= msgSentNtf)
+    msgNtfsB :: IORef Int, -- messages notication batches delivered to NTF server
     msgNtfNoSub :: IORef Int, -- no subscriber to notifications (e.g., NTF server not connected)
     msgNtfLost :: IORef Int, -- notification is lost because NTF delivery queue is full
+    msgNtfExpired :: IORef Int, -- expired
     pRelays :: ProxyStats,
     pRelaysOwn :: ProxyStats,
     pMsgFwds :: ProxyStats,
@@ -117,8 +119,10 @@ data ServerStatsData = ServerStatsData
     _msgRecvNtf :: Int,
     _activeQueuesNtf :: PeriodStatsData,
     _msgNtfs :: Int,
+    _msgNtfsB :: Int,
     _msgNtfNoSub :: Int,
     _msgNtfLost :: Int,
+    _msgNtfExpired :: Int,
     _pRelays :: ProxyStatsData,
     _pRelaysOwn :: ProxyStatsData,
     _pMsgFwds :: ProxyStatsData,
@@ -169,8 +173,10 @@ newServerStats ts = do
   msgRecvNtf <- newIORef 0
   activeQueuesNtf <- newPeriodStats
   msgNtfs <- newIORef 0
+  msgNtfsB <- newIORef 0
   msgNtfNoSub <- newIORef 0
   msgNtfLost <- newIORef 0
+  msgNtfExpired <- newIORef 0
   pRelays <- newProxyStats
   pRelaysOwn <- newProxyStats
   pMsgFwds <- newProxyStats
@@ -218,8 +224,10 @@ newServerStats ts = do
         msgRecvNtf,
         activeQueuesNtf,
         msgNtfs,
+        msgNtfsB,
         msgNtfNoSub,
         msgNtfLost,
+        msgNtfExpired,
         pRelays,
         pRelaysOwn,
         pMsgFwds,
@@ -269,8 +277,10 @@ getServerStatsData s = do
   _msgRecvNtf <- readIORef $ msgRecvNtf s
   _activeQueuesNtf <- getPeriodStatsData $ activeQueuesNtf s
   _msgNtfs <- readIORef $ msgNtfs s
+  _msgNtfsB <- readIORef $ msgNtfsB s
   _msgNtfNoSub <- readIORef $ msgNtfNoSub s
   _msgNtfLost <- readIORef $ msgNtfLost s
+  _msgNtfExpired <- readIORef $ msgNtfExpired s
   _pRelays <- getProxyStatsData $ pRelays s
   _pRelaysOwn <- getProxyStatsData $ pRelaysOwn s
   _pMsgFwds <- getProxyStatsData $ pMsgFwds s
@@ -318,8 +328,10 @@ getServerStatsData s = do
         _msgRecvNtf,
         _activeQueuesNtf,
         _msgNtfs,
+        _msgNtfsB,
         _msgNtfNoSub,
         _msgNtfLost,
+        _msgNtfExpired,
         _pRelays,
         _pRelaysOwn,
         _pMsgFwds,
@@ -370,8 +382,10 @@ setServerStats s d = do
   writeIORef (msgRecvNtf s) $! _msgRecvNtf d
   setPeriodStats (activeQueuesNtf s) (_activeQueuesNtf d)
   writeIORef (msgNtfs s) $! _msgNtfs d
+  writeIORef (msgNtfsB s) $! _msgNtfsB d
   writeIORef (msgNtfNoSub s) $! _msgNtfNoSub d
   writeIORef (msgNtfLost s) $! _msgNtfLost d
+  writeIORef (msgNtfExpired s) $! _msgNtfExpired d
   setProxyStats (pRelays s) $! _pRelays d
   setProxyStats (pRelaysOwn s) $! _pRelaysOwn d
   setProxyStats (pMsgFwds s) $! _pMsgFwds d
@@ -420,8 +434,10 @@ instance StrEncoding ServerStatsData where
         "msgSentNtf=" <> strEncode (_msgSentNtf d),
         "msgRecvNtf=" <> strEncode (_msgRecvNtf d),
         "msgNtfs=" <> strEncode (_msgNtfs d),
+        "msgNtfsB=" <> strEncode (_msgNtfsB d),
         "msgNtfNoSub=" <> strEncode (_msgNtfNoSub d),
         "msgNtfLost=" <> strEncode (_msgNtfLost d),
+        "msgNtfExpired=" <> strEncode (_msgNtfExpired d),
         "activeQueues:",
         strEncode (_activeQueues d),
         "activeQueuesNtf:",
@@ -475,8 +491,10 @@ instance StrEncoding ServerStatsData where
     _msgSentNtf <- opt "msgSentNtf="
     _msgRecvNtf <- opt "msgRecvNtf="
     _msgNtfs <- opt "msgNtfs="
+    _msgNtfsB <- opt "msgNtfsB="
     _msgNtfNoSub <- opt "msgNtfNoSub="
     _msgNtfLost <- opt "msgNtfLost="
+    _msgNtfExpired <- opt "msgNtfExpired="
     _activeQueues <-
       optional ("activeQueues:" <* A.endOfLine) >>= \case
         Just _ -> strP <* optional A.endOfLine
@@ -536,8 +554,10 @@ instance StrEncoding ServerStatsData where
           _msgSentNtf,
           _msgRecvNtf,
           _msgNtfs,
+          _msgNtfsB,
           _msgNtfNoSub,
           _msgNtfLost,
+          _msgNtfExpired,
           _activeQueues,
           _activeQueuesNtf,
           _pRelays,
diff --git a/src/Simplex/Messaging/TMap.hs b/src/Simplex/Messaging/TMap.hs
index 1bc9bcb60..02d20b695 100644
--- a/src/Simplex/Messaging/TMap.hs
+++ b/src/Simplex/Messaging/TMap.hs
@@ -9,6 +9,7 @@ module Simplex.Messaging.TMap
     member,
     memberIO,
     insert,
+    insertM,
     delete,
     lookupInsert,
     lookupDelete,
@@ -62,6 +63,10 @@ insert :: Ord k => k -> a -> TMap k a -> STM ()
 insert k v m = modifyTVar' m $ M.insert k v
 {-# INLINE insert #-}
 
+insertM :: Ord k => k -> STM a -> TMap k a -> STM ()
+insertM k f m = modifyTVar' m . M.insert k =<< f
+{-# INLINE insertM #-}
+
 delete :: Ord k => k -> TMap k a -> STM ()
 delete k m = modifyTVar' m $ M.delete k
 {-# INLINE delete #-}
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 40071873c..272c6d6d6 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -54,7 +54,7 @@ import Data.Text.Encoding (encodeUtf8)
 import Database.SQLite.Simple.QQ (sql)
 import NtfClient
 import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testNtfServer, testNtfServer2)
-import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn)
+import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore')
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, Env (..), InitialAgentServers)
@@ -134,9 +134,8 @@ notificationTests t = do
           withNtfServer t $ testChangeToken apns
   describe "Notifications server store log" $
     it "should save and restore tokens and subscriptions" $
-      withSmpServer t $
-        withAPNSMockServer $ \apns ->
-          testNotificationsStoreLog t apns
+      withAPNSMockServer $ \apns ->
+        testNotificationsStoreLog t apns
   describe "Notifications after SMP server restart" $
     it "should resume subscriptions after SMP server is restarted" $
       withAPNSMockServer $ \apns ->
@@ -183,15 +182,14 @@ runNtfTestCfg t baseId smpCfg ntfCfg aCfg bCfg runTest = do
   threadDelay 100000
 
 testNotificationToken :: APNSMockServer -> IO ()
-testNotificationToken APNSMockServer {apnsQ} = do
+testNotificationToken apns = do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+      getMockNotification apns tkn
     verification <- ntfData .-> "verification"
     nonce <- C.cbNonce <$> ntfData .-> "nonce"
-    liftIO $ sendApnsResponse APNSRespOk
     verifyNtfToken a tkn nonce verification
     NTActive <- checkNtfToken a tkn
     deleteNtfToken a tkn
@@ -208,48 +206,44 @@ v .-> key = do
 -- logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 testNtfTokenRepeatRegistration :: APNSMockServer -> IO ()
-testNtfTokenRepeatRegistration APNSMockServer {apnsQ} = do
+testNtfTokenRepeatRegistration apns = do
   -- setLogLevel LogError -- LogDebug
   -- withGlobalLogging logCfg $ do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+      getMockNotification apns tkn
     verification <- ntfData .-> "verification"
     nonce <- C.cbNonce <$> ntfData .-> "nonce"
-    liftIO $ sendApnsResponse APNSRespOk
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
+      getMockNotification apns tkn
     _ <- ntfData' .-> "verification"
     _ <- C.cbNonce <$> ntfData' .-> "nonce"
-    liftIO $ sendApnsResponse' APNSRespOk
     -- can still use the first verification code, it is the same after decryption
     verifyNtfToken a tkn nonce verification
     NTActive <- checkNtfToken a tkn
     pure ()
 
 testNtfTokenSecondRegistration :: APNSMockServer -> IO ()
-testNtfTokenSecondRegistration APNSMockServer {apnsQ} =
+testNtfTokenSecondRegistration apns =
   -- setLogLevel LogError -- LogDebug
   -- withGlobalLogging logCfg $ do
   withAgentClients2 $ \a a' -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+      getMockNotification apns tkn
     verification <- ntfData .-> "verification"
     nonce <- C.cbNonce <$> ntfData .-> "nonce"
-    liftIO $ sendApnsResponse APNSRespOk
     verifyNtfToken a tkn nonce verification
 
     NTRegistered <- registerNtfToken a' tkn NMPeriodic
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
+      getMockNotification apns tkn
     verification' <- ntfData' .-> "verification"
     nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
-    liftIO $ sendApnsResponse' APNSRespOk
 
     -- at this point the first token is still active
     NTActive <- checkNtfToken a tkn
@@ -265,14 +259,13 @@ testNtfTokenSecondRegistration APNSMockServer {apnsQ} =
     pure ()
 
 testNtfTokenServerRestart :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestart t APNSMockServer {apnsQ} = do
+testNtfTokenServerRestart t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   ntfData <- withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+        getMockNotification apns tkn
       pure ntfData
   -- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server
   threadDelay 1000000
@@ -287,14 +280,13 @@ testNtfTokenServerRestart t APNSMockServer {apnsQ} = do
       pure ()
 
 testNtfTokenServerRestartReverify :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReverify t APNSMockServer {apnsQ} = do
+testNtfTokenServerRestartReverify t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a -> do
     ntfData <- withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+        getMockNotification apns tkn
       pure ntfData
     runRight_ $ do
       verification <- ntfData .-> "verification"
@@ -311,14 +303,13 @@ testNtfTokenServerRestartReverify t APNSMockServer {apnsQ} = do
       pure ()
 
 testNtfTokenServerRestartReverifyTimeout :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReverifyTimeout t APNSMockServer {apnsQ} = do
+testNtfTokenServerRestartReverifyTimeout t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
     (nonce, verification) <- withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+        getMockNotification apns tkn
       verification <- ntfData .-> "verification"
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a tkn nonce verification
@@ -347,14 +338,14 @@ testNtfTokenServerRestartReverifyTimeout t APNSMockServer {apnsQ} = do
       pure ()
 
 testNtfTokenServerRestartReregister :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReregister t APNSMockServer {apnsQ} = do
+testNtfTokenServerRestartReregister t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <-
+        getMockNotification apns tkn
+      pure ()
   -- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server
   threadDelay 1000000
   withAgent 2 agentCfg initAgentServers testDB $ \a' ->
@@ -362,9 +353,8 @@ testNtfTokenServerRestartReregister t APNSMockServer {apnsQ} = do
     -- so that repeat registration happens when client is restarted.
     withNtfServerStoreLog t $ \_ -> runRight_ $ do
       NTRegistered <- registerNtfToken a' tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+        getMockNotification apns tkn
       verification <- ntfData .-> "verification"
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a' tkn nonce verification
@@ -372,14 +362,14 @@ testNtfTokenServerRestartReregister t APNSMockServer {apnsQ} = do
       pure ()
 
 testNtfTokenServerRestartReregisterTimeout :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenServerRestartReregisterTimeout t APNSMockServer {apnsQ} = do
+testNtfTokenServerRestartReregisterTimeout t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
     withNtfServerStoreLog t $ \_ -> runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <-
+        getMockNotification apns tkn
+      pure ()
     -- this emulates the situation when server registered token but the client did not receive the response
     withTransaction store $ \db ->
       DB.execute
@@ -398,9 +388,8 @@ testNtfTokenServerRestartReregisterTimeout t APNSMockServer {apnsQ} = do
     -- so that repeat registration happens when client is restarted.
     withNtfServerStoreLog t $ \_ -> runRight_ $ do
       NTRegistered <- registerNtfToken a' tkn NMPeriodic
-      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-        atomically $ readTBQueue apnsQ
-      liftIO $ sendApnsResponse APNSRespOk
+      APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+        getMockNotification apns tkn
       verification <- ntfData .-> "verification"
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a' tkn nonce verification
@@ -414,18 +403,17 @@ getTestNtfTokenPort a =
     Nothing -> error "no active NtfToken"
 
 testNtfTokenMultipleServers :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenMultipleServers t APNSMockServer {apnsQ} = do
+testNtfTokenMultipleServers t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers2 testDB $ \a ->
     withNtfServerThreadOn t ntfTestPort $ \ntf ->
       withNtfServerThreadOn t ntfTestPort2 $ \ntf2 -> runRight_ $ do
         -- register a new token, the agent picks a server and stores its choice
         NTRegistered <- registerNtfToken a tkn NMPeriodic
-        APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-          atomically $ readTBQueue apnsQ
+        APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+          getMockNotification apns tkn
         verification <- ntfData .-> "verification"
         nonce <- C.cbNonce <$> ntfData .-> "nonce"
-        liftIO $ sendApnsResponse APNSRespOk
         verifyNtfToken a tkn nonce verification
         NTActive <- checkNtfToken a tkn
         -- shut down the "other" server
@@ -439,10 +427,10 @@ testNtfTokenMultipleServers t APNSMockServer {apnsQ} = do
         pure ()
 
 testNtfTokenChangeServers :: ATransport -> APNSMockServer -> IO ()
-testNtfTokenChangeServers t APNSMockServer {apnsQ} =
+testNtfTokenChangeServers t apns =
   withNtfServerThreadOn t ntfTestPort $ \ntf -> do
     tkn1 <- withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight $ do
-      tkn <- registerTestToken a "abcd" NMInstant apnsQ
+      tkn <- registerTestToken a "abcd" NMInstant apns
       NTActive <- checkNtfToken a tkn
       liftIO $ setNtfServers a [testNtfServer2]
       NTActive <- checkNtfToken a tkn -- still works on old server
@@ -457,15 +445,15 @@ testNtfTokenChangeServers t APNSMockServer {apnsQ} =
         liftIO $ setNtfServers a [testNtfServer2] -- just change configured server list
         getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort -- not yet changed
         -- trigger token replace
-        tkn2 <- registerTestToken a "xyzw" NMInstant apnsQ
+        tkn2 <- registerTestToken a "xyzw" NMInstant apns
         getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort -- not yet changed
         deleteNtfToken a tkn2 -- force server switch
-        Left BROKER {brokerErr = NETWORK} <- tryError $ registerTestToken a "qwer" NMInstant apnsQ -- ok, it's down for now
+        Left BROKER {brokerErr = NETWORK} <- tryError $ registerTestToken a "qwer" NMInstant apns -- ok, it's down for now
         getTestNtfTokenPort a >>= \port2 -> liftIO $ port2 `shouldBe` ntfTestPort2 -- but the token got updated
       killThread ntf
       withNtfServerOn t ntfTestPort2 $ runRight_ $ do
         liftIO $ threadDelay 1000000 -- for notification server to reconnect
-        tkn <- registerTestToken a "qwer" NMInstant apnsQ
+        tkn <- registerTestToken a "qwer" NMInstant apns
         checkNtfToken a tkn >>= \r -> liftIO $ r `shouldBe` NTActive
 
 testRunNTFServerTests :: ATransport -> NtfServer -> IO (Maybe ProtocolTestFailure)
@@ -475,7 +463,7 @@ testRunNTFServerTests t srv =
       testProtocolServer a 1 $ ProtoServerWithAuth srv Nothing
 
 testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
-testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
+testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
   (bobId, aliceId, nonce, message) <- runRight $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -488,11 +476,10 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
     -- register notification token
     let tkn = DeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken alice tkn NMInstant
-    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
-      atomically $ readTBQueue apnsQ
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+      getMockNotification apns tkn
     verification <- ntfData .-> "verification"
     vNonce <- C.cbNonce <$> ntfData .-> "nonce"
-    liftIO $ sendApnsResponse APNSRespOk
     verifyNtfToken alice tkn vNonce verification
     NTActive <- checkNtfToken alice tkn
     -- send message
@@ -500,7 +487,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
     -- notification
-    (nonce, message) <- messageNotification apnsQ
+    (nonce, message) <- messageNotification apns tkn
     pure (bobId, aliceId, nonce, message)
 
   -- alice client already has subscription for the connection
@@ -533,65 +520,64 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
     2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
     get bob ##> ("", aliceId, SENT $ baseId + 2)
     -- no notifications should follow
-    noNotification apnsQ
+    noNotification alice apns
   where
     msgId = subtract baseId
 
 testNotificationSubscriptionNewConnection :: HasCallStack => APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
-testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} baseId alice bob =
+testNotificationSubscriptionNewConnection apns baseId alice bob =
   runRight_ $ do
     -- alice registers notification token
-    DeviceToken {} <- registerTestToken alice "abcd" NMInstant apnsQ
+    DeviceToken {} <- registerTestToken alice "abcd" NMInstant apns
     -- bob registers notification token
-    DeviceToken {} <- registerTestToken bob "bcde" NMInstant apnsQ
+    DeviceToken {} <- registerTestToken bob "bcde" NMInstant apns
     -- establish connection
     liftIO $ threadDelay 50000
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
     liftIO $ threadDelay 1000000
     (aliceId, _sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
     liftIO $ threadDelay 750000
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     ("", _, CONF confId _ "bob's connInfo") <- get alice
     liftIO $ threadDelay 500000
     allowConnection alice bobId confId "alice's connInfo"
-    void $ messageNotificationData bob apnsQ
+    void $ messageNotificationData bob apns
     get bob ##> ("", aliceId, INFO "alice's connInfo")
-    when (baseId == 3) $ void $ messageNotificationData alice apnsQ
+    when (baseId == 3) $ void $ messageNotificationData alice apns
     get alice ##> ("", bobId, CON)
-    when (baseId == 3) $ void $ messageNotificationData bob apnsQ
+    when (baseId == 3) $ void $ messageNotificationData bob apns
     get bob ##> ("", aliceId, CON)
     -- bob sends message
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 1) Nothing
     -- alice sends message
     2 <- msgId <$> sendMessage alice bobId (SMP.MsgFlags True) "hey there"
     get alice ##> ("", bobId, SENT $ baseId + 2)
-    void $ messageNotificationData bob apnsQ
+    void $ messageNotificationData bob apns
     get bob =##> \case ("", c, Msg "hey there") -> c == aliceId; _ -> False
     ackMessage bob aliceId (baseId + 2) Nothing
     -- no unexpected notifications should follow
-    noNotification apnsQ
+    noNotifications apns
   where
     msgId = subtract baseId
 
-registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO DeviceToken
-registerTestToken a token mode apnsQ = do
+registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> APNSMockServer -> ExceptT AgentErrorType IO DeviceToken
+registerTestToken a token mode apns = do
   let tkn = DeviceToken PPApnsTest token
   NTRegistered <- registerNtfToken a tkn mode
-  Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
-    timeout 1000000 . atomically $ readTBQueue apnsQ
+  Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
+    timeout 1000000 $ getMockNotification apns tkn
   verification' <- ntfData' .-> "verification"
   nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
-  liftIO $ sendApnsResponse' APNSRespOk
   verifyNtfToken a tkn nonce' verification'
   NTActive <- checkNtfToken a tkn
   pure tkn
 
-testChangeNotificationsMode :: APNSMockServer -> IO ()
-testChangeNotificationsMode APNSMockServer {apnsQ} =
+testChangeNotificationsMode :: HasCallStack => APNSMockServer -> IO ()
+testChangeNotificationsMode apns =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -603,12 +589,12 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, CON)
     -- register notification token, set mode to NMInstant
-    tkn <- registerTestToken alice "abcd" NMInstant apnsQ
+    tkn <- registerTestToken alice "abcd" NMInstant apns
     -- send message, receive notification
     liftIO $ threadDelay 500000
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 1) Nothing
     -- set mode to NMPeriodic
@@ -617,7 +603,7 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
     liftIO $ threadDelay 750000
     2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
     get bob ##> ("", aliceId, SENT $ baseId + 2)
-    noNotification apnsQ
+    noNotification alice apns
     get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 2) Nothing
     -- set mode to NMInstant
@@ -626,7 +612,7 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
     liftIO $ threadDelay 500000
     3 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello there"
     get bob ##> ("", aliceId, SENT $ baseId + 3)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello there") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 3) Nothing
     -- turn off notifications
@@ -635,26 +621,26 @@ testChangeNotificationsMode APNSMockServer {apnsQ} =
     liftIO $ threadDelay 500000
     4 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "why hello there"
     get bob ##> ("", aliceId, SENT $ baseId + 4)
-    noNotification apnsQ
+    noNotifications apns
     get alice =##> \case ("", c, Msg "why hello there") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 4) Nothing
     -- turn on notifications, set mode to NMInstant
-    void $ registerTestToken alice "abcd" NMInstant apnsQ
+    void $ registerTestToken alice "abcd" NMInstant apns
     -- send message, receive notification
     liftIO $ threadDelay 500000
     5 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hey"
     get bob ##> ("", aliceId, SENT $ baseId + 5)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hey") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 5) Nothing
     -- no notifications should follow
-    noNotification apnsQ
+    noNotification alice apns
   where
     baseId = 1
     msgId = subtract baseId
 
 testChangeToken :: APNSMockServer -> IO ()
-testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers testDB2 $ \bob -> do
+testChangeToken apns = withAgent 1 agentCfg initAgentServers testDB2 $ \bob -> do
   (aliceId, bobId) <- withAgent 2 agentCfg initAgentServers testDB $ \alice -> runRight $ do
     -- establish connection
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -666,12 +652,12 @@ testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers t
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, CON)
     -- register notification token, set mode to NMInstant
-    void $ registerTestToken alice "abcd" NMInstant apnsQ
+    void $ registerTestToken alice "abcd" NMInstant apns
     -- send message, receive notification
     liftIO $ threadDelay 500000
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId (baseId + 1) Nothing
     pure (aliceId, bobId)
@@ -679,53 +665,66 @@ testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers t
   withAgent 3 agentCfg initAgentServers testDB $ \alice1 -> runRight_ $ do
     subscribeConnection alice1 bobId
     -- change notification token
-    void $ registerTestToken alice1 "bcde" NMInstant apnsQ
+    void $ registerTestToken alice1 "bcde" NMInstant apns
     -- send message, receive notification
     liftIO $ threadDelay 500000
     2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello there"
     get bob ##> ("", aliceId, SENT $ baseId + 2)
-    void $ messageNotificationData alice1 apnsQ
+    void $ messageNotificationData alice1 apns
     get alice1 =##> \case ("", c, Msg "hello there") -> c == bobId; _ -> False
     ackMessage alice1 bobId (baseId + 2) Nothing
     -- no notifications should follow
-    noNotification apnsQ
+    noNotification alice1 apns
   where
     baseId = 1
     msgId = subtract baseId
 
 testNotificationsStoreLog :: ATransport -> APNSMockServer -> IO ()
-testNotificationsStoreLog t APNSMockServer {apnsQ} = withAgentClients2 $ \alice bob -> do
-  (aliceId, bobId) <- withNtfServerStoreLog t $ \threadId -> runRight $ do
-    (aliceId, bobId) <- makeConnection alice bob
-    _ <- registerTestToken alice "abcd" NMInstant apnsQ
-    liftIO $ threadDelay 250000
-    2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
-    get bob ##> ("", aliceId, SENT 2)
-    void $ messageNotificationData alice apnsQ
-    get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
-    ackMessage alice bobId 2 Nothing
-    liftIO $ killThread threadId
-    pure (aliceId, bobId)
+testNotificationsStoreLog t apns = withAgentClients2 $ \alice bob -> do
+  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    (aliceId, bobId) <- withNtfServerStoreLog t $ \threadId -> runRight $ do
+      (aliceId, bobId) <- makeConnection alice bob
+      _ <- registerTestToken alice "abcd" NMInstant apns
+      liftIO $ threadDelay 250000
+      2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
+      get bob ##> ("", aliceId, SENT 2)
+      void $ messageNotificationData alice apns
+      get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
+      ackMessage alice bobId 2 Nothing
+      liftIO $ killThread threadId
+      pure (aliceId, bobId)
 
-  liftIO $ threadDelay 250000
-
-  withNtfServerStoreLog t $ \threadId -> runRight_ $ do
     liftIO $ threadDelay 250000
-    3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
-    get bob ##> ("", aliceId, SENT 3)
-    void $ messageNotificationData alice apnsQ
-    get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
-    liftIO $ killThread threadId
+
+    withNtfServerStoreLog t $ \threadId -> runRight_ $ do
+      liftIO $ threadDelay 250000
+      3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
+      get bob ##> ("", aliceId, SENT 3)
+      void $ messageNotificationData alice apns
+      get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
+      ackMessage alice bobId 3 Nothing
+      liftIO $ killThread threadId
+
+    runRight_ $ do
+      4 <- sendMessage bob aliceId (SMP.MsgFlags True) "message 4"
+      get bob ##> ("", aliceId, SENT 4)
+      get alice =##> \case ("", c, Msg "message 4") -> c == bobId; _ -> False
+      ackMessage alice bobId 4 Nothing
+      noNotifications apns
+
+  withSmpServerStoreMsgLogOn t testPort $ \_ ->
+    withNtfServerStoreLog t $ \_ -> runRight_ $ do
+      void $ messageNotificationData alice apns
 
 testNotificationsSMPRestart :: ATransport -> APNSMockServer -> IO ()
-testNotificationsSMPRestart t APNSMockServer {apnsQ} = withAgentClients2 $ \alice bob -> do
+testNotificationsSMPRestart t apns = withAgentClients2 $ \alice bob -> do
   (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \threadId -> runRight $ do
     (aliceId, bobId) <- makeConnection alice bob
-    _ <- registerTestToken alice "abcd" NMInstant apnsQ
+    _ <- registerTestToken alice "abcd" NMInstant apns
     liftIO $ threadDelay 250000
     2 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT 2)
-    void $ messageNotificationData alice apnsQ
+    void $ messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
     ackMessage alice bobId 2 Nothing
     liftIO $ killThread threadId
@@ -741,22 +740,22 @@ testNotificationsSMPRestart t APNSMockServer {apnsQ} = withAgentClients2 $ \alic
     liftIO $ threadDelay 1000000
     3 <- sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
     get bob ##> ("", aliceId, SENT 3)
-    _ <- messageNotificationData alice apnsQ
+    _ <- messageNotificationData alice apns
     get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
     liftIO $ killThread threadId
 
 testNotificationsSMPRestartBatch :: Int -> ATransport -> APNSMockServer -> IO ()
-testNotificationsSMPRestartBatch n t APNSMockServer {apnsQ} =
+testNotificationsSMPRestartBatch n t apns =
   withAgentClientsCfgServers2 agentCfg agentCfg initAgentServers2 $ \a b -> do
     threadDelay 1000000
     conns <- runServers $ do
       conns <- replicateM (n :: Int) $ makeConnection a b
-      _ <- registerTestToken a "abcd" NMInstant apnsQ
+      _ <- registerTestToken a "abcd" NMInstant apns
       liftIO $ threadDelay 5000000
       forM_ conns $ \(aliceId, bobId) -> do
         msgId <- sendMessage b aliceId (SMP.MsgFlags True) "hello"
         get b ##> ("", aliceId, SENT msgId)
-        void $ messageNotificationData a apnsQ
+        void $ messageNotificationData a apns
         get a =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
         ackMessage a bobId msgId Nothing
       pure conns
@@ -780,7 +779,7 @@ testNotificationsSMPRestartBatch n t APNSMockServer {apnsQ} =
       forM_ conns $ \(aliceId, bobId) -> do
         msgId <- sendMessage b aliceId (SMP.MsgFlags True) "hello again"
         get b ##> ("", aliceId, SENT msgId)
-        _ <- messageNotificationData a apnsQ
+        _ <- messageNotificationData a apns
         get a =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
   where
     runServers :: ExceptT AgentErrorType IO a -> IO a
@@ -792,16 +791,16 @@ testNotificationsSMPRestartBatch n t APNSMockServer {apnsQ} =
         pure res
 
 testSwitchNotifications :: InitialAgentServers -> APNSMockServer -> IO ()
-testSwitchNotifications servers APNSMockServer {apnsQ} =
+testSwitchNotifications servers apns =
   withAgentClientsCfgServers2 agentCfg agentCfg servers $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
     exchangeGreetings a bId b aId
-    _ <- registerTestToken a "abcd" NMInstant apnsQ
+    _ <- registerTestToken a "abcd" NMInstant apns
     liftIO $ threadDelay 250000
     let testMessage msg = do
           msgId <- sendMessage b aId (SMP.MsgFlags True) msg
           get b ##> ("", aId, SENT msgId)
-          void $ messageNotificationData a apnsQ
+          void $ messageNotificationData a apns
           get a =##> \case ("", c, Msg msg') -> c == bId && msg == msg'; _ -> False
           ackMessage a bId msgId Nothing
     testMessage "hello"
@@ -811,74 +810,80 @@ testSwitchNotifications servers APNSMockServer {apnsQ} =
     testMessage "hello again"
 
 testNotificationsOldToken :: APNSMockServer -> IO ()
-testNotificationsOldToken APNSMockServer {apnsQ} =
+testNotificationsOldToken apns =
   withAgentClients3 $ \a b c -> runRight_ $ do
     (abId, baId) <- makeConnection a b
-    let testMessageAB = testMessage_ apnsQ a abId b baId
-    _ <- registerTestToken a "abcd" NMInstant apnsQ
+    let testMessageAB = testMessage_ apns a abId b baId
+    _ <- registerTestToken a "abcd" NMInstant apns
     liftIO $ threadDelay 250000
     testMessageAB "hello"
     -- change server
     liftIO $ setNtfServers a [testNtfServer2] -- server 2 isn't running now, don't use
     -- replacing token keeps server
-    _ <- registerTestToken a "xyzw" NMInstant apnsQ
+    _ <- registerTestToken a "xyzw" NMInstant apns
     getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort
     testMessageAB "still there"
     -- new connections keep server
     (acId, caId) <- makeConnection a c
-    let testMessageAC = testMessage_ apnsQ a acId c caId
+    let testMessageAC = testMessage_ apns a acId c caId
     testMessageAC "greetings"
 
 testNotificationsNewToken :: APNSMockServer -> ThreadId -> IO ()
-testNotificationsNewToken APNSMockServer {apnsQ} oldNtf =
+testNotificationsNewToken apns oldNtf =
   withAgentClients3 $ \a b c -> runRight_ $ do
     (abId, baId) <- makeConnection a b
-    let testMessageAB = testMessage_ apnsQ a abId b baId
-    tkn <- registerTestToken a "abcd" NMInstant apnsQ
+    let testMessageAB = testMessage_ apns a abId b baId
+    tkn <- registerTestToken a "abcd" NMInstant apns
     getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort
     liftIO $ threadDelay 250000
     testMessageAB "hello"
     -- switch
     liftIO $ setNtfServers a [testNtfServer2]
     deleteNtfToken a tkn
-    _ <- registerTestToken a "abcd" NMInstant apnsQ
+    _ <- registerTestToken a "abcd" NMInstant apns
     getTestNtfTokenPort a >>= \port -> liftIO $ port `shouldBe` ntfTestPort2
     liftIO $ threadDelay 250000
     liftIO $ killThread oldNtf
     -- -- back to work
     testMessageAB "hello again"
     (acId, caId) <- makeConnection a c
-    let testMessageAC = testMessage_ apnsQ a acId c caId
+    let testMessageAC = testMessage_ apns a acId c caId
     testMessageAC "greetings"
 
-testMessage_ :: HasCallStack => TBQueue APNSMockRequest -> AgentClient -> ConnId -> AgentClient -> ConnId -> SMP.MsgBody -> ExceptT AgentErrorType IO ()
-testMessage_ apnsQ a aId b bId msg = do
+testMessage_ :: HasCallStack => APNSMockServer -> AgentClient -> ConnId -> AgentClient -> ConnId -> SMP.MsgBody -> ExceptT AgentErrorType IO ()
+testMessage_ apns a aId b bId msg = do
   msgId <- sendMessage b aId (SMP.MsgFlags True) msg
   get b ##> ("", aId, SENT msgId)
-  void $ messageNotificationData a apnsQ
+  void $ messageNotificationData a apns
   get a =##> \case ("", c, Msg msg') -> c == bId && msg == msg'; _ -> False
   ackMessage a bId msgId Nothing
 
-messageNotification :: HasCallStack => TBQueue APNSMockRequest -> ExceptT AgentErrorType IO (C.CbNonce, ByteString)
-messageNotification apnsQ = do
-  1000000 `timeout` atomically (readTBQueue apnsQ) >>= \case
+messageNotification :: HasCallStack => APNSMockServer -> DeviceToken -> ExceptT AgentErrorType IO (C.CbNonce, ByteString)
+messageNotification apns tkn = do
+  500000 `timeout` getMockNotification apns tkn >>= \case
     Nothing -> error "no notification"
-    Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}, sendApnsResponse} -> do
+    Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}} -> do
       nonce <- C.cbNonce <$> ntfData .-> "nonce"
       message <- ntfData .-> "message"
-      liftIO $ sendApnsResponse APNSRespOk
       pure (nonce, message)
     _ -> error "bad notification"
 
-messageNotificationData :: HasCallStack => AgentClient -> TBQueue APNSMockRequest -> ExceptT AgentErrorType IO PNMessageData
-messageNotificationData c apnsQ = do
-  (nonce, message) <- messageNotification apnsQ
-  NtfToken {ntfDhSecret = Just dhSecret} <- getNtfTokenData c
+messageNotificationData :: HasCallStack => AgentClient -> APNSMockServer -> ExceptT AgentErrorType IO PNMessageData
+messageNotificationData c apns = do
+  NtfToken {deviceToken, ntfDhSecret = Just dhSecret} <- getNtfTokenData c
+  (nonce, message) <- messageNotification apns deviceToken
   Right pnMsgs <- liftEither . first INTERNAL $ Right . parseAll pnMessagesP =<< first show (C.cbDecrypt dhSecret nonce message)
   pure $ L.last pnMsgs
 
-noNotification :: TBQueue APNSMockRequest -> ExceptT AgentErrorType IO ()
-noNotification apnsQ = do
-  500000 `timeout` atomically (readTBQueue apnsQ) >>= \case
+noNotification :: AgentClient -> APNSMockServer -> ExceptT AgentErrorType IO ()
+noNotification c apns = do
+  NtfToken {deviceToken} <- getNtfTokenData c
+  500000 `timeout` getMockNotification apns deviceToken >>= \case
+    Nothing -> pure ()
+    _ -> error "unexpected notification"
+
+noNotifications :: APNSMockServer -> ExceptT AgentErrorType IO ()
+noNotifications apns = do
+  500000 `timeout` getAnyMockNotification apns >>= \case
     Nothing -> pure ()
     _ -> error "unexpected notification"
diff --git a/tests/CoreTests/BatchingTests.hs b/tests/CoreTests/BatchingTests.hs
index a12cbf1ea..e2427b565 100644
--- a/tests/CoreTests/BatchingTests.hs
+++ b/tests/CoreTests/BatchingTests.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -14,11 +15,13 @@ import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString as B
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.List.NonEmpty as L
+import Data.Time.Clock.System (SystemTime, getSystemTime)
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
 import qualified Data.X509.File as XF
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport
 import Test.Hspec
@@ -26,29 +29,30 @@ import Test.Hspec
 batchingTests :: Spec
 batchingTests = do
   describe "batchTransmissions" $ do
-    describe "SMP v6 (current)" $ do
-      it "should batch with 107 subscriptions per batch" testBatchSubscriptions
+    describe "SMP v6 (previous)" $ do
+      it "should batch with 107 subscriptions per batch" testBatchSubscriptionsV6
+      it "should break on message that does not fit" testBatchWithMessageV6
+      it "should break on large message" testBatchWithLargeMessageV6
+    describe "SMP current" $ do
+      it "should batch with 136 subscriptions per batch" testBatchSubscriptions
       it "should break on message that does not fit" testBatchWithMessage
       it "should break on large message" testBatchWithLargeMessage
-    describe "v7 (next)" $ do
-      it "should batch with 136 subscriptions per batch" testBatchSubscriptionsV7
-      it "should break on message that does not fit" testBatchWithMessageV7
-      it "should break on large message" testBatchWithLargeMessageV7
   describe "batchTransmissions'" $ do
-    describe "SMP v6 (current)" $ do
-      it "should batch with 107 subscriptions per batch" testClientBatchSubscriptions
+    describe "SMP v6 (previous)" $ do
+      it "should batch with 107 subscriptions per batch" testClientBatchSubscriptionsV6
+      it "should break on message that does not fit" testClientBatchWithMessageV6
+      it "should break on large message" testClientBatchWithLargeMessageV6
+    describe "SMP current" $ do
+      it "should batch with 136 subscriptions per batch" testClientBatchSubscriptions
+      it "should batch with 255 ENDs per batch" testClientBatchENDs
+      it "should batch with 80 NMSGs per batch" testClientBatchNMSGs
       it "should break on message that does not fit" testClientBatchWithMessage
       it "should break on large message" testClientBatchWithLargeMessage
-    describe "v7 (next)" $ do
-      it "should batch with 136 subscriptions per batch" testClientBatchSubscriptionsV7
-      it "should batch with N ENDs per batch" testClientBatchENDs
-      it "should break on message that does not fit" testClientBatchWithMessageV7
-      it "should break on large message" testClientBatchWithLargeMessageV7
 
-testBatchSubscriptions :: IO ()
-testBatchSubscriptions = do
+testBatchSubscriptionsV6 :: IO ()
+testBatchSubscriptionsV6 = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs <- replicateM 250 $ randomSUB sessId
+  subs <- replicateM 250 $ randomSUBv6 sessId
   let batches1 = batchTransmissions False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   length batches1 `shouldBe` 250
@@ -58,10 +62,10 @@ testBatchSubscriptions = do
   (n1, n2, n3) `shouldBe` (36, 107, 107)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testBatchSubscriptionsV7 :: IO ()
-testBatchSubscriptionsV7 = do
+testBatchSubscriptions :: IO ()
+testBatchSubscriptions = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs <- replicateM 300 $ randomSUBv7 sessId
+  subs <- replicateM 300 $ randomSUB sessId
   let batches1 = batchTransmissions False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   length batches1 `shouldBe` 300
@@ -71,6 +75,22 @@ testBatchSubscriptionsV7 = do
   (n1, n2, n3) `shouldBe` (28, 136, 136)
   all lenOk [s1, s2, s3] `shouldBe` True
 
+testBatchWithMessageV6 :: IO ()
+testBatchWithMessageV6 = do
+  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
+  subs1 <- replicateM 60 $ randomSUBv6 sessId
+  send <- randomSENDv6 sessId 8000
+  subs2 <- replicateM 40 $ randomSUBv6 sessId
+  let cmds = subs1 <> [send] <> subs2
+      batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
+  all lenOk1 batches1 `shouldBe` True
+  length batches1 `shouldBe` 101
+  let batches = batchTransmissions True smpBlockSize $ L.fromList cmds
+  length batches `shouldBe` 2
+  [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _] <- pure batches
+  (n1, n2) `shouldBe` (47, 54)
+  all lenOk [s1, s2] `shouldBe` True
+
 testBatchWithMessage :: IO ()
 testBatchWithMessage = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
@@ -84,31 +104,15 @@ testBatchWithMessage = do
   let batches = batchTransmissions True smpBlockSize $ L.fromList cmds
   length batches `shouldBe` 2
   [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _] <- pure batches
-  (n1, n2) `shouldBe` (47, 54)
-  all lenOk [s1, s2] `shouldBe` True
-
-testBatchWithMessageV7 :: IO ()
-testBatchWithMessageV7 = do
-  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs1 <- replicateM 60 $ randomSUBv7 sessId
-  send <- randomSENDv7 sessId 8000
-  subs2 <- replicateM 40 $ randomSUBv7 sessId
-  let cmds = subs1 <> [send] <> subs2
-      batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
-  all lenOk1 batches1 `shouldBe` True
-  length batches1 `shouldBe` 101
-  let batches = batchTransmissions True smpBlockSize $ L.fromList cmds
-  length batches `shouldBe` 2
-  [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _] <- pure batches
   (n1, n2) `shouldBe` (32, 69)
   all lenOk [s1, s2] `shouldBe` True
 
-testBatchWithLargeMessage :: IO ()
-testBatchWithLargeMessage = do
+testBatchWithLargeMessageV6 :: IO ()
+testBatchWithLargeMessageV6 = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs1 <- replicateM 50 $ randomSUB sessId
-  send <- randomSEND sessId 17000
-  subs2 <- replicateM 150 $ randomSUB sessId
+  subs1 <- replicateM 50 $ randomSUBv6 sessId
+  send <- randomSENDv6 sessId 17000
+  subs2 <- replicateM 150 $ randomSUBv6 sessId
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -122,12 +126,12 @@ testBatchWithLargeMessage = do
   (n1, n2, n3) `shouldBe` (50, 43, 107)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testBatchWithLargeMessageV7 :: IO ()
-testBatchWithLargeMessageV7 = do
+testBatchWithLargeMessage :: IO ()
+testBatchWithLargeMessage = do
   sessId <- atomically . C.randomBytes 32 =<< C.newRandom
-  subs1 <- replicateM 60 $ randomSUBv7 sessId
-  send <- randomSENDv7 sessId 17000
-  subs2 <- replicateM 150 $ randomSUBv7 sessId
+  subs1 <- replicateM 60 $ randomSUB sessId
+  send <- randomSEND sessId 17000
+  subs2 <- replicateM 150 $ randomSUB sessId
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -141,10 +145,10 @@ testBatchWithLargeMessageV7 = do
   (n1, n2, n3) `shouldBe` (60, 14, 136)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testClientBatchSubscriptions :: IO ()
-testClientBatchSubscriptions = do
-  client <- testClientStub
-  subs <- replicateM 250 $ randomSUBCmd client
+testClientBatchSubscriptionsV6 :: IO ()
+testClientBatchSubscriptionsV6 = do
+  client <- testClientStubV6
+  subs <- replicateM 250 $ randomSUBCmdV6 client
   let batches1 = batchTransmissions' False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   let batches = batchTransmissions' True smpBlockSize $ L.fromList subs
@@ -154,10 +158,10 @@ testClientBatchSubscriptions = do
   (length rs1, length rs2, length rs3) `shouldBe` (36, 107, 107)
   all lenOk [s1, s2, s3] `shouldBe` True
 
-testClientBatchSubscriptionsV7 :: IO ()
-testClientBatchSubscriptionsV7 = do
-  client <- clientStubV7
-  subs <- replicateM 300 $ randomSUBCmdV7 client
+testClientBatchSubscriptions :: IO ()
+testClientBatchSubscriptions = do
+  client <- testClientStub
+  subs <- replicateM 300 $ randomSUBCmd client
   let batches1 = batchTransmissions' False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
   let batches = batchTransmissions' True smpBlockSize $ L.fromList subs
@@ -169,7 +173,7 @@ testClientBatchSubscriptionsV7 = do
 
 testClientBatchENDs :: IO ()
 testClientBatchENDs = do
-  client <- clientStubV7
+  client <- testClientStub
   ends <- replicateM 300 randomENDCmd
   let ends' = map (\t -> Right (Nothing, encodeTransmission (thParams client) t)) ends
       batches1 = batchTransmissions False smpBlockSize $ L.fromList ends'
@@ -181,6 +185,38 @@ testClientBatchENDs = do
   (length rs1, length rs2) `shouldBe` (45, 255)
   all lenOk [s1, s2] `shouldBe` True
 
+testClientBatchNMSGs :: IO ()
+testClientBatchNMSGs = do
+  client <- testClientStub
+  ts <- getSystemTime
+  ntfs <- replicateM 200 $ randomNMSGCmd ts
+  let ntfs' = map (\t -> Right (Nothing, encodeTransmission (thParams client) t)) ntfs
+      batches1 = batchTransmissions False smpBlockSize $ L.fromList ntfs'
+  all lenOk1 batches1 `shouldBe` True
+  let batches = batchTransmissions True smpBlockSize $ L.fromList ntfs'
+  length batches `shouldBe` 3
+  [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2, TBTransmissions s3 n3 rs3] <- pure batches
+  (n1, n2, n3) `shouldBe` (40, 80, 80)
+  (length rs1, length rs2, length rs3) `shouldBe` (40, 80, 80)
+  all lenOk [s1, s2, s3] `shouldBe` True
+
+testClientBatchWithMessageV6 :: IO ()
+testClientBatchWithMessageV6 = do
+  client <- testClientStubV6
+  subs1 <- replicateM 60 $ randomSUBCmdV6 client
+  send <- randomSENDCmdV6 client 8000
+  subs2 <- replicateM 40 $ randomSUBCmdV6 client
+  let cmds = subs1 <> [send] <> subs2
+      batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
+  all lenOk1 batches1 `shouldBe` True
+  length batches1 `shouldBe` 101
+  let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds
+  length batches `shouldBe` 2
+  [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2] <- pure batches
+  (n1, n2) `shouldBe` (47, 54)
+  (length rs1, length rs2) `shouldBe` (47, 54)
+  all lenOk [s1, s2] `shouldBe` True
+
 testClientBatchWithMessage :: IO ()
 testClientBatchWithMessage = do
   client <- testClientStub
@@ -194,33 +230,16 @@ testClientBatchWithMessage = do
   let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds
   length batches `shouldBe` 2
   [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2] <- pure batches
-  (n1, n2) `shouldBe` (47, 54)
-  (length rs1, length rs2) `shouldBe` (47, 54)
-  all lenOk [s1, s2] `shouldBe` True
-
-testClientBatchWithMessageV7 :: IO ()
-testClientBatchWithMessageV7 = do
-  client <- clientStubV7
-  subs1 <- replicateM 60 $ randomSUBCmdV7 client
-  send <- randomSENDCmdV7 client 8000
-  subs2 <- replicateM 40 $ randomSUBCmdV7 client
-  let cmds = subs1 <> [send] <> subs2
-      batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
-  all lenOk1 batches1 `shouldBe` True
-  length batches1 `shouldBe` 101
-  let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds
-  length batches `shouldBe` 2
-  [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2] <- pure batches
   (n1, n2) `shouldBe` (32, 69)
   (length rs1, length rs2) `shouldBe` (32, 69)
   all lenOk [s1, s2] `shouldBe` True
 
-testClientBatchWithLargeMessage :: IO ()
-testClientBatchWithLargeMessage = do
-  client <- testClientStub
-  subs1 <- replicateM 50 $ randomSUBCmd client
-  send <- randomSENDCmd client 17000
-  subs2 <- replicateM 150 $ randomSUBCmd client
+testClientBatchWithLargeMessageV6 :: IO ()
+testClientBatchWithLargeMessageV6 = do
+  client <- testClientStubV6
+  subs1 <- replicateM 50 $ randomSUBCmdV6 client
+  send <- randomSENDCmdV6 client 17000
+  subs2 <- replicateM 150 $ randomSUBCmdV6 client
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -244,12 +263,12 @@ testClientBatchWithLargeMessage = do
   (length rs1', length rs2') `shouldBe` (93, 107)
   all lenOk [s1', s2'] `shouldBe` True
 
-testClientBatchWithLargeMessageV7 :: IO ()
-testClientBatchWithLargeMessageV7 = do
-  client <- clientStubV7
-  subs1 <- replicateM 60 $ randomSUBCmdV7 client
-  send <- randomSENDCmdV7 client 17000
-  subs2 <- replicateM 150 $ randomSUBCmdV7 client
+testClientBatchWithLargeMessage :: IO ()
+testClientBatchWithLargeMessage = do
+  client <- testClientStub
+  subs1 <- replicateM 60 $ randomSUBCmd client
+  send <- randomSENDCmd client 17000
+  subs2 <- replicateM 150 $ randomSUBCmd client
   let cmds = subs1 <> [send] <> subs2
       batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds
   all lenOk1 batches1 `shouldBe` False
@@ -273,25 +292,25 @@ testClientBatchWithLargeMessageV7 = do
   (length rs1', length rs2') `shouldBe` (74, 136)
   all lenOk [s1', s2'] `shouldBe` True
 
-testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
-testClientStub = do
+testClientStubV6 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
+testClientStubV6 = do
   g <- C.newRandom
   sessId <- atomically $ C.randomBytes 32 g
   smpClientStub g sessId subModeSMPVersion Nothing
 
-clientStubV7 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
-clientStubV7 = do
+testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
+testClientStub = do
   g <- C.newRandom
   sessId <- atomically $ C.randomBytes 32 g
   (rKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
-  thAuth_ <- testTHandleAuth authCmdsSMPVersion g rKey
-  smpClientStub g sessId authCmdsSMPVersion thAuth_
+  thAuth_ <- testTHandleAuth currentClientSMPRelayVersion g rKey
+  smpClientStub g sessId currentClientSMPRelayVersion thAuth_
+
+randomSUBv6 :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
+randomSUBv6 = randomSUB_ C.SEd25519 subModeSMPVersion
 
 randomSUB :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSUB = randomSUB_ C.SEd25519 subModeSMPVersion
-
-randomSUBv7 :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSUBv7 = randomSUB_ C.SEd25519 authCmdsSMPVersion
+randomSUB = randomSUB_ C.SEd25519 currentClientSMPRelayVersion
 
 randomSUB_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> VersionSMP -> ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSUB_ a v sessId = do
@@ -304,11 +323,11 @@ randomSUB_ a v sessId = do
       TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId rId, Cmd SRecipient SUB)
   pure $ (,tToSend) <$> authTransmission thAuth_ (Just rpKey) nonce tForAuth
 
-randomSUBCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
-randomSUBCmd = randomSUBCmd_ C.SEd25519
+randomSUBCmdV6 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
+randomSUBCmdV6 = randomSUBCmd_ C.SEd25519
 
-randomSUBCmdV7 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
-randomSUBCmdV7 = randomSUBCmd_ C.SEd25519 -- same as v6
+randomSUBCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
+randomSUBCmd = randomSUBCmd_ C.SEd25519 -- same as v6
 
 randomSUBCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
 randomSUBCmd_ a c = do
@@ -323,11 +342,22 @@ randomENDCmd = do
   rId <- atomically $ C.randomBytes 24 g
   pure (CorrId "", EntityId rId, END)
 
-randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSEND = randomSEND_ C.SEd25519 subModeSMPVersion
+randomNMSGCmd :: SystemTime -> IO (Transmission BrokerMsg)
+randomNMSGCmd ts = do
+  g <- C.newRandom
+  nId <- atomically $ C.randomBytes 24 g
+  msgId <- atomically $ C.randomBytes 24 g
+  (k, pk) <- atomically $ C.generateKeyPair g
+  nonce <- atomically $ C.randomCbNonce g
+  let msgMeta = NMsgMeta {msgId, msgTs = ts}
+  Right encNMsgMeta <- pure $ C.cbEncrypt (C.dh' k pk) nonce (smpEncode msgMeta) 128
+  pure (CorrId "", EntityId nId, NMSG nonce encNMsgMeta)
 
-randomSENDv7 :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
-randomSENDv7 = randomSEND_ C.SX25519 authCmdsSMPVersion
+randomSENDv6 :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
+randomSENDv6 = randomSEND_ C.SEd25519 subModeSMPVersion
+
+randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
+randomSEND = randomSEND_ C.SX25519 currentClientSMPRelayVersion
 
 randomSEND_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> VersionSMP -> ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSEND_ a v sessId len = do
@@ -365,11 +395,11 @@ testTHandleAuth v g (C.APublicAuthKey a serverPeerPubKey) = case a of
     pure $ Just THAuthClient {serverPeerPubKey, serverCertKey, sessSecret = Nothing}
   _ -> pure Nothing
 
-randomSENDCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
-randomSENDCmd = randomSENDCmd_ C.SEd25519
+randomSENDCmdV6 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
+randomSENDCmdV6 = randomSENDCmd_ C.SEd25519
 
-randomSENDCmdV7 :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
-randomSENDCmdV7 = randomSENDCmd_ C.SX25519
+randomSENDCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
+randomSENDCmd = randomSENDCmd_ C.SX25519
 
 randomSENDCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
 randomSENDCmd_ a c len = do
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index 87ff797f0..6c38af721 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
@@ -14,14 +15,18 @@
 
 module NtfClient where
 
+import Control.Concurrent.STM (retry)
 import Control.Monad
 import Control.Monad.Except (runExceptT)
+import Control.Monad.IO.Class
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Types as JT
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
 import Data.List.NonEmpty (NonEmpty)
+import qualified Data.Map.Strict as M
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Network.HTTP.Types (Status)
@@ -33,13 +38,14 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost,
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Notifications.Protocol (NtfResponse)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfResponse)
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
 import Simplex.Messaging.Notifications.Server.Env
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
 import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol
+import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), http2TLSParams)
@@ -83,9 +89,9 @@ ntfServerCfg =
     { transports = [],
       subIdBytes = 24,
       regCodeBytes = 32,
-      clientQSize = 1,
-      subQSize = 1,
-      pushQSize = 1,
+      clientQSize = 2,
+      subQSize = 2,
+      pushQSize = 2,
       smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 0},
       apnsConfig =
         defaultAPNSPushClientConfig
@@ -124,7 +130,7 @@ ntfServerCfgVPrev =
 withNtfServerStoreLog :: ATransport -> (ThreadId -> IO a) -> IO a
 withNtfServerStoreLog t = withNtfServerCfg ntfServerCfg {storeLogFile = Just ntfTestStoreLogFile, transports = [(ntfTestPort, t, False)]}
 
-withNtfServerThreadOn :: ATransport -> ServiceName -> (ThreadId -> IO a) -> IO a
+withNtfServerThreadOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withNtfServerThreadOn t port' = withNtfServerCfg ntfServerCfg {transports = [(port', t, False)]}
 
 withNtfServerCfg :: HasCallStack => NtfServerConfig -> (ThreadId -> IO a) -> IO a
@@ -136,10 +142,10 @@ withNtfServerCfg cfg@NtfServerConfig {transports} =
         (\started -> runNtfServerBlocking started cfg)
         (pure ())
 
-withNtfServerOn :: ATransport -> ServiceName -> IO a -> IO a
+withNtfServerOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => IO a) -> IO a
 withNtfServerOn t port' = withNtfServerThreadOn t port' . const
 
-withNtfServer :: ATransport -> IO a -> IO a
+withNtfServer :: HasCallStack => ATransport -> (HasCallStack => IO a) -> IO a
 withNtfServer t = withNtfServerOn t ntfTestPort
 
 runNtfTest :: forall c a. Transport c => (THandleNTF c 'TClient -> IO a) -> IO a
@@ -166,22 +172,21 @@ ntfTest :: Transport c => TProxy c -> (THandleNTF c 'TClient -> IO ()) -> Expect
 ntfTest _ test' = runNtfTest test' `shouldReturn` ()
 
 data APNSMockRequest = APNSMockRequest
-  { notification :: APNSNotification,
-    sendApnsResponse :: APNSMockResponse -> IO ()
+  { notification :: APNSNotification
   }
 
 data APNSMockResponse = APNSRespOk | APNSRespError Status Text
 
 data APNSMockServer = APNSMockServer
   { action :: Async (),
-    apnsQ :: TBQueue APNSMockRequest,
+    notifications :: TM.TMap ByteString (TBQueue APNSMockRequest),
     http2Server :: HTTP2Server
   }
 
 apnsMockServerConfig :: HTTP2ServerConfig
 apnsMockServerConfig =
   HTTP2ServerConfig
-    { qSize = 1,
+    { qSize = 2,
       http2Port = apnsTestPort,
       bufferSize = 16384,
       bodyHeadSize = 16384,
@@ -224,23 +229,36 @@ deriving instance ToJSON APNSErrorResponse
 getAPNSMockServer :: HTTP2ServerConfig -> IO APNSMockServer
 getAPNSMockServer config@HTTP2ServerConfig {qSize} = do
   http2Server <- getHTTP2Server config Nothing
-  apnsQ <- newTBQueueIO qSize
-  action <- async $ runAPNSMockServer apnsQ http2Server
-  pure APNSMockServer {action, apnsQ, http2Server}
+  notifications <- TM.emptyIO
+  action <- async $ runAPNSMockServer notifications http2Server
+  pure APNSMockServer {action, notifications, http2Server}
   where
-    runAPNSMockServer apnsQ HTTP2Server {reqQ} = forever $ do
-      HTTP2Request {reqBody = HTTP2Body {bodyHead}, sendResponse} <- atomically $ readTBQueue reqQ
+    runAPNSMockServer notifications HTTP2Server {reqQ} = forever $ do
+      HTTP2Request {request, reqBody = HTTP2Body {bodyHead}, sendResponse} <- atomically $ readTBQueue reqQ
       let sendApnsResponse = \case
             APNSRespOk -> sendResponse $ H.responseNoBody N.ok200 []
             APNSRespError status reason ->
               sendResponse . H.responseBuilder status [] . lazyByteString $ J.encode APNSErrorResponse {reason}
       case J.decodeStrict' bodyHead of
-        Just notification ->
-          atomically $ writeTBQueue apnsQ APNSMockRequest {notification, sendApnsResponse}
+        Just notification -> do
+          Just token <- pure $ B.stripPrefix "/3/device/" =<< H.requestPath request
+          q <- atomically $ TM.lookup token notifications >>= maybe (newTokenQueue token) pure
+          atomically $ writeTBQueue q APNSMockRequest {notification}
+          sendApnsResponse APNSRespOk
+          where
+            newTokenQueue token = newTBQueue qSize >>= \q -> TM.insert token q notifications >> pure q
         _ -> do
           putStrLn $ "runAPNSMockServer J.decodeStrict' error, reqBody: " <> show bodyHead
           sendApnsResponse $ APNSRespError N.badRequest400 "bad_request_body"
 
+getMockNotification :: MonadIO m => APNSMockServer -> DeviceToken -> m APNSMockRequest
+getMockNotification APNSMockServer {notifications} (DeviceToken _ token) = do
+  atomically $ TM.lookup token notifications >>= maybe retry readTBQueue
+
+getAnyMockNotification :: MonadIO m => APNSMockServer -> m APNSMockRequest
+getAnyMockNotification APNSMockServer {notifications} = do
+  atomically $ readTVar notifications >>= mapM readTBQueue . M.elems >>= \case [] -> retry; ntf : _ -> pure ntf
+
 closeAPNSMockServer :: APNSMockServer -> IO ()
 closeAPNSMockServer APNSMockServer {action, http2Server} = do
   closeHTTP2Server http2Server
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index e3349e9a3..b9560976d 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -104,16 +104,15 @@ testNotificationSubscription (ATransport t) =
     (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
     let tkn = DeviceToken PPApnsTest "abcd"
-    withAPNSMockServer $ \APNSMockServer {apnsQ} ->
+    withAPNSMockServer $ \apns ->
       smpTest2 t $ \rh sh ->
         ntfTest t $ \nh -> do
           -- create queue
           (sId, rId, rKey, rcvDhSecret) <- createAndSecureQueue rh sPub
           -- register and verify token
           RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
-          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse = send} <-
-            atomically $ readTBQueue apnsQ
-          send APNSRespOk
+          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+            getMockNotification apns tkn
           let dhSecret = C.dh' ntfDh dhPriv
               Right verification = ntfData .-> "verification"
               Right nonce = C.cbNonce <$> ntfData .-> "nonce"
@@ -131,7 +130,7 @@ testNotificationSubscription (ATransport t) =
           threadDelay 50000
           Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello")
           -- receive notification
-          APNSMockRequest {notification, sendApnsResponse = send'} <- atomically $ readTBQueue apnsQ
+          APNSMockRequest {notification} <- getMockNotification apns tkn
           let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData'} = notification
               Right nonce' = C.cbNonce <$> ntfData' .-> "nonce"
               Right message = ntfData' .-> "message"
@@ -142,7 +141,6 @@ testNotificationSubscription (ATransport t) =
               Right NMsgMeta {msgId, msgTs} = parse smpP (AP.INTERNAL "error parsing NMsgMeta") nMsgMeta
           smpServer `shouldBe` srv
           notifierId `shouldBe` nId
-          send' APNSRespOk
           -- receive message
           Resp "" _ (MSG RcvMessage {msgId = mId1, msgBody = EncRcvMsgBody body}) <- tGet1 rh
           Right ClientRcvMsgBody {msgTs = mTs, msgBody} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret (C.cbNonce mId1) body)
@@ -154,9 +152,8 @@ testNotificationSubscription (ATransport t) =
           let tkn' = DeviceToken PPApnsTest "efgh"
           RespNtf "7" tId' NROk <- signSendRecvNtf nh tknKey ("7", tId, TRPL tkn')
           tId `shouldBe` tId'
-          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}, sendApnsResponse = send2} <-
-            atomically $ readTBQueue apnsQ
-          send2 APNSRespOk
+          APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}} <-
+            getMockNotification apns tkn'
           let Right verification2 = ntfData2 .-> "verification"
               Right nonce2 = C.cbNonce <$> ntfData2 .-> "nonce"
               Right code2 = NtfRegCode <$> C.cbDecrypt dhSecret nonce2 verification2
@@ -164,7 +161,7 @@ testNotificationSubscription (ATransport t) =
           RespNtf "8a" _ (NRTkn NTActive) <- signSendRecvNtf nh tknKey ("8a", tId, TCHK)
           -- send message
           Resp "9" _ OK <- signSendRecv sh sKey ("9", sId, _SEND' "hello 2")
-          APNSMockRequest {notification = notification3, sendApnsResponse = send3} <- atomically $ readTBQueue apnsQ
+          APNSMockRequest {notification = notification3} <- getMockNotification apns tkn'
           let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData3} = notification3
               Right nonce3 = C.cbNonce <$> ntfData3 .-> "nonce"
               Right message3 = ntfData3 .-> "message"
@@ -173,4 +170,3 @@ testNotificationSubscription (ATransport t) =
               APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} = L.last pnMsgs2
           smpServer3 `shouldBe` srv
           notifierId3 `shouldBe` nId
-          send3 APNSRespOk
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 970be7174..273cc90ad 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -62,6 +62,12 @@ testStoreMsgsFile = "tests/tmp/smp-server-messages.log"
 testStoreMsgsFile2 :: FilePath
 testStoreMsgsFile2 = "tests/tmp/smp-server-messages.log.2"
 
+testStoreNtfsFile :: FilePath
+testStoreNtfsFile = "tests/tmp/smp-server-ntfs.log"
+
+testStoreNtfsFile2 :: FilePath
+testStoreNtfsFile2 = "tests/tmp/smp-server-ntfs.log.2"
+
 testServerStatsBackupFile :: FilePath
 testServerStatsBackupFile = "tests/tmp/smp-server-stats.log"
 
@@ -104,17 +110,20 @@ cfg =
       msgIdBytes = 24,
       storeLogFile = Nothing,
       storeMsgsFile = Nothing,
+      storeNtfsFile = Nothing,
       allowNewQueues = True,
       newQueueBasicAuth = Nothing,
       controlPortUserAuth = Nothing,
       controlPortAdminAuth = Nothing,
       messageExpiration = Just defaultMessageExpiration,
+      notificationExpiration = defaultNtfExpiration,
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
       logStatsInterval = Nothing,
       logStatsStartTime = 0,
       serverStatsLogFile = "tests/smp-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
       pendingENDInterval = 500000,
+      ntfDeliveryInterval = 200000,
       smpCredentials =
         ServerCredentials
           { caCertificateFile = Just "tests/fixtures/ca.crt",
@@ -159,7 +168,15 @@ proxyVRangeV8 :: VersionRangeSMP
 proxyVRangeV8 = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion
 
 withSmpServerStoreMsgLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
-withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, serverStatsBackupFile = Just testServerStatsBackupFile}
+withSmpServerStoreMsgLogOn t =
+  withSmpServerConfigOn
+    t
+    cfg
+      { storeLogFile = Just testStoreLogFile,
+        storeMsgsFile = Just testStoreMsgsFile,
+        storeNtfsFile = Just testStoreNtfsFile,
+        serverStatsBackupFile = Just testServerStatsBackupFile
+      }
 
 withSmpServerStoreLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withSmpServerStoreLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, serverStatsBackupFile = Just testServerStatsBackupFile}
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 6fe10b38b..2025ff911 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -375,11 +375,11 @@ agentViaProxyRetryOffline = do
             ackMessage alice bobId (baseId + 4) Nothing
   where
     withServer :: (ThreadId -> IO a) -> IO a
-    withServer = withServer_ testStoreLogFile testStoreMsgsFile testPort
+    withServer = withServer_ testStoreLogFile testStoreMsgsFile testStoreNtfsFile testPort
     withServer2 :: (ThreadId -> IO a) -> IO a
-    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsFile2 testPort2
-    withServer_ storeLog storeMsgs port =
-      withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just storeLog, storeMsgsFile = Just storeMsgs} port
+    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsFile2 testStoreNtfsFile2 testPort2
+    withServer_ storeLog storeMsgs storeNtfs port =
+      withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just storeLog, storeMsgsFile = Just storeMsgs, storeNtfsFile = Just storeNtfs} port
     a `up` cId = nGet a =##> \case ("", "", UP _ [c]) -> c == cId; _ -> False
     a `down` cId = nGet a =##> \case ("", "", DOWN _ [c]) -> c == cId; _ -> False
     aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 0a1729ab8..d1ba7c67f 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -615,7 +615,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 2
     logSize testStoreMsgsFile `shouldReturn` 5
-    logSize testServerStatsBackupFile `shouldReturn` 72
+    logSize testServerStatsBackupFile `shouldReturn` 74
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
 
@@ -633,7 +633,7 @@ testRestoreMessages at@(ATransport t) =
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
     logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 72
+    logSize testServerStatsBackupFile `shouldReturn` 74
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
@@ -652,7 +652,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     logSize testStoreMsgsFile `shouldReturn` 0
-    logSize testServerStatsBackupFile `shouldReturn` 72
+    logSize testServerStatsBackupFile `shouldReturn` 74
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
 

From d0f65329fb1a27d917658568c0a5b68757813024 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 3 Oct 2024 12:12:55 +0100
Subject: [PATCH 142/195] ntf server: enable pings on ntf subscriptions (#1353)

---
 src/Simplex/Messaging/Client.hs               | 20 +++++++++++++------
 .../Messaging/Notifications/Server/Main.hs    |  2 +-
 2 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 54a53e3c5..b066e08b6 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -714,8 +714,8 @@ createSMPQueue c (rKey, rpKey) dhKey auth subMode sndSecure =
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue
 subscribeSMPQueue :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> ExceptT SMPClientError IO ()
-subscribeSMPQueue c@ProtocolClient {client_ = PClient {sendPings}} rpKey rId = do
-  liftIO . atomically $ writeTVar sendPings True
+subscribeSMPQueue c rpKey rId = do
+  liftIO $ enablePings c
   sendSMPCommand c (Just rpKey) rId SUB >>= \case
     OK -> pure ()
     cmd@MSG {} -> liftIO $ writeSMPMessage c rId cmd
@@ -723,8 +723,8 @@ subscribeSMPQueue c@ProtocolClient {client_ = PClient {sendPings}} rpKey rId = d
 
 -- | Subscribe to multiple SMP queues batching commands if supported.
 subscribeSMPQueues :: SMPClient -> NonEmpty (RcvPrivateAuthKey, RecipientId) -> IO (NonEmpty (Either SMPClientError ()))
-subscribeSMPQueues c@ProtocolClient {client_ = PClient {sendPings}} qs = do
-  atomically $ writeTVar sendPings True
+subscribeSMPQueues c qs = do
+  liftIO $ enablePings c
   sendProtocolCommands c cs >>= mapM (processSUBResponse c)
   where
     cs = L.map (\(rpKey, rId) -> (Just rpKey, rId, Cmd SRecipient SUB)) qs
@@ -763,14 +763,22 @@ getSMPMessage c rpKey rId =
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue-notifications
 subscribeSMPQueueNotifications :: SMPClient -> NtfPrivateAuthKey -> NotifierId -> ExceptT SMPClientError IO ()
-subscribeSMPQueueNotifications = okSMPCommand NSUB
+subscribeSMPQueueNotifications c npKey nId = do
+  liftIO $ enablePings c
+  okSMPCommand NSUB c npKey nId
 {-# INLINE subscribeSMPQueueNotifications #-}
 
 -- | Subscribe to multiple SMP queues notifications batching commands if supported.
 subscribeSMPQueuesNtfs :: SMPClient -> NonEmpty (NtfPrivateAuthKey, NotifierId) -> IO (NonEmpty (Either SMPClientError ()))
-subscribeSMPQueuesNtfs = okSMPCommands NSUB
+subscribeSMPQueuesNtfs c qs = do
+  liftIO $ enablePings c
+  okSMPCommands NSUB c qs
 {-# INLINE subscribeSMPQueuesNtfs #-}
 
+enablePings :: SMPClient -> IO ()
+enablePings ProtocolClient {client_ = PClient {sendPings}} = atomically $ writeTVar sendPings True
+{-# INLINE enablePings #-}
+
 -- | Secure the SMP queue by adding a sender public key.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#secure-queue-command
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index 16f8e430f..30b241166 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -143,7 +143,7 @@ ntfServerCLI cfgPath logPath =
                                 socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini,
                                 hostMode = either (const HMPublic) (either error id . textToHostMode) $ lookupValue "SUBSCRIBER" "host_mode" ini,
                                 requiredHostMode = fromMaybe False $ iniOnOff "SUBSCRIBER" "required_host_mode" ini,
-                                smpPingInterval = 60_000_000 -- 1 minutes
+                                smpPingInterval = 60_000_000 -- 1 minute
                               }
                         },
                     persistErrorInterval = 0 -- seconds

From 0e921d3258a0f210cc86f643a1599aa7151dcd14 Mon Sep 17 00:00:00 2001
From: sh <37271604+shumvgolove@users.noreply.github.com>
Date: Fri, 4 Oct 2024 08:57:07 +0000
Subject: [PATCH 143/195] scripts: preparations for new deployments (#1357)

* scripts/install: allow specifying version

* scripts/update: allow specifying version

* scripts/services: allow 443 for smp, allow infinite startup
---
 README.md                           | 11 +++++++--
 install.sh                          | 38 ++++++++++++++++++-----------
 scripts/main/simplex-servers-update | 20 ++++++++++++---
 scripts/main/smp-server.service     |  2 ++
 scripts/main/xftp-server.service    |  1 +
 5 files changed, 52 insertions(+), 20 deletions(-)

diff --git a/README.md b/README.md
index b43fe6920..b5cbca928 100644
--- a/README.md
+++ b/README.md
@@ -149,8 +149,15 @@ On Linux, you can deploy smp and xftp server using Docker. This will download im
 You can install and setup servers automatically using our script:
 
 ```sh
-curl --proto '=https' --tlsv1.2 -sSf https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/install.sh -o simplex-server-install.sh \
-&& if echo 'c90886104cd640b2ed64921dba80e90691db36788e8d6dcc13d8f33f92f0ea54 simplex-server-install.sh' | sha256sum -c; then chmod +x ./simplex-server-install.sh && ./simplex-server-install.sh; rm ./simplex-server-install.sh; else echo "SHA-256 checksum is incorrect!" && rm ./simplex-server-install.sh; fi
+curl --proto '=https' --tlsv1.2 -sSf https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/install.sh -o simplex-server-install.sh &&\
+if echo '53fcdb4ceab324316e2c4cda7e84dbbb344f32550a65975a7895425e5a1be757 simplex-server-install.sh' | sha256sum -c; then
+  chmod +x ./simplex-server-install.sh
+  ./simplex-server-install.sh
+  rm ./simplex-server-install.sh
+else
+  echo "SHA-256 checksum is incorrect!"
+  rm ./simplex-server-install.sh
+fi
 ```
 
 ### Build from source
diff --git a/install.sh b/install.sh
index 461215f71..4974c8a3c 100755
--- a/install.sh
+++ b/install.sh
@@ -2,9 +2,6 @@
 set -eu
 
 # Links to scripts/configs
-bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
-remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
-
 scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
 scripts_systemd_smp="$scripts/smp-server.service"
 scripts_systemd_xftp="$scripts/xftp-server.service"
@@ -57,7 +54,7 @@ ${GRN}1.${NC} Install latest binaries from GitHub releases:
 ${GRN}2.${NC} Create server directories:
     - smp: ${YLW}${path_conf_smp}${NC}
     - xftp: ${YLW}${path_conf_xftp}${NC}
-${GRN}3.${NC} Setup user for each server:
+${GRN}3.${NC} Setup user for server:
     - xmp: ${YLW}${user_smp}${NC}
     - xftp: ${YLW}${user_xftp}${NC}
 ${GRN}4.${NC} Create systemd services:
@@ -67,9 +64,8 @@ ${GRN}5.${NC} Install stopscript (systemd), update and uninstallation script:
     - all: ${YLW}${path_bin_update}${NC}, ${YLW}${path_bin_uninstall}${NC}, ${YLW}${path_bin_stopscript}${NC}
 
 Press:
-  - ${GRN}ENTER${NC} to continue installing both xftp and smp servers
-  - ${GRN}1${NC} to install only smp server
-  - ${GRN}2${NC} to install only xftp server
+  - ${GRN}1${NC} to install smp server
+  - ${GRN}2${NC} to install xftp server
   - ${RED}Ctrl+C${NC} to cancel installation
   
 Selection: "
@@ -83,6 +79,21 @@ Please checkout our server guides:
 To uninstall with full clean-up, simply run: ${YLW}sudo /usr/local/bin/simplex-servers-uninstall${NC}
 "
 
+set_version() {
+  ver="${VER:-latest}"
+
+  case "$ver" in 
+    latest)
+      bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
+      remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
+      ;;
+    *)
+      bin="https://github.com/simplex-chat/simplexmq/releases/download/${ver}"
+      remote_version="${ver}"
+      ;;
+  esac
+}
+
 os_test() {
  . /etc/os-release
 
@@ -155,6 +166,7 @@ checks() {
   exit 1
  fi
  
+ set_version
  os_test
 
  mkdir -p $path_conf_info  
@@ -166,13 +178,11 @@ main() {
  printf "%b\n%b" "${BLU}$logo${NC}" "$welcome"
  read ans
 
- if [ "$ans" = '1' ]; then
-  setup='smp'
- elif [ "$ans" = '2' ]; then
-  setup='xftp'
- else
-  setup='smp xftp'
- fi
+ case "$ans" in
+  1) setup='smp' ;;
+  2) setup='xftp' ;;
+  *) printf 'Installation aborted.\n' && exit 0 ;;
+ esac
 
  printf "Installing binaries..."
  
diff --git a/scripts/main/simplex-servers-update b/scripts/main/simplex-servers-update
index 7e85ff777..dad3c25b9 100755
--- a/scripts/main/simplex-servers-update
+++ b/scripts/main/simplex-servers-update
@@ -2,8 +2,6 @@
 set -eu
 
 # Links to scripts/configs
-bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
-
 scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
 scripts_systemd_smp="$scripts/smp-server.service"
 scripts_systemd_xftp="$scripts/xftp-server.service"
@@ -76,6 +74,21 @@ installed_test() {
   set -u
 }
 
+set_version() {
+  ver="${VER:-latest}"
+
+  case "$ver" in 
+    latest)
+      bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
+      remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
+      ;;
+    *)
+      bin="https://github.com/simplex-chat/simplexmq/releases/download/${ver}"
+      remote_version="${ver}"
+      ;;
+  esac
+}
+
 update_scripts() {
   curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_update" -o "$path_tmp_bin_update" && chmod +x "$path_tmp_bin_update"
   curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_uninstall" -o "$path_tmp_bin_uninstall" && chmod +x "$path_tmp_bin_uninstall"
@@ -137,8 +150,6 @@ update_bins() {
   eval "bin=\$bin_${1}"
   eval "path_bin=\$path_bin_${1}"
 
-  remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
-
   set_ver() {
     local_version='unset'
     sed -i -- "s/local_version_${1}=.*/local_version_${1}='${remote_version}'/" "$path_conf_info/release"
@@ -192,6 +203,7 @@ checks() {
     exit 1
   fi
 
+  set_version
   os_test
   installed_test
 
diff --git a/scripts/main/smp-server.service b/scripts/main/smp-server.service
index 3a845f1c6..6d365041d 100644
--- a/scripts/main/smp-server.service
+++ b/scripts/main/smp-server.service
@@ -9,7 +9,9 @@ ExecStart=/usr/local/bin/smp-server start +RTS -N -RTS
 ExecStopPost=/usr/local/bin/simplex-servers-stopscript smp-server
 LimitNOFILE=65535
 KillSignal=SIGINT
+TimeoutStartSec=infinity
 TimeoutStopSec=infinity
+AmbientCapabilities=CAP_NET_BIND_SERVICE
 
 [Install]
 WantedBy=multi-user.target
diff --git a/scripts/main/xftp-server.service b/scripts/main/xftp-server.service
index 51c8b1cd9..fcde29bf8 100644
--- a/scripts/main/xftp-server.service
+++ b/scripts/main/xftp-server.service
@@ -9,6 +9,7 @@ ExecStart=/usr/local/bin/xftp-server start +RTS -N -RTS
 ExecStopPost=/usr/local/bin/simplex-servers-stopscript xftp-server
 LimitNOFILE=65535
 KillSignal=SIGINT
+TimeoutStartSec=infinity
 TimeoutStopSec=infinity
 AmbientCapabilities=CAP_NET_BIND_SERVICE
    

From b130ea439acef2c46146eb98f0537a4f5ef8c9d3 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Fri, 4 Oct 2024 17:19:05 +0400
Subject: [PATCH 144/195] server: fix msgGetNoMsg stat (#1358)

---
 src/Simplex/Messaging/Server.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 54fef3ab3..014e78e8e 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -575,7 +575,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                 putStat "msgRecv" msgRecv
                 putStat "msgRecvGet" msgRecvGet
                 putStat "msgGet" msgGet
-                putStat "msgGetNoMsg" msgGet
+                putStat "msgGetNoMsg" msgGetNoMsg
                 gets <- (,,) <$> getStat msgGetAuth <*> getStat msgGetDuplicate <*> getStat msgGetProhibited
                 hPutStrLn h $ "other GET events (auth, duplicate, prohibited): " <> show gets
                 putStat "msgSentNtf" msgSentNtf

From 50e4abf8369c2d6a70ff32b41d909f9a61ff0b4d Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 6 Oct 2024 12:33:14 +0100
Subject: [PATCH 145/195] ntf server: control port (#1354)

* ntf server: control port

* version .405

* control

* use own_server_domains from INI file

* fix subs by server in control port

* bigger queues

* ntf server: only print subscriptions per own server when they are > 0

* fix tests

* revert version change

* dont import listThreads in ghc 8.10.7
---
 simplexmq.cabal                               |   1 +
 src/Simplex/FileTransfer/Server.hs            |   1 +
 src/Simplex/FileTransfer/Server/Control.hs    |   2 -
 src/Simplex/FileTransfer/Server/Main.hs       |   1 +
 src/Simplex/Messaging/Client/Agent.hs         |   4 +-
 src/Simplex/Messaging/Notifications/Server.hs | 152 +++++++++++++++++-
 .../Messaging/Notifications/Server/Control.hs |  37 +++++
 .../Messaging/Notifications/Server/Env.hs     |   5 +-
 .../Messaging/Notifications/Server/Main.hs    |  13 ++
 tests/NtfClient.hs                            |   3 +
 10 files changed, 206 insertions(+), 13 deletions(-)
 create mode 100644 src/Simplex/Messaging/Notifications/Server/Control.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 43e18ff5c..a77dfe9b0 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -154,6 +154,7 @@ library
       Simplex.Messaging.Notifications.Client
       Simplex.Messaging.Notifications.Protocol
       Simplex.Messaging.Notifications.Server
+      Simplex.Messaging.Notifications.Server.Control
       Simplex.Messaging.Notifications.Server.Env
       Simplex.Messaging.Notifications.Server.Main
       Simplex.Messaging.Notifications.Server.Push.APNS
diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index 24ad4815e..bfe5b8dd0 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -55,6 +55,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (CorrId (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity)
 import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
+import Simplex.Messaging.Server.Control (CPClientRole (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, getRoundedSystemTime)
 import Simplex.Messaging.Server.Stats
diff --git a/src/Simplex/FileTransfer/Server/Control.hs b/src/Simplex/FileTransfer/Server/Control.hs
index 75e54e55a..3a84ace49 100644
--- a/src/Simplex/FileTransfer/Server/Control.hs
+++ b/src/Simplex/FileTransfer/Server/Control.hs
@@ -8,8 +8,6 @@ import Simplex.FileTransfer.Protocol (XFTPFileId)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth)
 
-data CPClientRole = CPRNone | CPRUser | CPRAdmin
-
 data ControlProtocol
   = CPAuth BasicAuth
   | CPStatsRTS
diff --git a/src/Simplex/FileTransfer/Server/Main.hs b/src/Simplex/FileTransfer/Server/Main.hs
index 1f9246b1c..aca3b60df 100644
--- a/src/Simplex/FileTransfer/Server/Main.hs
+++ b/src/Simplex/FileTransfer/Server/Main.hs
@@ -101,6 +101,7 @@ xftpServerCLI cfgPath logPath = do
                \\n\
                \# control_port_admin_password:\n\
                \# control_port_user_password:\n\
+               \\n\
                \[TRANSPORT]\n\
                \# host is only used to print server address on start\n"
             <> ("host: " <> T.pack host <> "\n")
diff --git a/src/Simplex/Messaging/Client/Agent.hs b/src/Simplex/Messaging/Client/Agent.hs
index 378b470a3..1a7a67806 100644
--- a/src/Simplex/Messaging/Client/Agent.hs
+++ b/src/Simplex/Messaging/Client/Agent.hs
@@ -84,8 +84,8 @@ defaultSMPClientAgentConfig =
             maxInterval = 10 * second
           },
       persistErrorInterval = 30, -- seconds
-      msgQSize = 1024,
-      agentQSize = 1024,
+      msgQSize = 2048,
+      agentQSize = 2048,
       agentSubsBatchSize = 1360,
       ownServerDomains = []
     }
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 42c24aeb8..4e9f75f9e 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -23,7 +25,8 @@ import Data.Either (partitionEithers)
 import Data.Functor (($>))
 import Data.IORef
 import Data.Int (Int64)
-import Data.List (intercalate, sort)
+import qualified Data.IntSet as IS
+import Data.List (intercalate, partition, sort)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
@@ -34,34 +37,42 @@ import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Clock.System (getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import GHC.IORef (atomicSwapIORef)
-import Network.Socket (ServiceName)
+import GHC.Stats (getRTSStats)
+import Network.Socket (ServiceName, Socket, socketToHandle)
 import Simplex.Messaging.Client (ProtocolClientError (..), SMPClientError, ServerTransmission (..))
 import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Control
 import Simplex.Messaging.Notifications.Server.Env
 import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..), PushNotification (..), PushProviderError (..))
 import Simplex.Messaging.Notifications.Server.Stats
 import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Notifications.Server.StoreLog
 import Simplex.Messaging.Notifications.Transport
-import Simplex.Messaging.Protocol (EntityId (..), ErrorType (..), ProtocolServer (host), SMPServer, SignedTransmission, Transmission, pattern NoEntity, encodeTransmission, tGet, tPut)
+import Simplex.Messaging.Protocol (EntityId (..), ErrorType (..), ProtocolServer (host), SMPServer, SignedTransmission, Transmission, pattern NoEntity, pattern SMPServer, encodeTransmission, tGet, tPut)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
-import Simplex.Messaging.Server.Stats
+import Simplex.Messaging.Server.Control (CPClientRole (..))
+import Simplex.Messaging.Server.Stats (PeriodStats (..), PeriodStatCounts (..), periodStatCounts, updatePeriodStats)
+import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport (..), THandle (..), THandleAuth (..), THandleParams (..), TProxy, Transport (..), TransportPeer (..), defaultSupportedParams)
-import Simplex.Messaging.Transport.Server (AddHTTP, runTransportServer)
+import Simplex.Messaging.Transport.Buffer (trimCR)
+import Simplex.Messaging.Transport.Server (AddHTTP, runTransportServer, runLocalTCPServer)
 import Simplex.Messaging.Util
 import System.Exit (exitFailure)
-import System.IO (BufferMode (..), hPutStrLn, hSetBuffering)
+import System.IO (BufferMode (..), hClose, hPrint, hPutStrLn, hSetBuffering, hSetNewlineMode, universalNewlineMode)
 import System.Mem.Weak (deRefWeak)
-import UnliftIO (IOMode (..), async, uninterruptibleCancel, withFile)
+import UnliftIO (IOMode (..), UnliftIO, askUnliftIO, async, uninterruptibleCancel, unliftIO, withFile)
 import UnliftIO.Concurrent (forkIO, killThread, mkWeakThreadId)
 import UnliftIO.Directory (doesFileExist, renameFile)
 import UnliftIO.Exception
 import UnliftIO.STM
+#if MIN_VERSION_base(4,18,0)
+import GHC.Conc (listThreads)
+#endif
 
 runNtfServer :: NtfServerConfig -> IO ()
 runNtfServer cfg = do
@@ -79,7 +90,7 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
   s <- asks subscriber
   ps <- asks pushServer
   resubscribe s
-  raceAny_ (ntfSubscriber s : ntfPush ps : map runServer transports <> serverStatsThread_ cfg) `finally` stopServer
+  raceAny_ (ntfSubscriber s : ntfPush ps : map runServer transports <> serverStatsThread_ cfg <> controlPortThread_ cfg) `finally` stopServer
   where
     runServer :: (ServiceName, ATransport, AddHTTP) -> M ()
     runServer (tcpPort, ATransport t, _addHTTP) = do
@@ -152,6 +163,131 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
               ]
         liftIO $ threadDelay' interval
 
+    controlPortThread_ :: NtfServerConfig -> [M ()]
+    controlPortThread_ NtfServerConfig {controlPort = Just port} = [runCPServer port]
+    controlPortThread_ _ = []
+
+    runCPServer :: ServiceName -> M ()
+    runCPServer port = do
+      cpStarted <- newEmptyTMVarIO
+      u <- askUnliftIO
+      liftIO $ do
+        labelMyThread "control port server"
+        runLocalTCPServer cpStarted port $ runCPClient u
+      where
+        runCPClient :: UnliftIO (ReaderT NtfEnv IO) -> Socket -> IO ()
+        runCPClient u sock = do
+          labelMyThread "control port client"
+          h <- socketToHandle sock ReadWriteMode
+          hSetBuffering h LineBuffering
+          hSetNewlineMode h universalNewlineMode
+          hPutStrLn h "Ntf server control port\n'help' for supported commands"
+          role <- newTVarIO CPRNone
+          cpLoop h role
+          where
+            cpLoop h role = do
+              s <- trimCR <$> B.hGetLine h
+              case strDecode s of
+                Right CPQuit -> hClose h
+                Right cmd -> logCmd s cmd >> processCP h role cmd >> cpLoop h role
+                Left err -> hPutStrLn h ("error: " <> err) >> cpLoop h role
+            logCmd s cmd = when shouldLog $ logWarn $ "ControlPort: " <> tshow s
+              where
+                shouldLog = case cmd of
+                  CPAuth _ -> False
+                  CPHelp -> False
+                  CPQuit -> False
+                  CPSkip -> False
+                  _ -> True
+            processCP h role = \case
+              CPAuth auth -> atomically $ writeTVar role $! newRole cfg
+                where
+                  newRole NtfServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin}
+                    | Just auth == admin = CPRAdmin
+                    | Just auth == user = CPRUser
+                    | otherwise = CPRNone
+              CPStats -> withUserRole $ do
+                ss <- unliftIO u $ asks serverStats
+                let getStat :: (NtfServerStats -> IORef a) -> IO a
+                    getStat var = readIORef (var ss)
+                    putStat :: Show a => String -> (NtfServerStats -> IORef a) -> IO ()
+                    putStat label var = getStat var >>= \v -> hPutStrLn h $ label <> ": " <> show v
+                putStat "fromTime" fromTime
+                putStat "tknCreated" tknCreated
+                putStat "tknVerified" tknVerified
+                putStat "tknDeleted" tknDeleted
+                putStat "subCreated" subCreated
+                putStat "subDeleted" subDeleted
+                putStat "ntfReceived" ntfReceived
+                getStat (day . activeTokens) >>= \v -> hPutStrLn h $ "daily active tokens: " <> show (IS.size v)
+                getStat (day . activeSubs) >>= \v -> hPutStrLn h $ "daily active subscriptions: " <> show (IS.size v)
+              CPStatsRTS -> tryAny getRTSStats >>= either (hPrint h) (hPrint h)
+              CPServerInfo -> readTVarIO role >>= \case
+                CPRNone -> do
+                  logError "Unauthorized control port command"
+                  hPutStrLn h "AUTH"
+                r -> do
+#if MIN_VERSION_base(4,18,0)
+                  threads <- liftIO listThreads
+                  hPutStrLn h $ "Threads: " <> show (length threads)
+#else
+                  hPutStrLn h "Threads: not available on GHC 8.10"
+#endif
+                  NtfSubscriber {smpSubscribers, smpAgent = a} <- unliftIO u $ asks subscriber
+                  putSMPWorkers a "SMP subcscribers" smpSubscribers
+                  let SMPClientAgent {smpClients, smpSessions, srvSubs, pendingSrvSubs, smpSubWorkers} = a
+                  putSMPWorkers a "SMP clients" smpClients
+                  putSMPWorkers a "SMP subscription workers" smpSubWorkers
+                  sessions <- readTVarIO smpSessions
+                  hPutStrLn h $ "SMP sessions count: " <> show (M.size sessions)
+                  putSMPSubs a "SMP subscriptions" srvSubs
+                  putSMPSubs a "Pending SMP subscriptions" pendingSrvSubs
+                  where
+                    putSMPSubs :: SMPClientAgent -> String -> TMap SMPServer (TMap SMPSub a) -> IO ()
+                    putSMPSubs a name v = do
+                      subs <- readTVarIO v
+                      (totalCnt, ownCount, otherCnt, servers, ownByServer) <- foldM countSubs (0, 0, 0, [], M.empty) $ M.assocs subs
+                      showServers a name servers
+                      hPutStrLn h $ name <> " total: " <> show totalCnt
+                      hPutStrLn h $ name <> " on own servers: " <> show ownCount
+                      when (r == CPRAdmin && not (null ownByServer)) $
+                        forM_ (M.assocs ownByServer) $ \(SMPServer (host :| _) _ _, cnt) ->
+                          hPutStrLn h $ name <> " on " <> B.unpack (strEncode host) <> ": " <> show cnt
+                      hPutStrLn h $ name <> " on other servers: " <> show otherCnt
+                      where
+                        countSubs :: (Int, Int, Int, [SMPServer], M.Map SMPServer Int) -> (SMPServer, TMap SMPSub a) -> IO (Int, Int, Int, [SMPServer], M.Map SMPServer Int)
+                        countSubs (!totalCnt, !ownCount, !otherCnt, !servers, !ownByServer) (srv, srvSubs) = do
+                          cnt <- M.size <$> readTVarIO srvSubs
+                          let totalCnt' = totalCnt + cnt
+                              ownServer = isOwnServer a srv
+                              (ownCount', otherCnt')
+                                | ownServer = (ownCount + cnt, otherCnt)
+                                | otherwise = (ownCount, otherCnt + cnt)
+                              servers' = if cnt > 0 then srv : servers else servers
+                              ownByServer'
+                                | r == CPRAdmin && ownServer && cnt > 0 = M.alter (Just . maybe cnt (+ cnt)) srv ownByServer
+                                | otherwise = ownByServer
+                          pure (totalCnt', ownCount', otherCnt', servers', ownByServer')
+                    putSMPWorkers :: SMPClientAgent -> String -> TMap SMPServer a -> IO ()
+                    putSMPWorkers a name v = readTVarIO v >>= showServers a name . M.keys
+                    showServers :: SMPClientAgent -> String -> [SMPServer] -> IO ()
+                    showServers a name srvs = do
+                      let (ownSrvs, otherSrvs) = partition (isOwnServer a) srvs
+                      hPutStrLn h $ name <> " own servers count: " <> show (length ownSrvs)
+                      when (r == CPRAdmin) $ hPutStrLn h $ name <> " own servers: " <> intercalate "," (sort $ map (\(SMPServer (host :| _) _ _) -> B.unpack $ strEncode host) ownSrvs)
+                      hPutStrLn h $ name <> " other servers count: " <> show (length otherSrvs)
+              CPHelp -> hPutStrLn h "commands: stats, stats-rts, server-info, help, quit"
+              CPQuit -> pure ()
+              CPSkip -> pure ()
+              where
+                withUserRole action =
+                  readTVarIO role >>= \case
+                    CPRAdmin -> action
+                    CPRUser -> action
+                    _ -> do
+                      logError "Unauthorized control port command"
+                      hPutStrLn h "AUTH"
+
 resubscribe :: NtfSubscriber -> M ()
 resubscribe NtfSubscriber {newSubQ} = do
   logInfo "Preparing SMP resubscriptions..."
diff --git a/src/Simplex/Messaging/Notifications/Server/Control.hs b/src/Simplex/Messaging/Notifications/Server/Control.hs
new file mode 100644
index 000000000..234baede2
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Server/Control.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Messaging.Notifications.Server.Control where
+
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (BasicAuth)
+
+data ControlProtocol
+  = CPAuth BasicAuth
+  | CPStats
+  | CPStatsRTS
+  | CPServerInfo
+  | CPHelp
+  | CPQuit
+  | CPSkip
+
+instance StrEncoding ControlProtocol where
+  strEncode = \case
+    CPAuth tok -> "auth " <> strEncode tok
+    CPStats -> "stats"
+    CPStatsRTS -> "stats-rts"
+    CPServerInfo -> "server-info"
+    CPHelp -> "help"
+    CPQuit -> "quit"
+    CPSkip -> ""
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "auth" -> CPAuth <$> _strP
+      "stats" -> pure CPStats
+      "stats-rts" -> pure CPStatsRTS
+      "server-info" -> pure CPServerInfo
+      "help" -> pure CPHelp
+      "quit" -> pure CPQuit
+      "" -> pure CPSkip
+      _ -> fail "bad ControlProtocol command"
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 8fd2a33ad..6ac250258 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -28,7 +28,7 @@ import Simplex.Messaging.Notifications.Server.Stats
 import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Notifications.Server.StoreLog
 import Simplex.Messaging.Notifications.Transport (NTFVersion, VersionRangeNTF)
-import Simplex.Messaging.Protocol (CorrId, SMPServer, Transmission)
+import Simplex.Messaging.Protocol (BasicAuth, CorrId, SMPServer, Transmission)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -40,6 +40,9 @@ import UnliftIO.STM
 
 data NtfServerConfig = NtfServerConfig
   { transports :: [(ServiceName, ATransport, AddHTTP)],
+    controlPort :: Maybe ServiceName,
+    controlPortUserAuth :: Maybe BasicAuth,
+    controlPortAdminAuth :: Maybe BasicAuth,
     subIdBytes :: Int,
     regCodeBytes :: Int,
     clientQSize :: Natural,
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index 30b241166..0c5d5e54b 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -14,6 +14,7 @@ import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
 import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
@@ -85,6 +86,10 @@ ntfServerCLI cfgPath logPath =
           \# Log is compacted on start (deleted objects are removed).\n"
             <> ("enable: " <> onOff enableStoreLog <> "\n\n")
             <> "log_stats: off\n\n\
+               \[AUTH]\n\
+               \# control_port_admin_password:\n\
+               \# control_port_user_password:\n\
+               \\n\
                \[TRANSPORT]\n\
                \# Host is only used to print server address on start.\n\
                \# You can specify multiple server ports.\n"
@@ -93,6 +98,8 @@ ntfServerCLI cfgPath logPath =
             <> "log_tls_errors: off\n\n\
                \# Use `websockets: 443` to run websockets server in addition to plain TLS.\n\
                \websockets: off\n\n\
+               \# control_port: 5227\n\
+               \\n\
                \[SUBSCRIBER]\n\
                \# Network configuration for notification server client.\n\
                \# `host_mode` can be 'public' (default) or 'onion'.\n\
@@ -105,6 +112,8 @@ ntfServerCLI cfgPath logPath =
                \# `socks_mode` can be 'onion' for SOCKS proxy to be used for .onion destination hosts only (default)\n\
                \# or 'always' to be used for all destination hosts (can be used if it is an .onion server).\n\
                \# socks_mode: onion\n\n\
+               \# The domain suffixes of the relays you operate (space-separated) to count as separate proxy statistics.\n\
+               \# own_server_domains: \n\n\
                \[INACTIVE_CLIENTS]\n\
                \# TTL and interval to check inactive clients\n\
                \disconnect: off\n"
@@ -128,6 +137,9 @@ ntfServerCLI cfgPath logPath =
         serverConfig =
           NtfServerConfig
             { transports = iniTransports ini,
+              controlPort = either (const Nothing) (Just . T.unpack) $ lookupValue "TRANSPORT" "control_port" ini,
+              controlPortAdminAuth = either error id <$!> strDecodeIni "AUTH" "control_port_admin_password" ini,
+              controlPortUserAuth = either error id <$!> strDecodeIni "AUTH" "control_port_user_password" ini,
               subIdBytes = 24,
               regCodeBytes = 32,
               clientQSize = 64,
@@ -146,6 +158,7 @@ ntfServerCLI cfgPath logPath =
                                 smpPingInterval = 60_000_000 -- 1 minute
                               }
                         },
+                    ownServerDomains = either (const []) (map encodeUtf8 . T.words) $ lookupValue "SUBSCRIBER" "own_server_domains" ini,
                     persistErrorInterval = 0 -- seconds
                   },
               apnsConfig = defaultAPNSPushClientConfig,
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index 6c38af721..05055fe45 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -87,6 +87,9 @@ ntfServerCfg :: NtfServerConfig
 ntfServerCfg =
   NtfServerConfig
     { transports = [],
+      controlPort = Nothing,
+      controlPortUserAuth = Nothing,
+      controlPortAdminAuth = Nothing,
       subIdBytes = 24,
       regCodeBytes = 32,
       clientQSize = 2,

From 97d45fb2a645236bffc4dfc5b9c7e06e8358393a Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 6 Oct 2024 12:34:44 +0100
Subject: [PATCH 146/195] smp server: pass server information via CLI during
 server initialization (#1356)

* smp server: pass server information via CLI during server initialization

* more info

* enable client expiration by default, disable port 8000

* update
---
 apps/smp-server/static/index.html           |   6 +
 apps/smp-server/web/Static.hs               |   4 +-
 src/Simplex/FileTransfer/Server/Env.hs      |   2 +-
 src/Simplex/Messaging/Server/Information.hs |  50 +++++
 src/Simplex/Messaging/Server/Main.hs        | 220 +++++++++++++++-----
 tests/CLITests.hs                           |   4 +-
 6 files changed, 232 insertions(+), 54 deletions(-)

diff --git a/apps/smp-server/static/index.html b/apps/smp-server/static/index.html
index de7ac9e46..68ac6d906 100644
--- a/apps/smp-server/static/index.html
+++ b/apps/smp-server/static/index.html
@@ -295,6 +295,12 @@
                   <td>${hostingEntity} (${hostingCountry})</td>
                 </tr>
               </x-hosting>
+              <x-hostingType>
+                <tr class="text-grey-black dark:text-white text-base">
+                  <td>Hosting type:</td>
+                  <td>${hostingType}</td>
+                </tr>
+              </x-hostingType>
               <x-serverCountry>
                 <tr class="text-grey-black dark:text-white text-base">
                   <td>Server country:</td>
diff --git a/apps/smp-server/web/Static.hs b/apps/smp-server/web/Static.hs
index 510034a4a..342b4ae33 100644
--- a/apps/smp-server/web/Static.hs
+++ b/apps/smp-server/web/Static.hs
@@ -8,6 +8,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Char (toUpper)
 import Data.IORef (readIORef)
 import Data.Maybe (fromMaybe)
 import Data.String (fromString)
@@ -150,7 +151,8 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
             ("hostingCountry", encodeUtf8 <$> country)
           ]
         server =
-          [ ("serverCountry", fmap encodeUtf8 $ serverCountry =<< information)
+          [ ("serverCountry", encodeUtf8 <$> serverCountry spi),
+            ("hostingType",  (\s -> maybe s (\(c, rest) -> toUpper c `B.cons` rest) $ B.uncons s) . strEncode <$> hostingType spi)
           ]
 
 -- Copy-pasted from simplex-chat Simplex.Chat.Types.Preferences
diff --git a/src/Simplex/FileTransfer/Server/Env.hs b/src/Simplex/FileTransfer/Server/Env.hs
index c967d834c..a9b6c9a79 100644
--- a/src/Simplex/FileTransfer/Server/Env.hs
+++ b/src/Simplex/FileTransfer/Server/Env.hs
@@ -72,7 +72,7 @@ data XFTPServerConfig = XFTPServerConfig
 defaultInactiveClientExpiration :: ExpirationConfig
 defaultInactiveClientExpiration =
   ExpirationConfig
-    { ttl = 43200, -- seconds, 12 hours
+    { ttl = 21600, -- seconds, 6 hours
       checkInterval = 3600 -- seconds, 1 hours
     }
 
diff --git a/src/Simplex/Messaging/Server/Information.hs b/src/Simplex/Messaging/Server/Information.hs
index 01052541d..422dab224 100644
--- a/src/Simplex/Messaging/Server/Information.hs
+++ b/src/Simplex/Messaging/Server/Information.hs
@@ -1,14 +1,21 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Simplex.Messaging.Server.Information where
 
+import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson.TH as J
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Int (Int64)
+import Data.Maybe (isJust)
 import Data.Text (Text)
 import Simplex.Messaging.Agent.Protocol (ConnectionMode (..), ConnectionRequestUri)
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
 
 data ServerInformation = ServerInformation
@@ -36,16 +43,59 @@ data ServerPublicInfo = ServerPublicInfo
     adminContacts :: Maybe ServerContactAddress,
     complaintsContacts :: Maybe ServerContactAddress,
     hosting :: Maybe Entity,
+    hostingType :: Maybe HostingType,
     serverCountry :: Maybe Text
   }
   deriving (Show)
 
+emptyServerInfo :: Text -> ServerPublicInfo
+emptyServerInfo sourceCode =
+  ServerPublicInfo
+    { sourceCode,
+      usageConditions = Nothing,
+      operator = Nothing,
+      website = Nothing,
+      adminContacts = Nothing,
+      complaintsContacts = Nothing,
+      hosting = Nothing,
+      hostingType = Nothing,
+      serverCountry = Nothing
+    }
+
+hasServerInfo :: ServerPublicInfo -> Bool
+hasServerInfo ServerPublicInfo {usageConditions, operator, website, adminContacts, complaintsContacts, hosting, hostingType, serverCountry} =
+  isJust usageConditions || isJust operator || isJust website || isJust adminContacts || isJust complaintsContacts || isJust hosting || isJust hostingType || isJust serverCountry
+
 data ServerPersistenceMode = SPMMemoryOnly | SPMQueues | SPMMessages
   deriving (Show)
 
 data ServerConditions = ServerConditions {conditions :: Text, amendments :: Maybe Text}
   deriving (Show)
 
+data HostingType = HTVirtual | HTDedicated | HTColocation | HTOwned
+  deriving (Show)
+
+instance StrEncoding HostingType where
+  strEncode = \case
+    HTVirtual -> "virtual"
+    HTDedicated -> "dedicated"
+    HTColocation -> "colocation"
+    HTOwned -> "owned"
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "virtual" -> pure HTVirtual
+      "dedicated" -> pure HTDedicated
+      "colocation" -> pure HTColocation
+      "owned" -> pure HTOwned
+      _ -> fail "bad HostingType"
+
+instance FromJSON HostingType where
+  parseJSON = strParseJSON "HostingType"
+
+instance ToJSON HostingType where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
 data Entity = Entity {name :: Text, country :: Maybe Text}
   deriving (Show)
 
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index ca4a5ed60..33e275862 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -14,7 +15,7 @@ module Simplex.Messaging.Server.Main where
 
 import Control.Concurrent.STM
 import Control.Logger.Simple
-import Control.Monad (void, when, (<$!>))
+import Control.Monad
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (isAlpha, isAscii, toUpper)
@@ -25,7 +26,7 @@ import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
+import Data.Text.Encoding (encodeUtf8, decodeLatin1)
 import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
@@ -42,11 +43,12 @@ import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedServerSMPRelayVRange)
-import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Transport.Client (SocksProxy, TransportHost (..), defaultSocksProxy)
 import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow)
 import Simplex.Messaging.Version (mkVersionRange)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.Exit (exitFailure)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)
@@ -93,6 +95,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       | scripted = initialize opts
       | otherwise = do
           putStrLn "Use `smp-server init -h` for available options."
+          checkInitOptions opts
           void $ withPrompt "SMP server will be initialized (press Enter)" getLine
           enableStoreLog <- onOffPrompt "Enable store log to restore queues and messages on server restart" True
           logStats <- onOffPrompt "Enable logging daily statistics" False
@@ -108,7 +111,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 logStats,
                 fqdn = if null host' then fqdn else Just host',
                 password,
-                sourceCode = (T.pack <$> sourceCode') <|> src',
+                sourceCode = (T.pack <$> sourceCode') <|> src' <|> Just (T.pack simplexmqSource),
                 webStaticPath = if null staticPath' then sp' else Just staticPath',
                 disableWeb = noWeb'
               }
@@ -122,7 +125,18 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               case strDecode $ encodeUtf8 $ T.pack s of
                 Right auth -> pure . Just $ ServerPassword auth
                 _ -> putStrLn "Invalid password. Only latin letters, digits and symbols other than '@' and ':' are allowed" >> serverPassword
-        initialize InitOptions {enableStoreLog, logStats, signAlgorithm, password, sourceCode, webStaticPath, disableWeb} = do
+        checkInitOptions InitOptions {sourceCode, serverInfo, operatorCountry, hostingCountry} = do
+          let err_
+                | isNothing sourceCode && hasServerInfo serverInfo = 
+                    Just "Error: passing any server information requires passing --source-code"
+                | isNothing (operator serverInfo) && isJust operatorCountry =
+                    Just "Error: passing --operator-country requires passing --operator"
+                | isNothing (hosting serverInfo) && isJust hostingCountry =
+                    Just "Error: passing --hosting-country requires passing --hosting"
+                | otherwise = Nothing
+          forM_ err_ $ \err -> putStrLn err >> exitFailure
+        initialize opts'@InitOptions {enableStoreLog, logStats, signAlgorithm, password, controlPort, socksProxy, ownDomains, sourceCode, webStaticPath, disableWeb} = do
+          checkInitOptions opts'
           clearDirIfExists cfgPath
           clearDirIfExists logPath
           createDirectoryIfMissing True cfgPath
@@ -130,9 +144,10 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
           let x509cfg = defaultX509Config {commonName = fromMaybe ip fqdn, signAlgorithm}
           fp <- createServerX509 cfgPath x509cfg
           basicAuth <- mapM createServerPassword password
+          controlPortPwds <- forM controlPort $ \_ -> let pwd = decodeLatin1 <$> randomBase64 18 in (,) <$> pwd <*> pwd
           let host = fromMaybe (if ip == "127.0.0.1" then "<hostnames>" else ip) fqdn
               srv = ProtoServerWithAuth (SMPServer [THDomainName host] "" (C.KeyHash fp)) basicAuth
-          T.writeFile iniFile $ iniFileContent host basicAuth $ Just "https://github.com/simplex-chat/simplexmq"
+          T.writeFile iniFile $ iniFileContent host basicAuth controlPortPwds
           putStrLn $ "Server initialized, please provide additional server information in " <> iniFile <> "."
           putStrLn $ "Run `" <> executableName <> " start` to start server."
           warnCAPrivateKeyFile cfgPath x509cfg
@@ -141,9 +156,10 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
           where
             createServerPassword = \case
               ServerPassword s -> pure s
-              SPRandom -> BasicAuth . strEncode <$> (atomically . C.randomBytes 32 =<< C.newRandom)
-            iniFileContent host basicAuth sourceCode' =
-              informationIniContent sourceCode'
+              SPRandom -> BasicAuth <$> randomBase64 32
+            randomBase64 n = strEncode <$> (atomically . C.randomBytes n =<< C.newRandom)
+            iniFileContent host basicAuth controlPortPwds =
+              informationIniContent opts'
                 <> "[STORE_LOG]\n\
                    \# The server uses STM memory for persistence,\n\
                    \# that will be lost on restart (e.g., as with redis).\n\
@@ -167,13 +183,13 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                    \# smp://fingerprint:password@host1,host2\n\
                    \# The password will not be shared with the connecting contacts, you must share it only\n\
                    \# with the users who you want to allow creating messaging queues on your server.\n"
-                <> ( case basicAuth of
-                      Just auth -> "create_password: " <> safeDecodeUtf8 (strEncode auth)
-                      _ -> "# create_password: password to create new queues (any printable ASCII characters without whitespace, '@', ':' and '/')"
+                <> ( let noPassword = "password to create new queues and forward messages (any printable ASCII characters without whitespace, '@', ':' and '/')"
+                      in optDisabled basicAuth <> "create_password: " <> maybe noPassword (safeDecodeUtf8 . strEncode) basicAuth
                    )
-                <> "\n\n\
-                   \# control_port_admin_password:\n\
-                   \# control_port_user_password:\n\n\
+                <> "\n\n"
+                <> (optDisabled controlPortPwds <> "control_port_admin_password: " <> maybe "" fst controlPortPwds <> "\n")
+                <> (optDisabled controlPortPwds <> "control_port_user_password: " <> maybe "" snd controlPortPwds <> "\n")
+                <> "\n\
                    \[TRANSPORT]\n\
                    \# Host is only used to print server address on start.\n\
                    \# You can specify multiple server ports.\n"
@@ -181,38 +197,44 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 <> ("port: " <> T.pack defaultServerPorts <> "\n")
                 <> "log_tls_errors: off\n\n\
                    \# Use `websockets: 443` to run websockets server in addition to plain TLS.\n\
-                   \websockets: off\n\
-                   \# control_port: 5224\n\n\
+                   \# This option is deprecated and should be used for testing only.\n\
+                   \# , port 443 should be specified in port above\n\
+                   \websockets: off\n"
+                <> (optDisabled controlPort <> "control_port: " <> tshow (fromMaybe defaultControlPort controlPort))
+                <> "\n\n\
                    \[PROXY]\n\
                    \# Network configuration for SMP proxy client.\n\
                    \# `host_mode` can be 'public' (default) or 'onion'.\n\
                    \# It defines prefferred hostname for destination servers with multiple hostnames.\n\
                    \# host_mode: public\n\
                    \# required_host_mode: off\n\n\
-                   \# The domain suffixes of the relays you operate (space-separated) to count as separate proxy statistics.\n\
-                   \# own_server_domains: \n\n\
+                   \# The domain suffixes of the relays you operate (space-separated) to count as separate proxy statistics.\n"
+                <> (optDisabled ownDomains <> "own_server_domains: " <> maybe "" (safeDecodeUtf8 . strEncode) ownDomains)
+                <> "\n\n\
                    \# SOCKS proxy port for forwarding messages to destination servers.\n\
-                   \# You may need a separate instance of SOCKS proxy for incoming single-hop requests.\n\
-                   \# socks_proxy: localhost:9050\n\n\
+                   \# You may need a separate instance of SOCKS proxy for incoming single-hop requests.\n"
+                <> (optDisabled socksProxy <> "socks_proxy: " <> maybe "localhost:9050" (safeDecodeUtf8 . strEncode) socksProxy)
+                <> "\n\n\
                    \# `socks_mode` can be 'onion' for SOCKS proxy to be used for .onion destination hosts only (default)\n\
                    \# or 'always' to be used for all destination hosts (can be used if it is an .onion server).\n\
                    \# socks_mode: onion\n\n\
                    \# Limit number of threads a client can spawn to process proxy commands in parrallel.\n"
-                <> ("# client_concurrency: " <> tshow defaultProxyClientConcurrency <> "\n\n")
-                <> "[INACTIVE_CLIENTS]\n\
+                <> ("# client_concurrency: " <> tshow defaultProxyClientConcurrency)
+                <> "\n\n\
+                   \[INACTIVE_CLIENTS]\n\
                    \# TTL and interval to check inactive clients\n\
-                   \disconnect: off\n"
-                <> ("# ttl: " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
-                <> ("# check_interval: " <> tshow (checkInterval defaultInactiveClientExpiration) <> "\n")
+                   \disconnect: on\n"
+                <> ("ttl: " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
+                <> ("check_interval: " <> tshow (checkInterval defaultInactiveClientExpiration))
                 <> "\n\n\
                    \[WEB]\n\
                    \# Set path to generate static mini-site for server information and qr codes/links\n"
                 <> ("static_path: " <> T.pack (fromMaybe defaultStaticPath webStaticPath) <> "\n\n")
                 <> "# Run an embedded server on this port\n\
                    \# Onion sites can use any port and register it in the hidden service config.\n\
-                   \# Running on a port 80 may require setting process capabilities.\n"
-                <> (webDisabled <> "http: 8000\n\n")
-                <> "# You can run an embedded TLS web server too if you provide port and cert and key files.\n\
+                   \# Running on a port 80 may require setting process capabilities.\n\
+                   \# http: 8000\n\n\
+                   \# You can run an embedded TLS web server too if you provide port and cert and key files.\n\
                    \# Not required for running relay on onion address.\n"
                 <> (webDisabled <> "https: 443\n")
                 <> (webDisabled <> "cert: " <> T.pack httpsCertFile <> "\n")
@@ -389,28 +411,31 @@ getServerSourceCode =
 simplexmqSource :: String
 simplexmqSource = "https://github.com/simplex-chat/simplexmq"
 
-informationIniContent :: Maybe Text -> Text
-informationIniContent sourceCode_ =
+defaultControlPort :: Int
+defaultControlPort = 5224
+
+informationIniContent :: InitOptions -> Text
+informationIniContent InitOptions {sourceCode, serverInfo} =
   "[INFORMATION]\n\
   \# AGPLv3 license requires that you make any source code modifications\n\
   \# available to the end users of the server.\n\
   \# LICENSE: https://github.com/simplex-chat/simplexmq/blob/stable/LICENSE\n\
   \# Include correct source code URI in case the server source code is modified in any way.\n\
   \# If any other information fields are present, source code property also MUST be present.\n\n"
-    <> (maybe "# source_code: URI" ("source_code: " <>) sourceCode_ <> "\n\n")
-    <> "# Declaring all below information is optional, any of these fields can be omitted.\n\
+    <> (optDisabled sourceCode <> "source_code: " <> fromMaybe "URI" sourceCode)
+    <> "\n\n\
+       \# Declaring all below information is optional, any of these fields can be omitted.\n\
        \\n\
        \# Server usage conditions and amendments.\n\
        \# It is recommended to use standard conditions with any amendments in a separate document.\n\
        \# usage_conditions: https://github.com/simplex-chat/simplex-chat/blob/stable/PRIVACY.md\n\
        \# condition_amendments: link\n\
        \\n\
-       \# Server location and operator.\n\
-       \# server_country: ISO-3166 2-letter code\n\
-       \# operator: entity (organization or person name)\n\
-       \# operator_country: ISO-3166 2-letter code\n\
-       \# website:\n\
-       \\n\
+       \# Server location and operator.\n"
+    <> countryStr "server" serverCountry
+    <> enitiyStrs "operator" operator
+    <> (optDisabled website <> "website: " <> fromMaybe "" website)
+    <> "\n\n\
        \# Administrative contacts.\n\
        \# admin_simplex: SimpleX address\n\
        \# admin_email:\n\
@@ -423,9 +448,20 @@ informationIniContent sourceCode_ =
        \# complaints_pgp:\n\
        \# complaints_pgp_fingerprint:\n\
        \\n\
-       \# Hosting provider.\n\
-       \# hosting: entity (organization or person name)\n\
-       \# hosting_country: ISO-3166 2-letter code\n\n"
+       \# Hosting provider.\n"
+    <> enitiyStrs "hosting" hosting
+    <> "\n\
+       \# Hosting type can be `virtual`, `dedicated`, `colocation`, `owned`\n"
+    <> ("hosting_type: " <> maybe "virtual" (decodeLatin1 . strEncode) hostingType <> "\n\n")
+  where
+    ServerPublicInfo {operator, website, hosting, hostingType, serverCountry}= serverInfo
+    countryStr optName country = optDisabled country <> optName <> "_country: " <> fromMaybe "ISO-3166 2-letter code" country <> "\n"
+    enitiyStrs optName entity =
+      optDisabled entity
+        <> optName <> ": "
+        <> maybe ("entity (organization or person name)") name entity
+        <> "\n"
+        <> countryStr optName (country =<< entity)
 
 serverPublicInfo :: Ini -> Maybe ServerPublicInfo
 serverPublicInfo ini = serverInfo <$!> infoValue "source_code"
@@ -441,15 +477,14 @@ serverPublicInfo ini = serverInfo <$!> infoValue "source_code"
           website = infoValue "website",
           adminContacts = iniContacts "admin_simplex" "admin_email" "admin_pgp" "admin_pgp_fingerprint",
           complaintsContacts = iniContacts "complaints_simplex" "complaints_email" "complaints_pgp" "complaints_pgp_fingerprint",
-          hosting = iniEntity "hosting" "hosting_country"
+          hosting = iniEntity "hosting" "hosting_country",
+          hostingType = either error id <$!> strDecodeIni "INFORMATION" "hosting_type" ini
         }
     infoValue name = eitherToMaybe $ lookupValue "INFORMATION" name ini
     iniEntity nameField countryField =
       (\name -> Entity {name, country = countryValue countryField})
         <$!> infoValue nameField
-    countryValue field =
-      (\cs -> if T.length cs == 2 && T.all (\c -> isAscii c && isAlpha c) cs then T.map toUpper cs else error $ "Use ISO3166 2-letter code for " <> T.unpack field)
-        <$!> infoValue field
+    countryValue field = (either error id . validCountryValue (T.unpack field) . T.unpack) <$!> infoValue field
     iniContacts simplexField emailField pgpKeyUriField pgpKeyFingerprintField =
       let simplex = either error id . parseAll (connReqUriP' Nothing) . encodeUtf8 <$!> eitherToMaybe (lookupValue "INFORMATION" simplexField ini)
           email = infoValue emailField
@@ -460,6 +495,14 @@ serverPublicInfo ini = serverInfo <$!> infoValue "source_code"
             (Nothing, Nothing, _, Nothing) -> Nothing
             (_, _, pkURI, pkFingerprint) -> Just ServerContactAddress {simplex, email, pgp = PGPKey <$> pkURI <*> pkFingerprint}
 
+optDisabled :: Maybe a -> Text
+optDisabled p = if isNothing p then "# " else ""
+
+validCountryValue :: String -> String -> Either String Text
+validCountryValue field s
+  | length s == 2 && all (\c -> isAscii c && isAlpha c) s = Right $ T.pack $ map toUpper s
+  | otherwise = Left $ "Use ISO3166 2-letter code for " <> field
+
 printSourceCode :: Maybe Text -> IO ()
 printSourceCode = \case
   Just sourceCode -> T.putStrLn $ "Server source code: " <> sourceCode
@@ -480,7 +523,13 @@ data InitOptions = InitOptions
     ip :: HostName,
     fqdn :: Maybe HostName,
     password :: Maybe ServerPassword,
+    controlPort :: Maybe Int,
+    socksProxy :: Maybe SocksProxy,
+    ownDomains :: Maybe (L.NonEmpty TransportHost),
     sourceCode :: Maybe Text,
+    serverInfo :: ServerPublicInfo,
+    operatorCountry :: Maybe Text,
+    hostingCountry :: Maybe Text,
     webStaticPath :: Maybe FilePath,
     disableWeb :: Bool,
     scripted :: Bool
@@ -549,11 +598,46 @@ cliCommandP cfgPath logPath iniFile =
                   <> help "Set password to create new messaging queues"
                   <> value SPRandom
               )
+      controlPort <-
+        flag' (Just defaultControlPort) (long "control-port" <> help ("Enable control port on " <> show defaultControlPort))
+          <|> option strParse (long "control-port" <> help "Enable control port" <> metavar "PORT" <> value Nothing)
+      socksProxy <-
+        flag' (Just defaultSocksProxy) (long "socks-proxy" <> help "Outgoing SOCKS proxy on port 9050")
+          <|>
+            option
+              strParse
+              ( long "socks-proxy"
+                  <> metavar "PROXY"
+                  <> help "Outgoing SOCKS proxy to forward messages to onion-only servers"
+                  <> value Nothing
+              )
+      ownDomains :: Maybe (L.NonEmpty TransportHost) <-
+        option
+          strParse
+            ( long "own-domains"
+                <> metavar "DOMAINS"
+                <> help "Own server domain names (comma-separated)"
+                <> value Nothing
+            )
       sourceCode <-
+        flag' (Just simplexmqSource) (long "source-code" <> help ("Server source code (default: " <> simplexmqSource <> ")"))
+          <|> (optional . strOption) (long "source-code" <> metavar "URI" <> help "Server source code")
+      operator_ <- entityP "operator" "OPERATOR" "Server operator"
+      hosting_ <- entityP "hosting" "HOSTING" "Hosting provider"
+      hostingType <-
+        option
+          strParse
+          ( long "hosting-type"
+              <> metavar "HOSTING_TYPE"
+              <> help "Hosting type: virtual, dedicated, colocation, owned"
+              <> value Nothing
+          )
+      serverCountry <- countryP "server" "SERVER" "Server datacenter"
+      website <-
         (optional . strOption)
-          ( long "source-code"
-              <> help "Server source code will be communicated to the users"
-              <> metavar "URI"
+          ( long "operator-website"
+              <> help "Operator public website"
+              <> metavar "WEBSITE"
           )
       webStaticPath <-
         (optional . strOption)
@@ -580,10 +664,46 @@ cliCommandP cfgPath logPath iniFile =
             ip,
             fqdn,
             password,
-            sourceCode,
+            controlPort,
+            socksProxy,
+            ownDomains,
+            sourceCode = T.pack <$> sourceCode,
+            serverInfo =
+              ServerPublicInfo
+                { sourceCode = T.pack simplexmqSource,
+                  usageConditions = Nothing,
+                  operator = fst operator_,
+                  website,
+                  adminContacts = Nothing,
+                  complaintsContacts = Nothing,
+                  hosting = fst hosting_,
+                  hostingType,
+                  serverCountry
+                },
+            operatorCountry = snd operator_,
+            hostingCountry = snd hosting_,
             webStaticPath,
             disableWeb,
             scripted
           }
     parseBasicAuth :: ReadM ServerPassword
     parseBasicAuth = eitherReader $ fmap ServerPassword . strDecode . B.pack
+    entityP :: String -> String -> String -> Parser (Maybe Entity, Maybe Text)
+    entityP opt' metavar' help' = do
+      name_ <-
+        (optional . strOption)
+          ( long opt'
+              <> metavar (metavar' <> "_NAME")
+              <> help (help' <> " name")
+          )
+      country <- countryP opt' metavar' help'
+      pure ((\name -> Entity {name, country}) <$> name_, country)
+    countryP :: String -> String -> String -> Parser (Maybe Text)
+    countryP opt' metavar' help' =
+      (optional . option (eitherReader $ validCountryValue opt'))
+        ( long (opt' <> "-country")
+            <> metavar (metavar' <> "_COUNTRY")
+            <> help (help' <> " country")
+        )
+    strParse :: StrEncoding a => ReadM a
+    strParse = eitherReader $ parseAll strP . encodeUtf8 . T.pack
diff --git a/tests/CLITests.hs b/tests/CLITests.hs
index e8417fc8b..01b68653d 100644
--- a/tests/CLITests.hs
+++ b/tests/CLITests.hs
@@ -88,14 +88,14 @@ smpServerTest storeLog basicAuth = do
   lookupValue "TRANSPORT" "port" ini `shouldBe` Right "5223,443"
   lookupValue "TRANSPORT" "websockets" ini `shouldBe` Right "off"
   lookupValue "AUTH" "new_queues" ini `shouldBe` Right "on"
-  lookupValue "INACTIVE_CLIENTS" "disconnect" ini `shouldBe` Right "off"
+  lookupValue "INACTIVE_CLIENTS" "disconnect" ini `shouldBe` Right "on"
   doesFileExist (cfgPath <> "/ca.key") `shouldReturn` True
   -- start
   r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` smpServerCLI cfgPath logPath) `catchAll_` pure (Just ()))
   r `shouldContain` ["SMP server v" <> simplexMQVersion]
   r `shouldContain` (if storeLog then ["Store log: " <> logPath <> "/smp-server-store.log"] else ["Store log disabled."])
   r `shouldContain` ["Serving SMP protocol on port 5223 (TLS)...", "Serving SMP protocol on port 443 (TLS)...", "Serving static site on port 443 (TLS)..."]
-  r `shouldContain` ["not expiring inactive clients"]
+  r `shouldContain` ["expiring clients inactive for 21600 seconds every 3600 seconds"]
   r `shouldContain` (if basicAuth then ["creating new queues requires password"] else ["creating new queues allowed"])
   -- cert
   let certPath = cfgPath </> "server.crt"

From 0705d0507876c0b8acc10adc9c98882b224543ab Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 6 Oct 2024 18:05:06 +0100
Subject: [PATCH 147/195] smp: transport block encryption (#1317)

---
 src/Simplex/FileTransfer/Client.hs            |  2 +-
 src/Simplex/FileTransfer/Server.hs            |  2 +-
 src/Simplex/Messaging/Client.hs               |  5 +-
 .../Messaging/Notifications/Transport.hs      |  1 +
 src/Simplex/Messaging/Protocol.hs             | 15 ++--
 src/Simplex/Messaging/Transport.hs            | 71 ++++++++++++++-----
 tests/CoreTests/BatchingTests.hs              | 21 +++---
 tests/SMPProxyTests.hs                        |  2 +-
 8 files changed, 79 insertions(+), 40 deletions(-)

diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs
index 22b111a26..d8904e05e 100644
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -113,7 +113,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
   let HTTP2Client {sessionId, sessionALPN} = http2Client
       v = VersionXFTP 1
       thServerVRange = versionToRange v
-      thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, batch = True}
+      thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True}
   logDebug $ "Client negotiated handshake protocol: " <> tshow sessionALPN
   thParams@THandleParams {thVersion} <- case sessionALPN of
     Just "xftp/1" -> xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index bfe5b8dd0..4635034fc 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -120,7 +120,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
         reqBody <- getHTTP2Body r xftpBlockSize
         let v = VersionXFTP 1
             thServerVRange = versionToRange v
-            thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, batch = True}
+            thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True}
             req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse}
         flip runReaderT env $ case sessionALPN of
           Nothing -> processRequest req0
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index b066e08b6..2ba7d9edf 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -199,6 +199,7 @@ smpClientStub g sessionId thVersion thAuth = do
               thAuth,
               blockSize = smpBlockSize,
               implySessId = thVersion >= authCmdsSMPVersion,
+              encryptBlock = Nothing,
               batch = True
             },
         sessionTs = ts,
@@ -427,7 +428,9 @@ defaultClientConfig clientALPN useSNI serverVRange =
 defaultSMPClientConfig :: ProtocolClientConfig SMPVersion
 defaultSMPClientConfig =
   (defaultClientConfig (Just supportedSMPHandshakes) False supportedClientSMPRelayVRange)
-    {defaultTransport = (show defaultSMPPort, transport @TLS)}
+    { defaultTransport = (show defaultSMPPort, transport @TLS),
+      agreeSecret = True
+    }
 {-# INLINE defaultSMPClientConfig #-}
 
 data Request err msg = Request
diff --git a/src/Simplex/Messaging/Notifications/Transport.hs b/src/Simplex/Messaging/Notifications/Transport.hs
index 77a598c5c..836b6b1e7 100644
--- a/src/Simplex/Messaging/Notifications/Transport.hs
+++ b/src/Simplex/Messaging/Notifications/Transport.hs
@@ -169,5 +169,6 @@ ntfTHandle c = THandle {connection = c, params}
           thServerVRange = versionToRange v,
           thAuth = Nothing,
           implySessId = False,
+          encryptBlock = Nothing,
           batch = False
         }
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index 9ef7e57b2..bdc0254b4 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -258,13 +258,14 @@ supportedSMPClientVRange = mkVersionRange initialSMPClientVersion currentSMPClie
 -- TODO v6.0 remove dependency on version
 maxMessageLength :: VersionSMP -> Int
 maxMessageLength v
+  | v >= encryptedBlockSMPVersion = 16048 -- max 16051
   | v >= sendingProxySMPVersion = 16064 -- max 16067
-  | otherwise = 16088 -- 16064 - always use this size to determine allowed ranges
+  | otherwise = 16088 -- 16048 - always use this size to determine allowed ranges
 
 paddedProxiedTLength :: Int
-paddedProxiedTLength = 16242 -- 16241 .. 16243
+paddedProxiedTLength = 16226 -- 16225 .. 16227
 
--- TODO v6.0 change to 16064
+-- TODO v7.0 change to 16048
 type MaxMessageLen = 16088
 
 -- 16 extra bytes: 8 for timestamp and 8 for flags (7 flags and the space, only 1 flag is currently used)
@@ -272,10 +273,10 @@ type MaxRcvMessageLen = MaxMessageLen + 16 -- 16104, the padded size is 16106
 
 -- it is shorter to allow per-queue e2e encryption DH key in the "public" header
 e2eEncConfirmationLength :: Int
-e2eEncConfirmationLength = 15920 -- 15881 .. 15976
+e2eEncConfirmationLength = 15904 -- 15865 .. 15960
 
 e2eEncMessageLength :: Int
-e2eEncMessageLength = 16016 -- 16004 .. 16021
+e2eEncMessageLength = 16000 -- 15988 .. 16005
 
 -- | SMP protocol clients
 data Party = Recipient | Sender | Notifier | ProxiedClient
@@ -1663,8 +1664,8 @@ batchTransmissions' batch bSize ts
 batchTransmissions_ :: Int -> NonEmpty (Either TransportError ByteString, r) -> [TransportBatch r]
 batchTransmissions_ bSize = addBatch . foldr addTransmission ([], 0, 0, [], [])
   where
-    -- 3 = 2 bytes reserved for pad size + 1 for transmission count
-    bSize' = bSize - 3
+    -- 19 = 2 bytes reserved for pad size + 1 for transmission count + 16 auth tag from block encryption
+    bSize' = bSize - 19
     addTransmission :: (Either TransportError ByteString, r) -> ([TransportBatch r], Int, Int, [ByteString], [r]) -> ([TransportBatch r], Int, Int, [ByteString], [r])
     addTransmission (t_, r) acc@(bs, !len, !n, ss, rs) = case t_ of
       Left e -> (TBError e r : addBatch acc, 0, 0, [], [])
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index da00fe231..e64485964 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -48,6 +48,7 @@ module Simplex.Messaging.Transport
     sendingProxySMPVersion,
     sndAuthKeySMPVersion,
     deletedEventSMPVersion,
+    encryptedBlockSMPVersion,
     simplexMQVersion,
     smpBlockSize,
     TransportConfig (..),
@@ -90,6 +91,7 @@ import Control.Applicative (optional)
 import Control.Concurrent.STM
 import Control.Monad (forM, (<$!>))
 import Control.Monad.Except
+import Control.Monad.IO.Class
 import Control.Monad.Trans.Except (throwE)
 import qualified Data.Aeson.TH as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
@@ -101,6 +103,7 @@ import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Default (def)
 import Data.Functor (($>))
+import Data.Tuple (swap)
 import Data.Typeable (Typeable)
 import Data.Version (showVersion)
 import Data.Word (Word16)
@@ -138,6 +141,7 @@ smpBlockSize = 16384
 -- 8 - SMP proxy for sender commands
 -- 9 - faster handshake: SKEY command for sender to secure queue
 -- 10 - DELD event to subscriber when queue is deleted via another connnection
+-- 11 - additional encryption of transport blocks with forward secrecy (9/14/2024)
 
 data SMPVersion
 
@@ -171,14 +175,17 @@ sndAuthKeySMPVersion = VersionSMP 9
 deletedEventSMPVersion :: VersionSMP
 deletedEventSMPVersion = VersionSMP 10
 
+encryptedBlockSMPVersion :: VersionSMP
+encryptedBlockSMPVersion = VersionSMP 11
+
 currentClientSMPRelayVersion :: VersionSMP
-currentClientSMPRelayVersion = VersionSMP 10
+currentClientSMPRelayVersion = VersionSMP 11
 
 legacyServerSMPRelayVersion :: VersionSMP
 legacyServerSMPRelayVersion = VersionSMP 6
 
 currentServerSMPRelayVersion :: VersionSMP
-currentServerSMPRelayVersion = VersionSMP 10
+currentServerSMPRelayVersion = VersionSMP 11
 
 -- Max SMP protocol version to be used in e2e encrypted
 -- connection between client and server, as defined by SMP proxy.
@@ -400,6 +407,8 @@ data THandleParams v p = THandleParams
     -- | do NOT send session ID in transmission, but include it into signed message
     -- based on protocol version
     implySessId :: Bool,
+    -- -- | additional block encryption
+    encryptBlock :: Maybe TSbChainKeys,
     -- | send multiple transmissions in a single block
     -- based on protocol version
     batch :: Bool
@@ -525,16 +534,26 @@ instance Encoding TransportError where
 
 -- | Pad and send block to SMP transport.
 tPutBlock :: Transport c => THandle v c p -> ByteString -> IO (Either TransportError ())
-tPutBlock THandle {connection = c, params = THandleParams {blockSize}} block =
-  bimapM (const $ pure TELargeMsg) (cPut c) $
-    C.pad block blockSize
+tPutBlock THandle {connection = c, params = THandleParams {blockSize, encryptBlock}} block = do
+  block_ <- case encryptBlock of
+    Just TSbChainKeys {sndKey} -> do
+      (sk, nonce) <- atomically $ stateTVar sndKey C.sbcHkdf
+      pure $ C.sbEncrypt sk nonce block (blockSize - 16)
+    Nothing -> pure $ C.pad block blockSize
+  bimapM (const $ pure TELargeMsg) (cPut c) block_
 
 -- | Receive block from SMP transport.
 tGetBlock :: Transport c => THandle v c p -> IO (Either TransportError ByteString)
-tGetBlock THandle {connection = c, params = THandleParams {blockSize}} = do
+tGetBlock THandle {connection = c, params = THandleParams {blockSize, encryptBlock}} = do
   msg <- cGet c blockSize
   if B.length msg == blockSize
-    then pure . first (const TELargeMsg) $ C.unPad msg
+    then
+      first (const TELargeMsg) <$>
+        case encryptBlock of
+          Just TSbChainKeys {rcvKey} -> do
+            (sk, nonce) <- atomically $ stateTVar rcvKey C.sbcHkdf
+            pure $ C.sbDecrypt sk nonce msg
+          Nothing -> pure $ C.unPad msg
     else ioe_EOF
 
 -- | Server SMP transport handshake.
@@ -553,7 +572,7 @@ smpServerHandshake serverSignKey c (k, pk) kh smpVRange = do
           throwE $ TEHandshake IDENTITY
       | otherwise ->
           case compatibleVRange' smpVersionRange v of
-            Just (Compatible vr) -> pure $ smpTHandleServer th v vr pk k'
+            Just (Compatible vr) -> liftIO $ smpTHandleServer th v vr pk k'
             Nothing -> throwE TEVersion
 
 -- | Client SMP transport handshake.
@@ -577,23 +596,36 @@ smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange = do
             (,certKey) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey)
         let v = maxVersion vr
         sendHandshake th $ ClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_}
-        pure $ smpTHandleClient th v vr (snd <$> ks_) ck_
+        liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck_
       Nothing -> throwE TEVersion
 
-smpTHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRangeSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> THandleSMP c 'TServer
-smpTHandleServer th v vr pk k_ =
-  let thAuth = THAuthServer {serverPrivKey = pk, sessSecret' = (`C.dh'` pk) <$!> k_}
-   in smpTHandle_ th v vr (Just thAuth)
+smpTHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRangeSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> IO (THandleSMP c 'TServer)
+smpTHandleServer th v vr pk k_ = do
+  let thAuth = Just THAuthServer {serverPrivKey = pk, sessSecret' = (`C.dh'` pk) <$!> k_}
+  be <- blockEncryption th v thAuth
+  pure $ smpTHandle_ th v vr thAuth $ uncurry TSbChainKeys <$> be
 
-smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> THandleSMP c 'TClient
-smpTHandleClient th v vr pk_ ck_ =
+smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> IO (THandleSMP c 'TClient)
+smpTHandleClient th v vr pk_ ck_ = do
   let thAuth = (\(k, ck) -> THAuthClient {serverPeerPubKey = k, serverCertKey = forceCertChain ck, sessSecret = C.dh' k <$!> pk_}) <$!> ck_
-   in smpTHandle_ th v vr thAuth
+  be <- blockEncryption th v thAuth
+  -- swap is needed to use client's sndKey as server's rcvKey and vice versa
+  pure $ smpTHandle_ th v vr thAuth $ uncurry TSbChainKeys . swap <$> be
 
-smpTHandle_ :: forall c p. THandleSMP c p -> VersionSMP -> VersionRangeSMP -> Maybe (THandleAuth p) -> THandleSMP c p
-smpTHandle_ th@THandle {params} v vr thAuth =
+blockEncryption :: THandleSMP c p -> VersionSMP -> Maybe (THandleAuth p) -> IO (Maybe (TVar C.SbChainKey, TVar C.SbChainKey))
+blockEncryption THandle {params = THandleParams {sessionId}} v = \case
+  Just thAuth | v >= encryptedBlockSMPVersion -> case thAuth of
+    THAuthClient {sessSecret} -> be sessSecret
+    THAuthServer {sessSecret'} -> be sessSecret'
+  _ -> pure Nothing
+  where
+    be :: Maybe C.DhSecretX25519 -> IO (Maybe (TVar C.SbChainKey, TVar C.SbChainKey))
+    be = mapM $ \(C.DhSecretX25519 secret) -> bimapM newTVarIO newTVarIO $ C.sbcInit sessionId secret
+
+smpTHandle_ :: forall c p. THandleSMP c p -> VersionSMP -> VersionRangeSMP -> Maybe (THandleAuth p) -> Maybe TSbChainKeys -> THandleSMP c p
+smpTHandle_ th@THandle {params} v vr thAuth encryptBlock =
   -- TODO drop SMP v6: make thAuth non-optional
-  let params' = params {thVersion = v, thServerVRange = vr, thAuth, implySessId = v >= authCmdsSMPVersion}
+  let params' = params {thVersion = v, thServerVRange = vr, thAuth, implySessId = v >= authCmdsSMPVersion, encryptBlock}
    in (th :: THandleSMP c p) {params = params'}
 
 {-# INLINE forceCertChain #-}
@@ -625,6 +657,7 @@ smpTHandle c = THandle {connection = c, params}
           thVersion = v,
           thAuth = Nothing,
           implySessId = False,
+          encryptBlock = Nothing,
           batch = True
         }
 
diff --git a/tests/CoreTests/BatchingTests.hs b/tests/CoreTests/BatchingTests.hs
index e2427b565..41b1a6a38 100644
--- a/tests/CoreTests/BatchingTests.hs
+++ b/tests/CoreTests/BatchingTests.hs
@@ -30,7 +30,7 @@ batchingTests :: Spec
 batchingTests = do
   describe "batchTransmissions" $ do
     describe "SMP v6 (previous)" $ do
-      it "should batch with 107 subscriptions per batch" testBatchSubscriptionsV6
+      it "should batch with 106 subscriptions per batch" testBatchSubscriptionsV6
       it "should break on message that does not fit" testBatchWithMessageV6
       it "should break on large message" testBatchWithLargeMessageV6
     describe "SMP current" $ do
@@ -39,7 +39,7 @@ batchingTests = do
       it "should break on large message" testBatchWithLargeMessage
   describe "batchTransmissions'" $ do
     describe "SMP v6 (previous)" $ do
-      it "should batch with 107 subscriptions per batch" testClientBatchSubscriptionsV6
+      it "should batch with 106 subscriptions per batch" testClientBatchSubscriptionsV6
       it "should break on message that does not fit" testClientBatchWithMessageV6
       it "should break on large message" testClientBatchWithLargeMessageV6
     describe "SMP current" $ do
@@ -59,7 +59,7 @@ testBatchSubscriptionsV6 = do
   let batches = batchTransmissions True smpBlockSize $ L.fromList subs
   length batches `shouldBe` 3
   [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _, TBTransmissions s3 n3 _] <- pure batches
-  (n1, n2, n3) `shouldBe` (36, 107, 107)
+  (n1, n2, n3) `shouldBe` (38, 106, 106)
   all lenOk [s1, s2, s3] `shouldBe` True
 
 testBatchSubscriptions :: IO ()
@@ -123,7 +123,7 @@ testBatchWithLargeMessageV6 = do
   let batches = batchTransmissions True smpBlockSize $ L.fromList cmds
   length batches `shouldBe` 4
   [TBTransmissions s1 n1 _, TBError TELargeMsg _, TBTransmissions s2 n2 _, TBTransmissions s3 n3 _] <- pure batches
-  (n1, n2, n3) `shouldBe` (50, 43, 107)
+  (n1, n2, n3) `shouldBe` (50, 44, 106)
   all lenOk [s1, s2, s3] `shouldBe` True
 
 testBatchWithLargeMessage :: IO ()
@@ -154,8 +154,8 @@ testClientBatchSubscriptionsV6 = do
   let batches = batchTransmissions' True smpBlockSize $ L.fromList subs
   length batches `shouldBe` 3
   [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2, TBTransmissions s3 n3 rs3] <- pure batches
-  (n1, n2, n3) `shouldBe` (36, 107, 107)
-  (length rs1, length rs2, length rs3) `shouldBe` (36, 107, 107)
+  (n1, n2, n3) `shouldBe` (38, 106, 106)
+  (length rs1, length rs2, length rs3) `shouldBe` (38, 106, 106)
   all lenOk [s1, s2, s3] `shouldBe` True
 
 testClientBatchSubscriptions :: IO ()
@@ -251,16 +251,16 @@ testClientBatchWithLargeMessageV6 = do
   let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds
   length batches `shouldBe` 4
   [TBTransmissions s1 n1 rs1, TBError TELargeMsg _, TBTransmissions s2 n2 rs2, TBTransmissions s3 n3 rs3] <- pure batches
-  (n1, n2, n3) `shouldBe` (50, 43, 107)
-  (length rs1, length rs2, length rs3) `shouldBe` (50, 43, 107)
+  (n1, n2, n3) `shouldBe` (50, 44, 106)
+  (length rs1, length rs2, length rs3) `shouldBe` (50, 44, 106)
   all lenOk [s1, s2, s3] `shouldBe` True
   --
   let cmds' = [send] <> subs1 <> subs2
   let batches' = batchTransmissions' True smpBlockSize $ L.fromList cmds'
   length batches' `shouldBe` 3
   [TBError TELargeMsg _, TBTransmissions s1' n1' rs1', TBTransmissions s2' n2' rs2'] <- pure batches'
-  (n1', n2') `shouldBe` (93, 107)
-  (length rs1', length rs2') `shouldBe` (93, 107)
+  (n1', n2') `shouldBe` (94, 106)
+  (length rs1', length rs2') `shouldBe` (94, 106)
   all lenOk [s1', s2'] `shouldBe` True
 
 testClientBatchWithLargeMessage :: IO ()
@@ -380,6 +380,7 @@ testTHandleParams v sessionId =
       thServerVRange = supportedServerSMPRelayVRange,
       thAuth = Nothing,
       implySessId = v >= authCmdsSMPVersion,
+      encryptBlock = Nothing,
       batch = True
     }
 
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 2025ff911..e3b3e6fc6 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -63,7 +63,7 @@ smpProxyTests = do
     let srv1 = SMPServer testHost testPort testKeyHash
         srv2 = SMPServer testHost testPort2 testKeyHash
     describe "client API" $ do
-      let maxLen = maxMessageLength sendingProxySMPVersion
+      let maxLen = maxMessageLength encryptedBlockSMPVersion
       describe "one server" $ do
         it "deliver via proxy" . oneServer $ do
           deliverMessageViaProxy srv1 srv1 C.SEd448 "hello 1" "hello 2"

From 49935473ae9c26487707d2150d0e9c299cf3c416 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Sun, 6 Oct 2024 22:48:22 +0400
Subject: [PATCH 148/195] ntf: agent to notfiy MSGNTF on successful ack (#1355)

* ntf: agent to notfiy MSGNTF on successful ack

* move msgntf

* release lock earlier

* fix tests

* do not release get lock

* fix

* diff

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
---
 src/Simplex/Messaging/Agent.hs              | 13 ++++++------
 src/Simplex/Messaging/Agent/Client.hs       |  7 +++----
 src/Simplex/Messaging/Agent/Protocol.hs     |  3 +--
 src/Simplex/Messaging/Agent/Store/SQLite.hs |  6 ++++++
 tests/AgentTests/FunctionalAPITests.hs      | 23 +++++++++++++++++----
 5 files changed, 36 insertions(+), 16 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 5ca1b4be1..d2a96a5ed 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1681,10 +1681,14 @@ synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchroni
     _ -> throwE $ CMD PROHIBITED "synchronizeRatchet: not duplex"
 
 ackQueueMessage :: AgentClient -> RcvQueue -> SMP.MsgId -> AM ()
-ackQueueMessage c rq@RcvQueue {userId, server} srvMsgId = do
+ackQueueMessage c rq@RcvQueue {userId, connId, server} srvMsgId = do
   atomically $ incSMPServerStat c userId server ackAttempts
   tryAgentError (sendAck c rq srvMsgId) >>= \case
-    Right _ -> atomically $ incSMPServerStat c userId server ackMsgs
+    Right _ -> do
+      atomically $ incSMPServerStat c userId server ackMsgs
+      whenM (liftIO $ hasGetLock c rq) $ do
+        brokerTs_ <- (Just <$> withStore c (\db -> getRcvMsgBrokerTs db connId srvMsgId)) `catchAgentError` \_ -> pure Nothing
+        atomically $ writeTBQueue (subQ c) ("", connId, AEvt SAEConn $ MSGNTF srvMsgId brokerTs_)
     Left (SMP _ SMP.NO_MSG) -> atomically $ incSMPServerStat c userId server ackNoMsgErrs
     Left e -> do
       unless (temporaryOrHostError e) $ atomically $ incSMPServerStat c userId server ackOtherErrs
@@ -2285,12 +2289,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
             atomically $ incSMPServerStat c userId srv recvMsgs
             void . handleNotifyAck $ do
               msg' <- decryptSMPMessage rq msg
-              ack' <- handleNotifyAck $ case msg' of
+              handleNotifyAck $ case msg' of
                 SMP.ClientRcvMsgBody {msgTs = srvTs, msgFlags, msgBody} -> processClientMsg srvTs msgFlags msgBody
                 SMP.ClientRcvMsgQuota {} -> queueDrained >> ack
-              whenM (liftIO $ hasGetLock c rq) $
-                notify (MSGNTF $ SMP.rcvMessageMeta srvMsgId msg')
-              pure ack'
             where
               queueDrained = case conn of
                 DuplexConnection _ _ sqs -> void $ enqueueMessages c cData sqs SMP.noMsgFlags $ A_QCONT (sndAddress rq)
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index c2a3cab57..1c6fa38f8 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1646,10 +1646,9 @@ disableQueuesNtfs = sendTSessionBatches "NDEL" snd disableQueues_
     queueCreds (_, RcvQueue {rcvPrivateKey, rcvId}) = (rcvPrivateKey, rcvId)
 
 sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
-sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = do
-  withSMPClient c rq ("ACK:" <> logSecret' msgId) $ \smp ->
-    ackSMPMessage smp rcvPrivateKey rcvId msgId
-  atomically $ releaseGetLock c rq
+sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId =
+  withSMPClient c rq ("ACK:" <> logSecret' msgId) (\smp -> ackSMPMessage smp rcvPrivateKey rcvId msgId)
+    `agentFinally` atomically (releaseGetLock c rq)
 
 hasGetLock :: AgentClient -> RcvQueue -> IO Bool
 hasGetLock c RcvQueue {server, rcvId} =
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 635bb1aee..17ebb7d43 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -198,7 +198,6 @@ import Simplex.Messaging.Protocol
     NMsgMeta,
     ProtocolServer (..),
     SMPClientVersion,
-    SMPMsgMeta,
     SMPServer,
     SMPServerWithAuth,
     SndPublicAuthKey,
@@ -356,7 +355,7 @@ data AEvent (e :: AEntity) where
   MERR :: AgentMsgId -> AgentErrorType -> AEvent AEConn
   MERRS :: NonEmpty AgentMsgId -> AgentErrorType -> AEvent AEConn
   MSG :: MsgMeta -> MsgFlags -> MsgBody -> AEvent AEConn
-  MSGNTF :: SMPMsgMeta -> AEvent AEConn
+  MSGNTF :: MsgId -> Maybe UTCTime -> AEvent AEConn
   RCVD :: MsgMeta -> NonEmpty MsgReceipt -> AEvent AEConn
   QCONT :: AEvent AEConn
   DEL_RCVQ :: SMPServer -> SMP.RecipientId -> Maybe AgentErrorType -> AEvent AEConn
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 76e8a79f6..924ba6712 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -122,6 +122,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     getRcvMsg,
     getLastMsg,
     checkRcvMsgHashExists,
+    getRcvMsgBrokerTs,
     deleteMsg,
     deleteDeliveredSndMsg,
     deleteSndMsgDelivery,
@@ -1185,6 +1186,11 @@ checkRcvMsgHashExists db connId hash = do
           (connId, hash)
       )
 
+getRcvMsgBrokerTs :: DB.Connection -> ConnId -> SMP.MsgId -> IO (Either StoreError BrokerTs)
+getRcvMsgBrokerTs db connId msgId =
+  firstRow fromOnly SEMsgNotFound $
+    DB.query db "SELECT broker_ts FROM rcv_messages WHERE conn_id = ? AND broker_id = ?" (connId, msgId)
+
 deleteMsg :: DB.Connection -> ConnId -> InternalId -> IO ()
 deleteMsg db connId msgId =
   DB.execute db "DELETE FROM messages WHERE conn_id = ? AND internal_id = ?;" (connId, msgId)
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 199b1a36a..075b40f10 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -1681,34 +1681,45 @@ testOnlyCreatePullSlowHandshake = withAgentClientsCfg2 agentProxyCfgV8 agentProx
   (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
   liftIO $ sqSecured `shouldBe` False
   Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
+  getMSGNTF alice bobId
   allowConnection alice bobId confId "alice's connInfo"
   liftIO $ threadDelay 1_000000
   getMsg bob aliceId $
     get bob ##> ("", aliceId, INFO "alice's connInfo")
+  getMSGNTF bob aliceId
   liftIO $ threadDelay 1_000000
   getMsg alice bobId $ pure ()
-  get alice ##> ("", bobId, CON)
+  inAnyOrder
+    (get alice)
+    [ \case ("", c, CON) -> c == bobId; _ -> False,
+      \case ("", c, MSGNTF {}) -> c == bobId; _ -> False
+    ]
   getMsg bob aliceId $
     get bob ##> ("", aliceId, CON)
+  getMSGNTF bob aliceId
   -- exchange messages
   4 <- sendMessage alice bobId SMP.noMsgFlags "hello"
   get alice ##> ("", bobId, SENT 4)
   getMsg bob aliceId $
     get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
   ackMessage bob aliceId 4 Nothing
+  getMSGNTF bob aliceId
   5 <- sendMessage bob aliceId SMP.noMsgFlags "hello too"
   get bob ##> ("", aliceId, SENT 5)
   getMsg alice bobId $
     get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
   ackMessage alice bobId 5 Nothing
+  getMSGNTF alice bobId
 
 getMsg :: AgentClient -> ConnId -> ExceptT AgentErrorType IO a -> ExceptT AgentErrorType IO a
 getMsg c cId action = do
   liftIO $ noMessages c "nothing should be delivered before GET"
   Just _ <- getConnectionMessage c cId
-  r <- action
-  get c =##> \case ("", cId', MSGNTF _) -> cId == cId'; _ -> False
-  pure r
+  action
+
+getMSGNTF :: AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
+getMSGNTF c cId =
+  get c =##> \case ("", c', MSGNTF {}) -> c' == cId; _ -> False
 
 testOnlyCreatePull :: IO ()
 testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
@@ -1716,11 +1727,13 @@ testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
   (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
   liftIO $ sqSecured `shouldBe` True
   Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
+  getMSGNTF alice bobId
   allowConnection alice bobId confId "alice's connInfo"
   liftIO $ threadDelay 1_000000
   getMsg bob aliceId $ do
     get bob ##> ("", aliceId, INFO "alice's connInfo")
     get bob ##> ("", aliceId, CON)
+  getMSGNTF bob aliceId
   liftIO $ threadDelay 1_000000
   get alice ##> ("", bobId, CON) -- sent to initiating party after sending confirmation
   -- exchange messages
@@ -1729,11 +1742,13 @@ testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
   getMsg bob aliceId $
     get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
   ackMessage bob aliceId 2 Nothing
+  getMSGNTF bob aliceId
   3 <- sendMessage bob aliceId SMP.noMsgFlags "hello too"
   get bob ##> ("", aliceId, SENT 3)
   getMsg alice bobId $
     get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
   ackMessage alice bobId 3 Nothing
+  getMSGNTF alice bobId
 
 makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
 makeConnection = makeConnection_ PQSupportOn True

From 80d3518d557eb29b0af3f6f6e15d26a1145ddf7f Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 6 Oct 2024 21:21:08 +0100
Subject: [PATCH 149/195] tests: store log (#1348)

* 6.1.0.4

* tests: store log

* random

* more tests
---
 simplexmq.cabal                          |   1 +
 src/Simplex/Messaging/Server/StoreLog.hs |   1 +
 tests/AgentTests/SQLiteTests.hs          |   2 +-
 tests/CoreTests/StoreLogTests.hs         | 123 +++++++++++++++++++++++
 tests/Test.hs                            |   2 +
 5 files changed, 128 insertions(+), 1 deletion(-)
 create mode 100644 tests/CoreTests/StoreLogTests.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index a77dfe9b0..483f2c9de 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -615,6 +615,7 @@ test-suite simplexmq-test
       CoreTests.EncodingTests
       CoreTests.RetryIntervalTests
       CoreTests.SOCKSSettings
+      CoreTests.StoreLogTests
       CoreTests.TRcvQueuesTests
       CoreTests.UtilTests
       CoreTests.VersionRangeTests
diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs
index cfe2cd82e..e28434f69 100644
--- a/src/Simplex/Messaging/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Server/StoreLog.hs
@@ -9,6 +9,7 @@
 
 module Simplex.Messaging.Server.StoreLog
   ( StoreLog, -- constructors are not exported
+    StoreLogRecord (..), -- used in tests
     openWriteStoreLog,
     openReadStoreLog,
     storeLogFilePath,
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index fedb7cdb6..09356c5b6 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -13,7 +13,7 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
-module AgentTests.SQLiteTests (storeTests) where
+module AgentTests.SQLiteTests where
 
 import AgentTests.EqInstances ()
 import Control.Concurrent.Async (concurrently_)
diff --git a/tests/CoreTests/StoreLogTests.hs b/tests/CoreTests/StoreLogTests.hs
new file mode 100644
index 000000000..33d2c5a4a
--- /dev/null
+++ b/tests/CoreTests/StoreLogTests.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module CoreTests.StoreLogTests where
+
+import Control.Concurrent.STM
+import Control.Monad
+import Crypto.Random (ChaChaDRG)
+import qualified Data.ByteString.Char8 as B
+import Data.Either (partitionEithers)
+import qualified Data.Map.Strict as M
+import SMPClient
+import AgentTests.SQLiteTests
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol
+import Simplex.Messaging.Server.StoreLog
+import Simplex.Messaging.Server.QueueStore
+import Test.Hspec
+
+testNewQueueRec :: TVar ChaChaDRG -> Bool -> IO QueueRec
+testNewQueueRec g sndSecure = do
+  recipientId <- atomically $ EntityId <$> C.randomBytes 24 g
+  senderId <- atomically $ EntityId <$> C.randomBytes 24 g
+  (recipientKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
+  (k, pk) <- atomically $ C.generateKeyPair @'C.X25519 g
+  pure QueueRec
+    { recipientId,
+      recipientKey,
+      rcvDhSecret = C.dh' k pk,
+      senderId,
+      senderKey = Nothing,
+      sndSecure,
+      notifier = Nothing,
+      status = QueueActive,
+      updatedAt = Nothing
+    }
+
+testNtfCreds :: TVar ChaChaDRG -> IO NtfCreds
+testNtfCreds g = do
+  (notifierKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
+  (k, pk) <- atomically $ C.generateKeyPair @'C.X25519 g
+  pure
+    NtfCreds
+      { notifierId = EntityId "ijkl",
+        notifierKey,
+        rcvNtfDhSecret = C.dh' k pk
+      }
+
+data StoreLogTestCase r s = SLTC {name :: String, saved :: [r], state :: s, compacted :: [r]}
+
+type SMPStoreLogTestCase = StoreLogTestCase StoreLogRecord (M.Map RecipientId QueueRec)
+
+deriving instance Eq QueueRec
+
+deriving instance Eq StoreLogRecord
+
+deriving instance Eq NtfCreds
+
+storeLogTests :: Spec
+storeLogTests =
+  forM_ [False, True] $ \sndSecure -> do
+    (qr, ntfCreds, date) <- runIO $ do
+      g <- C.newRandom
+      (,,) <$> testNewQueueRec g sndSecure <*> testNtfCreds g <*> getSystemDate
+    testSMPStoreLog ("SMP server store log, sndSecure = " <> show sndSecure)
+      [ SLTC
+          { name = "create new queue",
+            saved = [CreateQueue qr],
+            compacted = [CreateQueue qr],
+            state = M.fromList [(recipientId qr, qr)]
+          },
+        SLTC
+          { name = "secure queue",
+            saved = [CreateQueue qr, SecureQueue (recipientId qr) testPublicAuthKey],
+            compacted = [CreateQueue qr {senderKey = Just testPublicAuthKey}],
+            state = M.fromList [(recipientId qr, qr {senderKey = Just testPublicAuthKey})]
+          },          
+        SLTC
+          { name = "create and delete queue",
+            saved = [CreateQueue qr, DeleteQueue $ recipientId qr],
+            compacted = [],
+            state = M.fromList []
+          },
+        SLTC
+          { name = "create queue and add notifier",
+            saved = [CreateQueue qr, AddNotifier (recipientId qr) ntfCreds],
+            compacted = [CreateQueue $ qr {notifier = Just ntfCreds}],
+            state = M.fromList [(recipientId qr, qr {notifier = Just ntfCreds})]
+          },
+        SLTC
+          { name = "delete notifier",
+            saved = [CreateQueue qr, AddNotifier (recipientId qr) ntfCreds, DeleteNotifier (recipientId qr)],
+            compacted = [CreateQueue qr],
+            state = M.fromList [(recipientId qr, qr)]
+          },
+        SLTC
+          { name = "update time",
+            saved = [CreateQueue qr, UpdateTime (recipientId qr) date],
+            compacted = [CreateQueue qr {updatedAt = Just date}],
+            state = M.fromList [(recipientId qr, qr {updatedAt = Just date})]
+          }          
+      ]
+
+testSMPStoreLog :: String -> [SMPStoreLogTestCase] -> Spec
+testSMPStoreLog testSuite tests =
+  fdescribe testSuite $ forM_ tests $ \t@SLTC {name, saved} -> it name $ do
+    l <- openWriteStoreLog testStoreLogFile
+    mapM_ (writeStoreLogRecord l) saved
+    closeStoreLog l
+    replicateM_ 3 $ testReadWrite t
+  where
+    testReadWrite SLTC {compacted, state} = do
+      (state', l) <- readWriteStoreLog testStoreLogFile
+      state' `shouldBe` state
+      closeStoreLog l
+      ([], compacted') <- partitionEithers . map strDecode . B.lines <$> B.readFile testStoreLogFile
+      compacted' `shouldBe` compacted
diff --git a/tests/Test.hs b/tests/Test.hs
index ac95f8c06..bb1896be4 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -13,6 +13,7 @@ import CoreTests.CryptoTests
 import CoreTests.EncodingTests
 import CoreTests.RetryIntervalTests
 import CoreTests.SOCKSSettings
+import CoreTests.StoreLogTests
 import CoreTests.TRcvQueuesTests
 import CoreTests.UtilTests
 import CoreTests.VersionRangeTests
@@ -54,6 +55,7 @@ main = do
           describe "Encrypted files tests" cryptoFileTests
           describe "Retry interval tests" retryIntervalTests
           describe "SOCKS settings tests" socksSettingsTests
+          describe "Store log tests" storeLogTests
           describe "TRcvQueues tests" tRcvQueuesTests
           describe "Util tests" utilTests
         describe "SMP server via TLS" $ serverTests (transport @TLS)

From f871f20172f07f563d8f4eb13a3ac49663f5930d Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 7 Oct 2024 09:01:28 +0100
Subject: [PATCH 150/195] smp server: fix notification delivery (#1350)

* .401

* stats for undelivered notifications

* logs, stats

* control port show ntf client IDs

* check that Ntf client is still current and that queue is not full, drop notifications otherwise

* prevent losing notifications when client is not current or queue full

* add log when no notifications, remove some logs

* reduce STM transaction

* revert version change
---
 src/Simplex/Messaging/Server.hs          | 107 ++++++++++++++++-------
 src/Simplex/Messaging/Server/NtfStore.hs |  14 +--
 src/Simplex/Messaging/Server/Stats.hs    |  18 ++--
 tests/CoreTests/StoreLogTests.hs         |   2 +-
 4 files changed, 91 insertions(+), 50 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 014e78e8e..8cdf55e8b 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -38,6 +38,7 @@ module Simplex.Messaging.Server
   )
 where
 
+import Control.Concurrent.STM (throwSTM)
 import Control.Concurrent.STM.TQueue (flushTQueue)
 import Control.Logger.Simple
 import Control.Monad
@@ -237,27 +238,46 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
     deliverNtfsThread :: Server -> M ()
     deliverNtfsThread Server {ntfSubClients} = do
       ntfInt <- asks $ ntfDeliveryInterval . config
-      ns <- asks ntfStore
+      NtfStore ns <- asks ntfStore
       stats <- asks serverStats
       liftIO $ forever $ do
         threadDelay ntfInt
         readTVarIO ntfSubClients >>= mapM_ (deliverNtfs ns stats)
       where
-        deliverNtfs ns stats Client {clientId, ntfSubscriptions, sndQ, connected} = whenM currentClient $
-          readTVarIO ntfSubscriptions >>= \subs -> do
-            ts_ <- foldM addNtfs [] (M.keys subs)
-            mapM_ (atomically . writeTBQueue sndQ) $ L.nonEmpty ts_
-            updateNtfStats $ length ts_
+        deliverNtfs ns stats Client {clientId, ntfSubscriptions, sndQ, connected} =
+          whenM (currentClient readTVarIO) $ do
+            subs <- readTVarIO ntfSubscriptions
+            logDebug $ "NOTIFICATIONS: client #" <> tshow clientId <> " is current with " <> tshow (M.size subs) <> " subs"
+            ntfQs <- M.assocs . M.filterWithKey (\nId _ -> M.member nId subs) <$> readTVarIO ns
+            tryAny (atomically $ flushSubscribedNtfs ntfQs) >>= \case
+              Right len -> updateNtfStats len
+              Left e -> logDebug $ "NOTIFICATIONS: cancelled for client #" <> tshow clientId <> ", reason: " <> tshow e
           where
-            currentClient = (&&) <$> readTVarIO connected <*> (IM.member clientId <$> readTVarIO ntfSubClients)
-            addNtfs :: [Transmission BrokerMsg] -> NotifierId -> IO [Transmission BrokerMsg]
-            addNtfs acc nId =
-              (foldl' (\acc' ntf -> nmsg nId ntf : acc') acc) -- reverses, to order by time
-                <$> flushNtfs ns nId
+            flushSubscribedNtfs :: [(NotifierId, TVar [MsgNtf])] -> STM Int
+            flushSubscribedNtfs ntfQs = do
+              ts_ <- foldM addNtfs [] ntfQs
+              forM_ (L.nonEmpty ts_) $ \ts -> do
+                let cancelNtfs s = throwSTM $ userError $ s <> ", " <> show (length ts_) <> " ntfs kept"
+                unlessM (currentClient readTVar) $ cancelNtfs "not current client"
+                whenM (isFullTBQueue sndQ) $ cancelNtfs "sending queue full"
+                writeTBQueue sndQ ts
+              pure $ length ts_
+            currentClient :: Monad m => (forall a. TVar a -> m a) -> m Bool
+            currentClient rd = (&&) <$> rd connected <*> (IM.member clientId <$> rd ntfSubClients)
+            addNtfs :: [Transmission BrokerMsg] -> (NotifierId, TVar [MsgNtf]) -> STM [Transmission BrokerMsg]
+            addNtfs acc (nId, v) =
+              readTVar v >>= \case
+                [] -> pure acc
+                ntfs -> do
+                  writeTVar v []
+                  pure $ foldl' (\acc' ntf -> nmsg nId ntf : acc') acc ntfs -- reverses, to order by time
             nmsg nId MsgNtf {ntfNonce, ntfEncMeta} = (CorrId "", nId, NMSG ntfNonce ntfEncMeta)
-            updateNtfStats len = when (len > 0) $ liftIO $ do
+            updateNtfStats 0 = logDebug $ "NOTIFICATIONS: no ntfs for client #" <> tshow clientId
+            updateNtfStats len = liftIO $ do
+              atomicModifyIORef'_ (ntfCount stats) (subtract len)
               atomicModifyIORef'_ (msgNtfs stats) (+ len)
               atomicModifyIORef'_ (msgNtfsB stats) (+ (len `div` 80 + 1)) -- up to 80 NMSG in the batch
+              logDebug $ "NOTIFICATIONS: delivered to client #" <> tshow clientId <> " " <> tshow len <> " ntfs"
 
     sendPendingEvtsThread :: Server -> M ()
     sendPendingEvtsThread s = do
@@ -334,7 +354,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
         threadDelay' interval
         old <- expireBeforeEpoch expCfg
         expired <- deleteExpiredNtfs ns old
-        when (expired > 0) $ atomicModifyIORef'_ (msgNtfExpired stats) (+ expired)
+        when (expired > 0) $ do
+          atomicModifyIORef'_ (msgNtfExpired stats) (+ expired)
+          atomicModifyIORef'_ (ntfCount stats) (subtract expired)
 
     serverStatsThread_ :: ServerConfig -> [M ()]
     serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime, serverStatsLogFile} =
@@ -347,7 +369,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
       initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
       liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
       liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
-      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedAllB, qDeletedNew, qDeletedSecured, qSub, qSubAllB, qSubAuth, qSubDuplicate, qSubProhibited, qSubEnd, qSubEndB, ntfCreated, ntfDeleted, ntfDeletedB, ntfSub, ntfSubB, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv}
+      ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedAllB, qDeletedNew, qDeletedSecured, qSub, qSubAllB, qSubAuth, qSubDuplicate, qSubProhibited, qSubEnd, qSubEndB, ntfCreated, ntfDeleted, ntfDeletedB, ntfSub, ntfSubB, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, ntfCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv}
         <- asks serverStats
       QueueStore {queues, notifiers} <- asks queueStore
       let interval = 1000000 * logInterval
@@ -404,8 +426,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
           pMsgFwdsRecv' <- atomicSwapIORef pMsgFwdsRecv 0
           qCount' <- readIORef qCount
           qCount'' <- M.size <$> readTVarIO queues
-          ntfCount' <- M.size <$> readTVarIO notifiers
+          notifierCount' <- M.size <$> readTVarIO notifiers
           msgCount' <- readIORef msgCount
+          ntfCount' <- readIORef ntfCount
           hPutStrLn h $
             intercalate
               ","
@@ -462,7 +485,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                        show ntfSub',
                        show ntfSubAuth',
                        show ntfSubDuplicate',
-                       show ntfCount',
+                       show notifierCount',
                        show qDeletedAllB',
                        show qSubAllB',
                        show qSubEnd',
@@ -470,7 +493,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                        show ntfDeletedB',
                        show ntfSubB',
                        show msgNtfsB',
-                       show msgNtfExpired'
+                       show msgNtfExpired',
+                       show ntfCount'
                      ]
               )
         liftIO $ threadDelay' interval
@@ -547,6 +571,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                   hPutStrLn h . B.unpack $ B.intercalate "," [bshow cid, encode sessionId, connected', strEncode createdAt, rcvActiveAt', sndActiveAt', bshow age, subscriptions']
               CPStats -> withUserRole $ do
                 ss <- unliftIO u $ asks serverStats
+                QueueStore {queues, notifiers} <- unliftIO u $ asks queueStore
                 let getStat :: (ServerStats -> IORef a) -> IO a
                     getStat var = readIORef (var ss)
                     putStat :: Show a => String -> (ServerStats -> IORef a) -> IO ()
@@ -584,7 +609,18 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                 putStat "msgNtfsB" msgNtfsB
                 putStat "msgNtfExpired" msgNtfExpired
                 putStat "qCount" qCount
+                qCount2 <- M.size <$> readTVarIO queues
+                hPutStrLn h $ "qCount 2: " <> show qCount2
+                notifierCount <- M.size <$> readTVarIO notifiers
+                hPutStrLn h $ "notifiers: " <> show notifierCount
                 putStat "msgCount" msgCount
+                putStat "ntfCount" ntfCount
+                readTVarIO role >>= \case
+                  CPRAdmin -> do
+                    NtfStore ns <- unliftIO u $ asks ntfStore
+                    ntfCount2 <- liftIO . foldM (\(!n) q -> (n +) . length <$> readTVarIO q) 0 =<< readTVarIO ns
+                    hPutStrLn h $ "ntfCount 2: " <> show ntfCount2
+                  _ -> pure ()
                 putProxyStat "pRelays" pRelays
                 putProxyStat "pRelaysOwn" pRelaysOwn
                 putProxyStat "pMsgFwds" pMsgFwds
@@ -650,24 +686,24 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                     hPutStrLn h $ "Ntf subscriptions (via clients): " <> show ntfSubCnt
                     hPutStrLn h $ "Ntf subscribed clients (via clients): " <> show ntfClCnt
                     hPutStrLn h $ "Ntf subscribed clients queues (via clients, rcvQ, sndQ, msgQ): " <> show ntfClQs
-                  putActiveClientsInfo "SMP" subscribers
-                  putActiveClientsInfo "Ntf" notifiers
-                  putSubscribedClients "SMP" subClients
-                  putSubscribedClients "Ntf" ntfSubClients
+                  putActiveClientsInfo "SMP" subscribers False
+                  putActiveClientsInfo "Ntf" notifiers True
+                  putSubscribedClients "SMP" subClients False
+                  putSubscribedClients "Ntf" ntfSubClients True
                   where
-                    putActiveClientsInfo :: String -> TMap QueueId (TVar Client) -> IO ()
-                    putActiveClientsInfo protoName clients = do
+                    putActiveClientsInfo :: String -> TMap QueueId (TVar Client) -> Bool -> IO ()
+                    putActiveClientsInfo protoName clients showIds = do
                       activeSubs <- readTVarIO clients
                       hPutStrLn h $ protoName <> " subscriptions: " <> show (M.size activeSubs)
-                      clCnt <- IS.size <$> countSubClients activeSubs
-                      hPutStrLn h $ protoName <> " subscribed clients: " <> show clCnt
+                      clnts <- countSubClients activeSubs
+                      hPutStrLn h $ protoName <> " subscribed clients: " <> show (IS.size clnts) <> (if showIds then " " <> show (IS.toList clnts) else "")
                       where
                         countSubClients :: M.Map QueueId (TVar Client) -> IO IS.IntSet
                         countSubClients = foldM (\ !s c -> (`IS.insert` s) . clientId <$> readTVarIO c) IS.empty
-                    putSubscribedClients :: String -> TVar (IM.IntMap Client) -> IO ()
-                    putSubscribedClients protoName subClnts = do
+                    putSubscribedClients :: String -> TVar (IM.IntMap Client) -> Bool -> IO ()
+                    putSubscribedClients protoName subClnts showIds = do
                       clnts <- readTVarIO subClnts
-                      hPutStrLn h $ protoName <> " subscribed clients count:" <> show (IM.size clnts)
+                      hPutStrLn h $ protoName <> " subscribed clients count 2: " <> show (IM.size clnts) <> (if showIds then " " <> show (IM.keys clnts) else "")
                     countClientSubs :: (Client -> TMap QueueId a) -> Maybe (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap (Maybe Client) -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
                     countClientSubs subSel countSubs_ = foldM addSubs (0, (0, 0, 0, 0), 0, (0, 0, 0))
                       where
@@ -1184,9 +1220,11 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           liftIO (deleteQueueNotifier st entId) >>= \case
             Right (Just nId) -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
-              asks ntfStore >>= liftIO . (`deleteNtfs` nId)
+              stats <- asks serverStats
+              deleted <- asks ntfStore >>= liftIO . (`deleteNtfs` nId)
+              when (deleted > 0) $ liftIO $ atomicModifyIORef'_ (ntfCount stats) (subtract deleted)
               atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
-              incStat . ntfDeleted =<< asks serverStats
+              incStat $ ntfDeleted stats
               pure ok
             Right Nothing -> pure ok
             Left e -> pure $ err e
@@ -1459,6 +1497,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               ns <- asks ntfStore
               ntf <- mkMessageNotification msgId msgTs rcvNtfDhSecret
               liftIO $ storeNtf ns nId ntf
+              incStat . ntfCount =<< asks serverStats
 
             mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> M MsgNtf
             mkMessageNotification msgId msgTs rcvNtfDhSecret = do
@@ -1569,7 +1608,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               forM_ (notifierId <$> notifier q) $ \nId -> do
                 -- queue is deleted by a different client from the one subscribed to notifications,
                 -- so we don't need to remove subscription from the current client.
-                asks ntfStore >>= liftIO . (`deleteNtfs` nId)
+                stats <- asks serverStats
+                deleted <- asks ntfStore >>= liftIO . (`deleteNtfs` nId)
+                when (deleted > 0) $ liftIO $ atomicModifyIORef'_ (ntfCount stats) (subtract deleted)
                 atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
               updateDeletedStats q
               pure ok
@@ -1760,7 +1801,9 @@ restoreServerStats expiredMsgs expiredNtfs = asks (serverStatsBackupFile . confi
           s <- asks serverStats
           _qCount <- fmap M.size . readTVarIO . queues =<< asks queueStore
           _msgCount <- liftIO . foldM (\(!n) q -> (n +) <$> getQueueSize q) 0 =<< readTVarIO =<< asks msgStore
-          liftIO $ setServerStats s d {_qCount, _msgCount, _msgExpired = _msgExpired d + expiredMsgs, _msgNtfExpired = _msgNtfExpired d + expiredNtfs}
+          NtfStore ns <- asks ntfStore
+          _ntfCount <- liftIO . foldM (\(!n) q -> (n +) . length <$> readTVarIO q) 0 =<< readTVarIO ns
+          liftIO $ setServerStats s d {_qCount, _msgCount, _ntfCount, _msgExpired = _msgExpired d + expiredMsgs, _msgNtfExpired = _msgNtfExpired d + expiredNtfs}
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
           when (_qCount /= statsQCount) $ logWarn $ "Queue count differs: stats: " <> tshow statsQCount <> ", store: " <> tshow _qCount
diff --git a/src/Simplex/Messaging/Server/NtfStore.hs b/src/Simplex/Messaging/Server/NtfStore.hs
index ded2bd85d..7895f64e9 100644
--- a/src/Simplex/Messaging/Server/NtfStore.hs
+++ b/src/Simplex/Messaging/Server/NtfStore.hs
@@ -34,18 +34,8 @@ storeNtf (NtfStore ns) nId ntf = do
   where
     newNtfs = TM.lookup nId ns >>= maybe (TM.insertM nId (newTVar [ntf]) ns) (`modifyTVar'` (ntf :))
 
-deleteNtfs :: NtfStore -> NotifierId -> IO ()
-deleteNtfs (NtfStore ns) nId = atomically $ TM.delete nId ns
-
-flushNtfs :: NtfStore -> NotifierId -> IO [MsgNtf]
-flushNtfs (NtfStore ns) nId = do
-  TM.lookupIO nId ns >>= maybe (pure []) swapNtfs
-  where
-    swapNtfs v =
-      readTVarIO v >>= \case
-        [] -> pure []
-        -- if notifications available, atomically swap with empty array
-        _ -> atomically (swapTVar v [])
+deleteNtfs :: NtfStore -> NotifierId -> IO Int
+deleteNtfs (NtfStore ns) nId = atomically (TM.lookupDelete nId ns) >>= maybe (pure 0) (fmap length . readTVarIO)
 
 deleteExpiredNtfs :: NtfStore -> Int64 -> IO Int
 deleteExpiredNtfs (NtfStore ns) old =
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index 49078d2d9..385ba119b 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -77,7 +77,8 @@ data ServerStats = ServerStats
     pMsgFwdsOwn :: ProxyStats,
     pMsgFwdsRecv :: IORef Int,
     qCount :: IORef Int,
-    msgCount :: IORef Int
+    msgCount :: IORef Int,
+    ntfCount :: IORef Int
   }
 
 data ServerStatsData = ServerStatsData
@@ -129,7 +130,8 @@ data ServerStatsData = ServerStatsData
     _pMsgFwdsOwn :: ProxyStatsData,
     _pMsgFwdsRecv :: Int,
     _qCount :: Int,
-    _msgCount :: Int
+    _msgCount :: Int,
+    _ntfCount :: Int
   }
   deriving (Show)
 
@@ -184,6 +186,7 @@ newServerStats ts = do
   pMsgFwdsRecv <- newIORef 0
   qCount <- newIORef 0
   msgCount <- newIORef 0
+  ntfCount <- newIORef 0
   pure
     ServerStats
       { fromTime,
@@ -234,7 +237,8 @@ newServerStats ts = do
         pMsgFwdsOwn,
         pMsgFwdsRecv,
         qCount,
-        msgCount
+        msgCount,
+        ntfCount
       }
 
 getServerStatsData :: ServerStats -> IO ServerStatsData
@@ -288,6 +292,7 @@ getServerStatsData s = do
   _pMsgFwdsRecv <- readIORef $ pMsgFwdsRecv s
   _qCount <- readIORef $ qCount s
   _msgCount <- readIORef $ msgCount s
+  _ntfCount <- readIORef $ ntfCount s
   pure
     ServerStatsData
       { _fromTime,
@@ -338,7 +343,8 @@ getServerStatsData s = do
         _pMsgFwdsOwn,
         _pMsgFwdsRecv,
         _qCount,
-        _msgCount
+        _msgCount,
+        _ntfCount
       }
 
 -- this function is not thread safe, it is used on server start only
@@ -393,6 +399,7 @@ setServerStats s d = do
   writeIORef (pMsgFwdsRecv s) $! _pMsgFwdsRecv d
   writeIORef (qCount s) $! _qCount d
   writeIORef (msgCount s) $! _msgCount d
+  writeIORef (ntfCount s) $! _ntfCount d
 
 instance StrEncoding ServerStatsData where
   strEncode d =
@@ -566,7 +573,8 @@ instance StrEncoding ServerStatsData where
           _pMsgFwdsOwn,
           _pMsgFwdsRecv,
           _qCount,
-          _msgCount = 0
+          _msgCount = 0,
+          _ntfCount = 0
         }
     where
       opt s = A.string s *> strP <* A.endOfLine <|> pure 0
diff --git a/tests/CoreTests/StoreLogTests.hs b/tests/CoreTests/StoreLogTests.hs
index 33d2c5a4a..d2462a09e 100644
--- a/tests/CoreTests/StoreLogTests.hs
+++ b/tests/CoreTests/StoreLogTests.hs
@@ -109,7 +109,7 @@ storeLogTests =
 
 testSMPStoreLog :: String -> [SMPStoreLogTestCase] -> Spec
 testSMPStoreLog testSuite tests =
-  fdescribe testSuite $ forM_ tests $ \t@SLTC {name, saved} -> it name $ do
+  describe testSuite $ forM_ tests $ \t@SLTC {name, saved} -> it name $ do
     l <- openWriteStoreLog testStoreLogFile
     mapM_ (writeStoreLogRecord l) saved
     closeStoreLog l

From e01398a31a9db33c607424f558f1e0389ec4dcea Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 7 Oct 2024 10:22:58 +0100
Subject: [PATCH 151/195] agent: send MSGNTF on NO_MSG error (#1362)

* agent: send MSGNTF on NO_MSG error

* simplify
---
 src/Simplex/Messaging/Agent.hs        | 15 +++++++++------
 src/Simplex/Messaging/Agent/Client.hs |  5 +++--
 2 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index d2a96a5ed..a3bda8629 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1684,15 +1684,18 @@ ackQueueMessage :: AgentClient -> RcvQueue -> SMP.MsgId -> AM ()
 ackQueueMessage c rq@RcvQueue {userId, connId, server} srvMsgId = do
   atomically $ incSMPServerStat c userId server ackAttempts
   tryAgentError (sendAck c rq srvMsgId) >>= \case
-    Right _ -> do
-      atomically $ incSMPServerStat c userId server ackMsgs
-      whenM (liftIO $ hasGetLock c rq) $ do
-        brokerTs_ <- (Just <$> withStore c (\db -> getRcvMsgBrokerTs db connId srvMsgId)) `catchAgentError` \_ -> pure Nothing
-        atomically $ writeTBQueue (subQ c) ("", connId, AEvt SAEConn $ MSGNTF srvMsgId brokerTs_)
-    Left (SMP _ SMP.NO_MSG) -> atomically $ incSMPServerStat c userId server ackNoMsgErrs
+    Right _ -> sendMsgNtf ackMsgs
+    Left (SMP _ SMP.NO_MSG) -> sendMsgNtf ackNoMsgErrs
     Left e -> do
       unless (temporaryOrHostError e) $ atomically $ incSMPServerStat c userId server ackOtherErrs
       throwE e
+  where
+    sendMsgNtf stat = do
+      atomically $ incSMPServerStat c userId server stat
+      whenM (liftIO $ hasGetLock c rq) $ do
+        atomically $ releaseGetLock c rq
+        brokerTs_ <- eitherToMaybe <$> tryAgentError (withStore c $ \db -> getRcvMsgBrokerTs db connId srvMsgId)
+        atomically $ writeTBQueue (subQ c) ("", connId, AEvt SAEConn $ MSGNTF srvMsgId brokerTs_)
 
 -- | Suspend SMP agent connection (OFF command) in Reader monad
 suspendConnection' :: AgentClient -> ConnId -> AM ()
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 1c6fa38f8..13d554f3c 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -92,6 +92,7 @@ module Simplex.Messaging.Agent.Client
     hasActiveSubscription,
     hasPendingSubscription,
     hasGetLock,
+    releaseGetLock,
     activeClientSession,
     agentClientStore,
     agentDRG,
@@ -1647,8 +1648,8 @@ disableQueuesNtfs = sendTSessionBatches "NDEL" snd disableQueues_
 
 sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId =
-  withSMPClient c rq ("ACK:" <> logSecret' msgId) (\smp -> ackSMPMessage smp rcvPrivateKey rcvId msgId)
-    `agentFinally` atomically (releaseGetLock c rq)
+  withSMPClient c rq ("ACK:" <> logSecret' msgId) $ \smp ->
+    ackSMPMessage smp rcvPrivateKey rcvId msgId      
 
 hasGetLock :: AgentClient -> RcvQueue -> IO Bool
 hasGetLock c RcvQueue {server, rcvId} =

From b8971a31bcb82fffabcb792c9afd6bc4a96ec649 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 7 Oct 2024 10:24:19 +0100
Subject: [PATCH 152/195] 6.1.0.5

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index d6bca13ae..aac53546c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.1.0.4
+version: 6.1.0.5
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 483f2c9de..5360513b1 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.1.0.4
+version:        6.1.0.5
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 8981cae3c2adb720f24941d8157a39bd4a9c996b Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 7 Oct 2024 22:22:02 +0100
Subject: [PATCH 153/195] ci: always generate change log

---
 .github/workflows/build.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 04a2acdf0..385cd215d 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -63,7 +63,7 @@ jobs:
           mv $(cabal list-bin xftp) xftp-ubuntu-${{ matrix.platform_name}}
 
       - name: Build changelog
-        if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'ubuntu-22.04'
+        if: startsWith(github.ref, 'refs/tags/v')
         id: build_changelog
         uses: mikepenz/release-changelog-builder-action@v1
         with:

From f24ee701385436a97264e9022bec0891a8af7237 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 7 Oct 2024 22:40:30 +0100
Subject: [PATCH 154/195] clients: do not send SNI (#1363)

---
 src/Simplex/FileTransfer/Client.hs              | 2 +-
 src/Simplex/Messaging/Notifications/Client.hs   | 2 +-
 src/Simplex/Messaging/Transport/HTTP2/Client.hs | 2 +-
 tests/CoreTests/SOCKSSettings.hs                | 2 +-
 4 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs
index d8904e05e..7abfdfe5a 100644
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -104,7 +104,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
   let socksCreds = clientSocksCredentials xftpNetworkConfig proxySessTs transportSession
       ProtocolServer _ host port keyHash = srv
   useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
-  let tcConfig = (transportClientConfig xftpNetworkConfig useHost True) {alpn = clientALPN}
+  let tcConfig = (transportClientConfig xftpNetworkConfig useHost False) {alpn = clientALPN}
       http2Config = xftpHTTP2Config tcConfig config
   clientVar <- newTVarIO Nothing
   let usePort = if null port then "443" else port
diff --git a/src/Simplex/Messaging/Notifications/Client.hs b/src/Simplex/Messaging/Notifications/Client.hs
index ba90b1530..273010c2c 100644
--- a/src/Simplex/Messaging/Notifications/Client.hs
+++ b/src/Simplex/Messaging/Notifications/Client.hs
@@ -24,7 +24,7 @@ type NtfClientError = ProtocolClientError ErrorType
 
 defaultNTFClientConfig :: ProtocolClientConfig NTFVersion
 defaultNTFClientConfig =
-  (defaultClientConfig (Just supportedNTFHandshakes) True supportedClientNTFVRange)
+  (defaultClientConfig (Just supportedNTFHandshakes) False supportedClientNTFVRange)
     {defaultTransport = ("443", transport @TLS)}
 {-# INLINE defaultNTFClientConfig #-}
 
diff --git a/src/Simplex/Messaging/Transport/HTTP2/Client.hs b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
index b5e05d20d..eda71cb98 100644
--- a/src/Simplex/Messaging/Transport/HTTP2/Client.hs
+++ b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
@@ -79,7 +79,7 @@ defaultHTTP2ClientConfig =
             logTLSErrors = True,
             clientCredentials = Nothing,
             alpn = Nothing,
-            useSNI = True
+            useSNI = False
           },
       bufferSize = defaultHTTP2BufferSize,
       bodyHeadSize = 16384,
diff --git a/tests/CoreTests/SOCKSSettings.hs b/tests/CoreTests/SOCKSSettings.hs
index 78e4ae187..1c510e3c4 100644
--- a/tests/CoreTests/SOCKSSettings.hs
+++ b/tests/CoreTests/SOCKSSettings.hs
@@ -90,7 +90,7 @@ testSocksMode = do
   where
     transportSocks proxy socksMode = transportSocksCfg defaultNetworkConfig {socksProxy = proxy, socksMode}
     transportSocksCfg cfg host =
-      let TransportClientConfig {socksProxy} = transportClientConfig cfg host True
+      let TransportClientConfig {socksProxy} = transportClientConfig cfg host False
        in socksProxy
 
 testSocksProxyEncoding :: Spec

From ca2202e3c811dc4fe3eb616224dc28e643222005 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 7 Oct 2024 22:41:53 +0100
Subject: [PATCH 155/195] 6.1.0.6

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index aac53546c..06b05a6f4 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.1.0.5
+version: 6.1.0.6
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 5360513b1..a639495c1 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.1.0.5
+version:        6.1.0.6
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From e1201f09674e5a7353ac0c6a566b176915e36c09 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Wed, 9 Oct 2024 15:16:08 +0400
Subject: [PATCH 156/195] agent: test db indexes (#1364)

---
 .../Store/SQLite/Migrations/agent_lint.sql    |  1 +
 tests/AgentTests/SchemaDump.hs                | 37 +++++++++++++++++--
 2 files changed, 35 insertions(+), 3 deletions(-)
 create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_lint.sql

diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_lint.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_lint.sql
new file mode 100644
index 000000000..318ea2d02
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_lint.sql
@@ -0,0 +1 @@
+CREATE INDEX 'ratchets_conn_id' ON 'ratchets'('conn_id'); --> connections(conn_id)
diff --git a/tests/AgentTests/SchemaDump.hs b/tests/AgentTests/SchemaDump.hs
index c32b69f10..3ee2774bc 100644
--- a/tests/AgentTests/SchemaDump.hs
+++ b/tests/AgentTests/SchemaDump.hs
@@ -4,6 +4,7 @@
 module AgentTests.SchemaDump where
 
 import Control.DeepSeq
+import Control.Exception (bracket_)
 import Control.Monad (unless, void)
 import Data.List (dropWhileEnd)
 import Data.Maybe (fromJust, isJust)
@@ -14,7 +15,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction')
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..), MigrationsToRun (..), toDownMigration)
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Util (ifM)
-import System.Directory (doesFileExist, removeFile)
+import System.Directory (createDirectoryIfMissing, doesFileExist, removeDirectoryRecursive, removeFile)
 import System.Process (readCreateProcess, shell)
 import Test.Hspec
 
@@ -24,12 +25,22 @@ testDB = "tests/tmp/test_agent_schema.db"
 appSchema :: FilePath
 appSchema = "src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql"
 
+-- Some indexes found by `.lint fkey-indexes` are not added to schema, explanation:
+--
+-- - CREATE INDEX 'ratchets_conn_id' ON 'ratchets'('conn_id'); --> connections(conn_id)
+--   Primary key is used instead. See for example:
+--   EXPLAIN QUERY PLAN DELETE FROM connections;
+--   (uses conn_id for ratchets table)
+appLint :: FilePath
+appLint = "src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_lint.sql"
+
 testSchema :: FilePath
 testSchema = "tests/tmp/test_agent_schema.sql"
 
 schemaDumpTest :: Spec
 schemaDumpTest = do
   it "verify and overwrite schema dump" testVerifySchemaDump
+  it "verify .lint fkey-indexes" testVerifyLintFKeyIndexes
   it "verify schema down migrations" testSchemaMigrations
   it "should NOT create user record for new database" testUsersMigrationNew
   it "should create user record for old database" testUsersMigrationOld
@@ -42,6 +53,20 @@ testVerifySchemaDump = do
   getSchema testDB appSchema `shouldReturn` savedSchema
   removeFile testDB
 
+testVerifyLintFKeyIndexes :: IO ()
+testVerifyLintFKeyIndexes = do
+  savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "")
+  savedLint `deepseq` pure ()
+  void $ createSQLiteStore testDB "" False Migrations.app MCConsole
+  getLintFKeyIndexes testDB "tests/tmp/agent_lint.sql" `shouldReturn` savedLint
+  removeFile testDB
+
+withTmpFiles :: IO () -> IO ()
+withTmpFiles =
+  bracket_
+    (createDirectoryIfMissing False "tests/tmp")
+    (removeDirectoryRecursive "tests/tmp")
+
 testSchemaMigrations :: IO ()
 testSchemaMigrations = do
   let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Migrations.app
@@ -92,7 +117,13 @@ skipComparisonForDownMigrations =
   ]
 
 getSchema :: FilePath -> FilePath -> IO String
-getSchema dpPath schemaPath = do
-  void $ readCreateProcess (shell $ "sqlite3 " <> dpPath <> " '.schema --indent' > " <> schemaPath) ""
+getSchema dbPath schemaPath = do
+  void $ readCreateProcess (shell $ "sqlite3 " <> dbPath <> " '.schema --indent' > " <> schemaPath) ""
   sch <- readFile schemaPath
   sch `deepseq` pure sch
+
+getLintFKeyIndexes :: FilePath -> FilePath -> IO String
+getLintFKeyIndexes dbPath lintPath = do
+  void $ readCreateProcess (shell $ "sqlite3 " <> dbPath <> " '.lint fkey-indexes' > " <> lintPath) ""
+  lint <- readFile lintPath
+  lint `deepseq` pure lint

From 9ad26c97a1b3a0b334b8f9c3c8c3103e94ef30aa Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Fri, 11 Oct 2024 14:05:14 +0400
Subject: [PATCH 157/195] agent: prepareConnectionToAccept api (#1365)

* agent: prepare conn (plan)

* implement

* refactor

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
---
 src/Simplex/Messaging/Agent.hs         | 130 ++++++++++++-------------
 tests/AgentTests/FunctionalAPITests.hs |  46 ++++-----
 tests/SMPProxyTests.hs                 |  14 ++-
 3 files changed, 94 insertions(+), 96 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index a3bda8629..961ccb2cf 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -56,6 +56,7 @@ module Simplex.Messaging.Agent
     createConnection,
     changeConnectionUser,
     prepareConnectionToJoin,
+    prepareConnectionToAccept,
     joinConnection,
     allowConnection,
     acceptContact,
@@ -332,7 +333,7 @@ deleteConnectionsAsync c waitDelivery = withAgentEnv c . deleteConnectionsAsync'
 
 -- | Create SMP agent connection (NEW command)
 createConnection :: AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AE (ConnId, ConnectionRequestUri c)
-createConnection c userId enableNtfs = withAgentEnv c .:: newConn c userId "" enableNtfs
+createConnection c userId enableNtfs = withAgentEnv c .:: newConn c userId enableNtfs
 {-# INLINE createConnection #-}
 
 -- | Changes the user id associated with a connection
@@ -348,10 +349,13 @@ changeConnectionUser c oldUserId connId newUserId = withAgentEnv c $ changeConne
 prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> PQSupport -> AE ConnId
 prepareConnectionToJoin c userId enableNtfs = withAgentEnv c .: newConnToJoin c userId "" enableNtfs
 
+-- | Create SMP agent connection without queue (to be joined with acceptContact passing invitation ID).
+prepareConnectionToAccept :: AgentClient -> Bool -> ConfirmationId -> PQSupport -> AE ConnId
+prepareConnectionToAccept c enableNtfs = withAgentEnv c .: newConnToAccept c "" enableNtfs
+
 -- | Join SMP agent connection (JOIN command).
-joinConnection :: AgentClient -> UserId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
-joinConnection c userId Nothing enableNtfs = withAgentEnv c .:: joinConn c userId "" False enableNtfs
-joinConnection c userId (Just connId) enableNtfs = withAgentEnv c .:: joinConn c userId connId True enableNtfs
+joinConnection :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured
+joinConnection c userId connId enableNtfs = withAgentEnv c .:: joinConn c userId connId enableNtfs
 {-# INLINE joinConnection #-}
 
 -- | Allow connection to continue after CONF notification (LET command)
@@ -360,8 +364,8 @@ allowConnection c = withAgentEnv c .:. allowConnection' c
 {-# INLINE allowConnection #-}
 
 -- | Accept contact after REQ notification (ACPT command)
-acceptContact :: AgentClient -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
-acceptContact c enableNtfs = withAgentEnv c .:: acceptContact' c "" enableNtfs
+acceptContact :: AgentClient -> ConnId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured
+acceptContact c connId enableNtfs = withAgentEnv c .:: acceptContact' c connId enableNtfs
 {-# INLINE acceptContact #-}
 
 -- | Reject contact (RJCT command)
@@ -649,15 +653,15 @@ deleteUser' c@AgentClient {smpServersStats, xftpServersStats} userId delSMPQueue
 
 newConnAsync :: ConnectionModeI c => AgentClient -> UserId -> ACorrId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AM ConnId
 newConnAsync c userId corrId enableNtfs cMode pqInitKeys subMode = do
-  connId <- newConnNoQueues c userId "" enableNtfs cMode (CR.connPQEncryption pqInitKeys)
+  connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys)
   enqueueCommand c corrId connId Nothing $ AClientCommand $ NEW enableNtfs (ACM cMode) pqInitKeys subMode
   pure connId
 
-newConnNoQueues :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> PQSupport -> AM ConnId
-newConnNoQueues c userId connId enableNtfs cMode pqSupport = do
+newConnNoQueues :: AgentClient -> UserId -> Bool -> SConnectionMode c -> PQSupport -> AM ConnId
+newConnNoQueues c userId enableNtfs cMode pqSupport = do
   g <- asks random
   connAgentVersion <- asks $ maxVersion . smpAgentVRange . config
-  let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
+  let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
   withStore c $ \db -> createNewConn db g cData cMode
 
 joinConnAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
@@ -744,9 +748,12 @@ switchConnectionAsync' c corrId connId =
             pure . connectionStats $ DuplexConnection cData rqs' sqs
       _ -> throwE $ CMD PROHIBITED "switchConnectionAsync: not duplex"
 
-newConn :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AM (ConnId, ConnectionRequestUri c)
-newConn c userId connId enableNtfs cMode clientData pqInitKeys subMode =
-  getSMPServer c userId >>= newConnSrv c userId connId False enableNtfs cMode clientData pqInitKeys subMode
+newConn :: AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AM (ConnId, ConnectionRequestUri c)
+newConn c userId enableNtfs cMode clientData pqInitKeys subMode = do
+  srv <- getSMPServer c userId
+  connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys)
+  cReq <- newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv
+  pure (connId, cReq)
 
 changeConnectionUser' :: AgentClient -> UserId -> ConnId -> UserId -> AM ()
 changeConnectionUser' c oldUserId connId newUserId = do
@@ -758,15 +765,7 @@ changeConnectionUser' c oldUserId connId newUserId = do
   where
     updateConn = withStore' c $ \db -> setConnUserId db oldUserId connId newUserId
 
-newConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, ConnectionRequestUri c)
-newConnSrv c userId connId hasNewConn enableNtfs cMode clientData pqInitKeys subMode srv = do
-  connId' <-
-    if hasNewConn
-      then pure connId
-      else newConnNoQueues c userId connId enableNtfs cMode (CR.connPQEncryption pqInitKeys)
-  newRcvConnSrv c userId connId' enableNtfs cMode clientData pqInitKeys subMode srv
-
-newRcvConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, ConnectionRequestUri c)
+newRcvConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnectionRequestUri c)
 newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srvWithAuth@(ProtoServerWithAuth srv _) = do
   case (cMode, pqInitKeys) of
     (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv"
@@ -782,12 +781,12 @@ newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv
     atomically $ sendNtfSubCommand ns (NSCCreate, [connId])
   let crData = ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData
   case cMode of
-    SCMContact -> pure (connId, CRContactUri crData)
+    SCMContact -> pure $ CRContactUri crData
     SCMInvitation -> do
       g <- asks random
       (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) (CR.initialPQEncryption pqInitKeys)
       withStore' c $ \db -> createRatchetX3dhKeys db connId pk1 pk2 pKem
-      pure (connId, CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange)
+      pure $ CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange
 
 newConnToJoin :: forall c. AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> PQSupport -> AM ConnId
 newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of
@@ -807,16 +806,24 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of
           cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
       withStore c $ \db -> createNewConn db g cData SCMInvitation
 
-joinConn :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (ConnId, SndQueueSecured)
-joinConn c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode = do
+newConnToAccept :: AgentClient -> ConnId -> Bool -> ConfirmationId -> PQSupport -> AM ConnId
+newConnToAccept c connId enableNtfs invId pqSup = do
+  Invitation {connReq, contactConnId} <- withStore c (`getInvitation` invId)
+  withStore c (`getConn` contactConnId) >>= \case
+    SomeConn _ (ContactConnection ConnData {userId} _) ->
+      newConnToJoin c userId connId enableNtfs connReq pqSup
+    _ -> throwE $ CMD PROHIBITED "newConnToAccept"
+
+joinConn :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured
+joinConn c userId connId enableNtfs cReq cInfo pqSupport subMode = do
   srv <- case cReq of
     CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ ->
       getNextServer c userId [qServer q]
     _ -> getSMPServer c userId
-  joinConnSrv c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode srv
+  joinConnSrv c userId connId enableNtfs cReq cInfo pqSupport subMode srv
 
-startJoinInvitation :: UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, NewSndQueue, C.PublicKeyX25519, CR.Ratchet 'C.X448, CR.SndE2ERatchetParams 'C.X448)
-startJoinInvitation userId connId sq_ enableNtfs cReqUri pqSup =
+startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448)
+startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
   lift (compatibleInvitationUri cReqUri) >>= \case
     Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_), Compatible connAgentVersion) -> do
       g <- asks random
@@ -829,11 +836,14 @@ startJoinInvitation userId connId sq_ enableNtfs cReqUri pqSup =
           rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams
       -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out
       -- e2ePubKey is always present, it's Maybe historically
-      (q, e2ePubKey) <- case sq_ of
-        Just sq@SndQueue {e2ePubKey = Just k} -> pure ((sq :: SndQueue) {dbQueueId = DBNewQueue}, k)
-        _ -> lift $ newSndQueue userId "" qInfo
+      q <- case sq_ of
+        Just sq@SndQueue {e2ePubKey = Just _k} -> pure (sq :: SndQueue) {dbQueueId = DBNewQueue}
+        _ -> lift $ fst <$> newSndQueue userId "" qInfo
       let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
-      pure (cData, q, e2ePubKey, rc, e2eSndParams)
+      sq' <- withStore c $ \db -> runExceptT $ do
+        liftIO $ createRatchet db connId rc
+        maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_
+      pure (cData, sq', e2eSndParams)
     Nothing -> throwE $ AGENT A_VERSION
 
 connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport))
@@ -866,34 +876,25 @@ versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport
 versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_
 {-# INLINE versionPQSupport_ #-}
 
-joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, SndQueueSecured)
-joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv =
+joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured
+joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv =
   withInvLock c (strEncode inv) "joinConnSrv" $ do
-    (cData, q, _, rc, e2eSndParams) <- startJoinInvitation userId connId Nothing enableNtfs inv pqSup
-    g <- asks random
-    (connId', sq) <- withStore c $ \db -> runExceptT $ do
-      r@(connId', _) <-
-        if hasNewConn
-          then (connId,) <$> ExceptT (updateNewConnSnd db connId q)
-          else ExceptT $ createSndConn db g cData q
-      liftIO $ createRatchet db connId' rc
-      pure r
-    let cData' = (cData :: ConnData) {connId = connId'}
-    -- joinConnSrv is only used on user interaction, and its failure is permanent,
-    -- otherwise we would need to manage retries here to avoid SndQueue recreated with a different key,
-    -- similar to how joinConnAsync does that.
-    tryError (secureConfirmQueue c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case
-      Right sqSecured -> pure (connId', sqSecured)
-      Left e -> do
-        -- possible improvement: recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md
-        void $ withStore' c $ \db -> deleteConn db Nothing connId'
-        throwE e
-joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv =
+    SomeConn cType conn <- withStore c (`getConn` connId)
+    case conn of
+      NewConnection _ -> doJoin Nothing
+      SndConnection _ sq -> doJoin $ Just sq
+      _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType
+  where
+    doJoin :: Maybe SndQueue -> AM SndQueueSecured
+    doJoin sq_ = do
+      (cData, sq, e2eSndParams) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup
+      secureConfirmQueue c cData sq srv cInfo (Just e2eSndParams) subMode
+joinConnSrv c userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv =
   lift (compatibleContactUri cReqUri) >>= \case
     Just (qInfo, vrsn) -> do
-      (connId', cReq) <- newConnSrv c userId connId hasNewConn enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv
-      void $ sendInvitation c userId connId' qInfo vrsn cReq cInfo
-      pure (connId', False)
+      cReq <- newRcvConnSrv c userId connId enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv
+      void $ sendInvitation c userId connId qInfo vrsn cReq cInfo
+      pure False
     Nothing -> throwE $ AGENT A_VERSION
 
 joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured
@@ -906,11 +907,8 @@ joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSuppo
   where
     doJoin :: Maybe SndQueue -> AM SndQueueSecured
     doJoin sq_ = do
-      (cData, sq, _, rc, e2eSndParams) <- startJoinInvitation userId connId sq_ enableNtfs inv pqSupport
-      sq' <- withStore c $ \db -> runExceptT $ do
-        liftIO $ createRatchet db connId rc
-        maybe (ExceptT $ updateNewConnSnd db connId sq) pure sq_
-      secureConfirmQueueAsync c cData sq' srv cInfo (Just e2eSndParams) subMode
+      (cData, sq, e2eSndParams) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSupport
+      secureConfirmQueueAsync c cData sq srv cInfo (Just e2eSndParams) subMode
 joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _pqSupport _srv = do
   throwE $ CMD PROHIBITED "joinConnSrvAsync"
 
@@ -938,13 +936,13 @@ allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConne
     _ -> throwE $ CMD PROHIBITED "allowConnection"
 
 -- | Accept contact (ACPT command) in Reader monad
-acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (ConnId, SndQueueSecured)
+acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured
 acceptContact' c connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do
   Invitation {contactConnId, connReq} <- withStore c (`getInvitation` invId)
   withStore c (`getConn` contactConnId) >>= \case
     SomeConn _ (ContactConnection ConnData {userId} _) -> do
       withStore' c $ \db -> acceptInvitation db invId ownConnInfo
-      joinConn c userId connId False enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do
+      joinConn c userId connId enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do
         withStore' c (`unacceptInvitation` invId)
         throwE err
     _ -> throwE $ CMD PROHIBITED "acceptContact"
@@ -1171,7 +1169,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
         NEW enableNtfs (ACM cMode) pqEnc subMode -> noServer $ do
           usedSrvs <- newTVarIO ([] :: [SMPServer])
           tryCommand . withNextSrv c userId usedSrvs [] $ \srv -> do
-            (_, cReq) <- newRcvConnSrv c userId connId enableNtfs cMode Nothing pqEnc subMode srv
+            cReq <- newRcvConnSrv c userId connId enableNtfs cMode Nothing pqEnc subMode srv
             notify $ INV (ACR cMode cReq)
         JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do
           let initUsed = [qServer q]
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 075b40f10..86a6651f4 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -12,6 +12,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -246,7 +247,9 @@ createConnection :: AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe
 createConnection c userId enableNtfs cMode clientData = A.createConnection c userId enableNtfs cMode clientData (IKNoPQ PQSupportOn)
 
 joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
-joinConnection c userId enableNtfs cReq connInfo = A.joinConnection c userId Nothing enableNtfs cReq connInfo PQSupportOn
+joinConnection c userId enableNtfs cReq connInfo subMode = do
+  connId <- A.prepareConnectionToJoin c userId enableNtfs cReq PQSupportOn
+  (connId,) <$> A.joinConnection c userId connId enableNtfs cReq connInfo PQSupportOn subMode
 
 sendMessage :: AgentClient -> ConnId -> SMP.MsgFlags -> MsgBody -> AE AgentMsgId
 sendMessage c connId msgFlags msgBody = do
@@ -605,7 +608,8 @@ runAgentClientTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (AgentClient,
 runAgentClientTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId =
   runRight_ $ do
     (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing aPQ SMSubscribe
-    (aliceId, sqSecured') <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" bPQ SMSubscribe
+    aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
+    sqSecured' <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
     liftIO $ sqSecured' `shouldBe` sqSecured
     ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
     liftIO $ pqSup' `shouldBe` CR.connPQEncryption aPQ
@@ -807,13 +811,12 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b
   runRight_ $ do
     (_, qInfo) <- A.createConnection alice 1 True SCMContact Nothing aPQ SMSubscribe
     aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
-    (aliceId', sqSecuredJoin) <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" bPQ SMSubscribe
-    liftIO $ do
-      aliceId' `shouldBe` aliceId
-      sqSecuredJoin `shouldBe` False -- joining via contact address connection
+    sqSecuredJoin <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
+    liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
     ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
     liftIO $ pqSup' `shouldBe` reqPQSupport
-    (bobId, sqSecured') <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
+    bobId <- A.prepareConnectionToAccept alice True invId (CR.connPQEncryption aPQ)
+    sqSecured' <- acceptContact alice bobId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
     liftIO $ sqSecured' `shouldBe` sqSecured
     ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get bob
     liftIO $ pqSup'' `shouldBe` bPQ
@@ -859,13 +862,12 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId
     msgId = subtract baseId . fst
     connectViaContact b pq qInfo = do
       aId <- A.prepareConnectionToJoin b 1 True qInfo pq
-      (aId', sqSecuredJoin) <- A.joinConnection b 1 (Just aId) True qInfo "bob's connInfo" pq SMSubscribe
-      liftIO $ do
-        aId' `shouldBe` aId
-        sqSecuredJoin `shouldBe` False -- joining via contact address connection
+      sqSecuredJoin <- A.joinConnection b 1 aId True qInfo "bob's connInfo" pq SMSubscribe
+      liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
       ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
       liftIO $ pqSup' `shouldBe` PQSupportOn
-      (bId, sqSecuredAccept) <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
+      bId <- A.prepareConnectionToAccept alice True invId (CR.connPQEncryption aPQ)
+      sqSecuredAccept <- acceptContact alice bId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
       liftIO $ sqSecuredAccept `shouldBe` False -- agent cfg is v8
       ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get b
       liftIO $ pqSup'' `shouldBe` pq
@@ -906,10 +908,8 @@ testRejectContactRequest =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     (addrConnId, qInfo) <- A.createConnection alice 1 True SCMContact Nothing IKPQOn SMSubscribe
     aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
-    (aliceId', sqSecured) <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" PQSupportOn SMSubscribe
-    liftIO $ do
-      aliceId' `shouldBe` aliceId
-      sqSecured `shouldBe` False -- joining via contact address connection
+    sqSecured <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+    liftIO $ sqSecured `shouldBe` False -- joining via contact address connection
     ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get alice
     liftIO $ runExceptT (rejectContact alice "abcd" invId) `shouldReturn` Left (CONN NOT_FOUND)
     rejectContact alice addrConnId invId
@@ -922,10 +922,8 @@ testUpdateConnectionUserId =
     newUserId <- createUser alice [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer]
     _ <- changeConnectionUser alice 1 connId newUserId
     aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
-    (aliceId', sqSecured') <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" PQSupportOn SMSubscribe
-    liftIO $ do
-      aliceId' `shouldBe` aliceId
-      sqSecured' `shouldBe` True
+    sqSecured' <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+    liftIO $ sqSecured' `shouldBe` True
     ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
     liftIO $ pqSup' `shouldBe` PQSupportOn
     allowConnection alice connId confId "alice's connInfo"
@@ -1763,10 +1761,8 @@ makeConnectionForUsers_ :: HasCallStack => PQSupport -> SndQueueSecured -> Agent
 makeConnectionForUsers_ pqSupport sqSecured alice aliceUserId bob bobUserId = do
   (bobId, qInfo) <- A.createConnection alice aliceUserId True SCMInvitation Nothing (CR.IKNoPQ pqSupport) SMSubscribe
   aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport
-  (aliceId', sqSecured') <- A.joinConnection bob bobUserId (Just aliceId) True qInfo "bob's connInfo" pqSupport SMSubscribe
-  liftIO $ do
-    aliceId' `shouldBe` aliceId
-    sqSecured' `shouldBe` sqSecured
+  sqSecured' <- A.joinConnection bob bobUserId aliceId True qInfo "bob's connInfo" pqSupport SMSubscribe
+  liftIO $ sqSecured' `shouldBe` sqSecured
   ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
   liftIO $ pqSup' `shouldBe` pqSupport
   allowConnection alice bobId confId "alice's connInfo"
@@ -2010,7 +2006,7 @@ pattern SentB :: AgentMsgId -> Either AgentErrorType (AgentMsgId, PQEncryption)
 pattern SentB msgId <- Right (msgId, PQEncOn)
 
 receiveMsg :: AgentClient -> ConnId -> AgentMsgId -> MsgBody -> ExceptT AgentErrorType IO ()
-receiveMsg c cId msgId msg  = do
+receiveMsg c cId msgId msg = do
   get c =##> \case ("", cId', Msg' mId' PQEncOn msg') -> cId' == cId && mId' == msgId && msg' == msg; _ -> False
   ackMessage c cId msgId Nothing
 
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index e3b3e6fc6..75f1f46b3 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -35,7 +35,7 @@ import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
-import Simplex.Messaging.Protocol (EncRcvMsgBody (..), MsgBody, RcvMessage (..), SubscriptionMode (..), pattern NoEntity, maxMessageLength, noMsgFlags)
+import Simplex.Messaging.Protocol (EncRcvMsgBody (..), MsgBody, RcvMessage (..), SubscriptionMode (..), maxMessageLength, noMsgFlags, pattern NoEntity)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Transport
@@ -210,7 +210,8 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b
   withAgent 1 aCfg (servers aTestCfg) testDB $ \alice ->
     withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do
       (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
-      (aliceId, sqSecured) <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+      aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
+      sqSecured <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
       liftIO $ sqSecured `shouldBe` True
       ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
       liftIO $ pqSup' `shouldBe` PQSupportOn
@@ -265,7 +266,8 @@ agentDeliverMessagesViaProxyConc agentServers msgs =
     -- otherwise the CONF messages would get mixed with MSG
     prePair alice bob = do
       (bobId, qInfo) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
-      (aliceId, sqSecured) <- runExceptT' $ A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+      aliceId <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
+      sqSecured <- runExceptT' $ A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
       liftIO $ sqSecured `shouldBe` True
       confId <-
         get alice >>= \case
@@ -315,7 +317,8 @@ agentViaProxyVersionError =
     Left (A.BROKER _ (TRANSPORT TEVersion)) <-
       withAgent 2 agentCfg (servers [SMPServer testHost testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do
         (_bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
-        A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+        aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
+        A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
     pure ()
   where
     servers srvs = (initAgentServersProxy SPMUnknown SPFProhibit) {smp = userServers srvs}
@@ -334,7 +337,8 @@ agentViaProxyRetryOffline = do
       withServer $ \_ -> do
         (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do
           (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
-          (aliceId, sqSecured) <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+          aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
+          sqSecured <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
           liftIO $ sqSecured `shouldBe` True
           ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
           liftIO $ pqSup' `shouldBe` PQSupportOn

From 887044283079b91f5d1ce84372a7e1a5c31c379b Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 11 Oct 2024 12:13:52 +0100
Subject: [PATCH 158/195] smp server: reject SKEY with different key earlier
 (at verification step), add tests (#1366)

---
 src/Simplex/Messaging/Server.hs |  2 +-
 tests/ServerTests.hs            | 65 +++++++++++++++++++++++++++++++++
 2 files changed, 66 insertions(+), 1 deletion(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 8cdf55e8b..d6fb3aa03 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -944,7 +944,7 @@ verifyTransmission auth_ tAuth authorized queueId cmd =
     Cmd SRecipient (NEW k _ _ _ _) -> pure $ Nothing `verifiedWith` k
     Cmd SRecipient _ -> verifyQueue (\q -> Just q `verifiedWith` recipientKey q) <$> get SRecipient
     -- SEND will be accepted without authorization before the queue is secured with KEY or SKEY command
-    Cmd SSender (SKEY k) -> verifyQueue (\q -> Just q `verifiedWith` k) <$> get SSender
+    Cmd SSender (SKEY k) -> verifyQueue (\q -> if maybe True (k ==) (senderKey q) then Just q `verifiedWith` k else dummyVerify) <$> get SSender
     Cmd SSender SEND {} -> verifyQueue (\q -> Just q `verified` maybe (isNothing tAuth) verify (senderKey q)) <$> get SSender
     Cmd SSender PING -> pure $ VRVerified Nothing
     Cmd SSender RFWD {} -> pure $ VRVerified Nothing
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index d1ba7c67f..d66f7363f 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -51,6 +51,9 @@ serverTests t@(ATransport t') = do
   describe "SMP syntax" $ syntaxTests t
   describe "SMP queues" $ do
     describe "NEW and KEY commands, SEND messages" $ testCreateSecure t
+    describe "NEW and SKEY commands" $ do
+      testCreateSndSecure t
+      testSndSecureProhibited t
     describe "NEW, OFF and DEL commands, SEND messages" $ testCreateDelete t
     describe "Stress test" $ stressTest t
     describe "allowNewQueues setting" $ testAllowNewQueues t'
@@ -193,6 +196,68 @@ testCreateSecure (ATransport t) =
       Resp "bcda" _ (ERR LARGE_MSG) <- signSendRecv s sKey ("bcda", sId, _SEND biggerMessage)
       pure ()
 
+testCreateSndSecure :: ATransport -> Spec
+testCreateSndSecure (ATransport t) =
+  it "should create (NEW) and secure (SKEY) queue by sender" $
+    smpTest2 t $ \r s -> do
+      g <- C.newRandom
+      (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+      (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv r rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe True)
+      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
+      (rId1, NoEntity) #== "creates queue"
+
+      (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+      Resp "bcda" _ err2 <- sendRecv s (sampleSig, "bcda", sId, SKEY sPub)
+      (err2, ERR AUTH) #== "rejects SKEY with wrong signature"
+
+      Resp "cdab" _ err3 <- signSendRecv s sKey ("cdab", rId, SKEY sPub)
+      (err3, ERR AUTH) #== "rejects SKEY with recipients's ID"
+
+      Resp "dabc" sId2 OK <- signSendRecv s sKey ("dabc", sId, SKEY sPub)
+      (sId2, sId) #== "secures queue, same queue ID in response"
+
+      (sPub', _) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+      Resp "abcd" _ err4 <- signSendRecv s sKey ("abcd", sId, SKEY sPub')
+      (err4, ERR AUTH) #== "rejects if secured with different key"
+      Resp "abcd" _ OK <- signSendRecv s sKey ("abcd", sId, SKEY sPub)
+
+      Resp "bcda" _ ok3 <- signSendRecv s sKey ("bcda", sId, _SEND "hello")
+      (ok3, OK) #== "accepts signed SEND"
+
+      Resp "" _ (Msg mId2 msg2) <- tGet1 r
+      (dec mId2 msg2, Right "hello") #== "delivers message"
+
+      Resp "cdab" _ ok5 <- signSendRecv r rKey ("cdab", rId, ACK mId2)
+      (ok5, OK) #== "replies OK when message acknowledged"
+
+      Resp "dabc" _ err5 <- sendRecv s ("", "dabc", sId, _SEND "hello")
+      (err5, ERR AUTH) #== "rejects unsigned SEND"
+
+      let maxAllowedMessage = B.replicate (maxMessageLength currentClientSMPRelayVersion) '-'
+      Resp "bcda" _ OK <- signSendRecv s sKey ("bcda", sId, _SEND maxAllowedMessage)
+      Resp "" _ (Msg mId3 msg3) <- tGet1 r
+      (dec mId3 msg3, Right maxAllowedMessage) #== "delivers message of max size"
+
+      let biggerMessage = B.replicate (maxMessageLength currentClientSMPRelayVersion + 1) '-'
+      Resp "bcda" _ (ERR LARGE_MSG) <- signSendRecv s sKey ("bcda", sId, _SEND biggerMessage)
+      pure ()
+
+testSndSecureProhibited :: ATransport -> Spec
+testSndSecureProhibited (ATransport t) =
+  it "should create (NEW) without allowing sndSecure and fail to and secure queue by sender (SKEY)" $
+    smpTest2 t $ \r s -> do
+      g <- C.newRandom
+      (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+      (dhPub, _dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      Resp "abcd" rId1 (Ids _rId sId _srvDh) <- signSendRecv r rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
+      (rId1, NoEntity) #== "creates queue"
+
+      (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+      Resp "dabc" sId2 err <- signSendRecv s sKey ("dabc", sId, SKEY sPub)
+      (sId2, sId) #== "secures queue, same queue ID in response"
+      (err, ERR AUTH) #== "rejects SKEY when not allowed in NEW command"
+
 testCreateDelete :: ATransport -> Spec
 testCreateDelete (ATransport t) =
   it "should create (NEW), suspend (OFF) and delete (DEL) queue" $

From c9af7e327eadb481d95213cc536cada2e0773b86 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Fri, 11 Oct 2024 14:49:15 +0300
Subject: [PATCH 159/195] smp server: graceful shutdown on SIGINT (#1360)

* smp-server: graceful shutdown on SIGINT

* .501

* clean up

* remove version

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
---
 apps/smp-server/web/Static.hs        | 10 ++++++----
 src/Simplex/Messaging/Server.hs      | 21 ++++++++++++++++++++-
 src/Simplex/Messaging/Server/Main.hs |  6 +++++-
 3 files changed, 31 insertions(+), 6 deletions(-)

diff --git a/apps/smp-server/web/Static.hs b/apps/smp-server/web/Static.hs
index 342b4ae33..c4a3e84f7 100644
--- a/apps/smp-server/web/Static.hs
+++ b/apps/smp-server/web/Static.hs
@@ -42,23 +42,22 @@ serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams}
     WT.runTLS (WT.tlsSettings cert key) (mkSettings port) app
   where
     app = staticFiles webStaticPath
-    mkSettings port = W.setPort port W.defaultSettings
+    mkSettings port = W.setPort port warpSettings
 
 -- | Prepare context and prepare HTTP handler for TLS connections that already passed TLS.handshake and ALPN check.
 attachStaticFiles :: FilePath -> (AttachHTTP -> IO ()) -> IO ()
 attachStaticFiles path action =
   -- Initialize global internal state for http server.
-  WI.withII settings $ \ii -> do
+  WI.withII warpSettings $ \ii -> do
     action $ \socket cxt -> do
       -- Initialize internal per-connection resources.
       addr <- getPeerName socket
       withConnection addr cxt $ \(conn, transport) ->
         withTimeout ii conn $ \th ->
           -- Run Warp connection handler to process HTTP requests for static files.
-          WI.serveConnection conn ii th addr transport settings app
+          WI.serveConnection conn ii th addr transport warpSettings app
   where
     app = staticFiles path
-    settings = W.defaultSettings
     -- from warp-tls
     withConnection socket cxt = bracket (WT.attachConn socket cxt) (terminate . fst)
     -- from warp
@@ -69,6 +68,9 @@ attachStaticFiles path action =
     -- shared clean up
     terminate conn = WI.connClose conn `finally` (readIORef (WI.connWriteBuffer conn) >>= WI.bufFree)
 
+warpSettings :: W.Settings
+warpSettings = W.setGracefulShutdownTimeout (Just 1) W.defaultSettings
+
 staticFiles :: FilePath -> Application
 staticFiles root = S.staticApp settings
   where
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index d6fb3aa03..fd80c86c5 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -53,6 +53,7 @@ import qualified Data.ByteString.Builder as BLD
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Dynamic (toDyn)
 import Data.Either (fromRight, partitionEithers)
 import Data.Functor (($>))
 import Data.IORef
@@ -71,6 +72,7 @@ import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Type.Equality
 import Data.Typeable (cast)
+import GHC.Conc.Signal
 import GHC.IORef (atomicSwapIORef)
 import GHC.Stats (getRTSStats)
 import GHC.TypeLits (KnownNat)
@@ -149,9 +151,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
         : sendPendingEvtsThread s
         : receiveFromProxyAgent pa
         : expireNtfsThread cfg
+        : sigIntHandlerThread
         : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
     )
-    `finally` withLock' (savingLock s) "final" (saveServer False >> closeServer)
+    `finally` stopServer s
   where
     runServer :: (ServiceName, ATransport, AddHTTP) -> M ()
     runServer (tcpPort, ATransport t, addHTTP) = do
@@ -175,6 +178,22 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
           runTransportServerState ss started tcpPort defaultSupportedParams smpCreds (Just supportedSMPHandshakes) tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
     fromTLSCredentials (_, pk) = C.x509ToPrivate (pk, []) >>= C.privKey
 
+    sigIntHandlerThread :: M ()
+    sigIntHandlerThread = do
+      flagINT <- newEmptyTMVarIO
+      let sigINT = 2 -- CONST_SIGINT value
+          sigIntAction = \_ptr -> atomically $ void $ tryPutTMVar flagINT ()
+          sigIntHandler = Just (sigIntAction, toDyn ())
+      void $ liftIO $ setHandler sigINT sigIntHandler
+      atomically $ readTMVar flagINT
+      logInfo "Received SIGINT, stopping server..."
+
+    stopServer :: Server -> M ()
+    stopServer s = do
+      logInfo "Saving server state..."
+      withLock' (savingLock s) "final" $ saveServer False >> closeServer
+      logInfo "Server stopped"
+
     saveServer :: Bool -> M ()
     saveServer keepMsgs = withLog closeStoreLog >> saveServerMessages keepMsgs >> saveServerNtfs >> saveServerStats
 
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 33e275862..685b28048 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -14,6 +14,7 @@
 module Simplex.Messaging.Server.Main where
 
 import Control.Concurrent.STM
+import Control.Exception (finally)
 import Control.Logger.Simple
 import Control.Monad
 import Data.ByteString.Char8 (ByteString)
@@ -280,13 +281,16 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       case webStaticPath' of
         Just path | sharedHTTP -> do
           runWebServer path Nothing ServerInformation {config, information}
-          attachStaticFiles path $ \attachHTTP -> runSMPServer cfg $ Just attachHTTP
+          attachStaticFiles path $ \attachHTTP -> do
+            logDebug "Allocated web server resources"
+            runSMPServer cfg (Just attachHTTP) `finally` logDebug "Releasing web server resources..."
         Just path -> do
           runWebServer path webHttpsParams' ServerInformation {config, information}
           runSMPServer cfg Nothing
         Nothing -> do
           logWarn "No server static path set"
           runSMPServer cfg Nothing
+      logDebug "Bye"
       where
         enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
         logStats = settingIsOn "STORE_LOG" "log_stats" ini

From c41bfe831d6d3fdf068f7419cbfed6afa46cb5b5 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Fri, 11 Oct 2024 13:01:12 +0100
Subject: [PATCH 160/195] 6.1.0.7: changelog for v6.1.0

---
 CHANGELOG.md    | 29 +++++++++++++++++++++++++++++
 package.yaml    |  2 +-
 simplexmq.cabal |  2 +-
 3 files changed, 31 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 18a42b791..635faf061 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,32 @@
+# 6.1.0
+
+SMP server and client:
+- transport block encryption (#1317).
+
+Agent:
+- batch and optimize iOS notifications processing (#1308, #1311, #1313, #1316, #1330, #1331, #1333, #1337, #1346).
+- allow receiving multiple messages from single iOS notification (#1355, #1362).
+- prepare connection to accept to avoid race condition with events (#1365).
+- transport isolation mode "Session" (default) to use new SOCKS credentials when client restarts or SOCKS proxy configuration changes (#1321).
+
+Ntf server:
+- control port (#1354).
+- enable pings on ntf subscriptions, to resubscribe on reconnection (#1353).
+
+SMP server:
+- support multiple server ports (#1319).
+- support serving HTTPS and SMP transport on the same port (#1326, #1327).
+- persist iOS notifications to avoid losing them when Ntf server is offline (#1336, #1339, #1350).
+- fix lost notification subscriptions (#1347).
+- reject SKEY with different key earlier, at verification step (#1366).
+- pass server information via CLI during server initialization (#1356).
+- show version on server page (#1341).
+- explicit graceful shutdown on SIGINT (#1360).
+
+XRCP (remote access protocol):
+- use SHA3-256 in hybrid key agreement (#1302).
+- session encryption with forward secrecy (#1328).
+
 # 6.0.5
 
 SMP agent:
diff --git a/package.yaml b/package.yaml
index 06b05a6f4..79ee06bdc 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.1.0.6
+version: 6.1.0.7
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index a639495c1..d73277fb2 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.1.0.6
+version:        6.1.0.7
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 1d0a418011293e681abc983e6cb55ede5b4ae636 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sat, 12 Oct 2024 17:12:45 +0100
Subject: [PATCH 161/195] rfc: rename file

---
 ...1-smp-message-storage.md => 2024-09-01-smp-message-storage.md} | 0
 1 file changed, 0 insertions(+), 0 deletions(-)
 rename rfcs/{2021-09-01-smp-message-storage.md => 2024-09-01-smp-message-storage.md} (100%)

diff --git a/rfcs/2021-09-01-smp-message-storage.md b/rfcs/2024-09-01-smp-message-storage.md
similarity index 100%
rename from rfcs/2021-09-01-smp-message-storage.md
rename to rfcs/2024-09-01-smp-message-storage.md

From 7b6c86c6c1093cdae5ad2ee566655828076bc25c Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 13 Oct 2024 22:02:57 +0100
Subject: [PATCH 162/195] docs: correction

---
 protocol/xftp.md                       | 8 +++++---
 rfcs/done/2023-10-25-remote-control.md | 2 +-
 2 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/protocol/xftp.md b/protocol/xftp.md
index d6d271837..bd1d9e664 100644
--- a/protocol/xftp.md
+++ b/protocol/xftp.md
@@ -559,11 +559,13 @@ In current implementation of XFTP protocol in SimpleX Chat clients don't use FAC
 
  - perform traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers.
 
- - observe how much traffic is being sent, and make guesses as to its purpose
+ - observe how much traffic is being sent, and make guesses as to its purpose.
 
-*cannot, even in case of a compromised transport protocol:*
+ - in case of a compromised transport protocol, correlate file senders and receivers.
 
- - perform traffic correlation attacks with any increase in efficiency over a non-compromised transport protocol
+*cannot, in case of a non-compromised transport protocol:*
+
+ - perform traffic correlation attacks.
 
 #### XFTP server
 
diff --git a/rfcs/done/2023-10-25-remote-control.md b/rfcs/done/2023-10-25-remote-control.md
index 444185307..8507dba49 100644
--- a/rfcs/done/2023-10-25-remote-control.md
+++ b/rfcs/done/2023-10-25-remote-control.md
@@ -53,7 +53,7 @@ The session invitation contains this data:
 - CA TLS certificate fingerprint of the controller - this is part of long term identity of the controller established during the first session, and repeated in the subsequent session announcements.
 - Session Ed25519 public key used to verify the announcement and commands - this mitigates the compromise of the long term signature key, as the controller will have to sign each command with this key first.
 - Long-term Ed25519 public key used to verify the announcement and commands - this is part of the long term controller identity.
-- Session X25519 DH key and sntrup761 KEM encapsulation key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. These DH public key and KEM encapsulation key are always sent unencrypted. NaCL Cryptobox is used for encryption.
+- Session X25519 DH key and sntrup761 KEM encapsulation key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. This DH public key is always sent unencrypted. NaCL Cryptobox is used for encryption.
 
 Host device decrypts (except the first session) and validates the invitation:
 - Session signature is valid.

From e0cd28a65aea3088491b382c735b5260913345d7 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 18 Oct 2024 09:12:59 +0100
Subject: [PATCH 163/195] smp server: stop server faster (#1371)

* smp server: stop server faster

* .702

* asks

* fix leak

* kill client when server stopped

* remove version

* fix version
---
 src/Simplex/Messaging/Server.hs           | 56 +++++++++++++----------
 src/Simplex/Messaging/Server/Env/STM.hs   |  8 ++--
 src/Simplex/Messaging/Transport/Server.hs |  4 +-
 3 files changed, 39 insertions(+), 29 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index fd80c86c5..29de4ff6d 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -160,7 +160,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
     runServer (tcpPort, ATransport t, addHTTP) = do
       smpCreds <- asks tlsServerCreds
       httpCreds_ <- asks httpServerCreds
-      ss <- asks sockets
+      ss <- liftIO newSocketState
+      asks sockets >>= atomically . (`modifyTVar'` ((tcpPort, ss) :))
       serverSignKey <- either fail pure $ fromTLSCredentials smpCreds
       env <- ask
       liftIO $ case (httpCreds_, attachHTTP_) of
@@ -190,6 +191,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
 
     stopServer :: Server -> M ()
     stopServer s = do
+      asks serverActive >>= atomically . (`writeTVar` False)
       logInfo "Saving server state..."
       withLock' (savingLock s) "final" $ saveServer False >> closeServer
       logInfo "Server stopped"
@@ -657,25 +659,28 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
 #else
                 hPutStrLn h "Not available on GHC 8.10"
 #endif
-              CPSockets -> withUserRole $ do
-                (accepted', closed', active') <- unliftIO u $ asks sockets
-                (accepted, closed, active) <- (,,) <$> readTVarIO accepted' <*> readTVarIO closed' <*> readTVarIO active'
-                hPutStrLn h "Sockets: "
-                hPutStrLn h $ "accepted: " <> show accepted
-                hPutStrLn h $ "closed: " <> show closed
-                hPutStrLn h $ "active: " <> show (IM.size active)
-                hPutStrLn h $ "leaked: " <> show (accepted - closed - IM.size active)
+              CPSockets -> withUserRole $ unliftIO u (asks sockets) >>= readTVarIO >>= mapM_ putSockets
+                where
+                  putSockets (tcpPort, (accepted', closed', active')) = do
+                    (accepted, closed, active) <- (,,) <$> readTVarIO accepted' <*> readTVarIO closed' <*> readTVarIO active'
+                    hPutStrLn h $ "Sockets for port " <> tcpPort <> ":"
+                    hPutStrLn h $ "accepted: " <> show accepted
+                    hPutStrLn h $ "closed: " <> show closed
+                    hPutStrLn h $ "active: " <> show (IM.size active)
+                    hPutStrLn h $ "leaked: " <> show (accepted - closed - IM.size active)
               CPSocketThreads -> withAdminRole $ do
 #if MIN_VERSION_base(4,18,0)
-                (_, _, active') <- unliftIO u $ asks sockets
-                active <- readTVarIO active'
-                forM_ (IM.toList active) $ \(sid, tid') ->
-                  deRefWeak tid' >>= \case
-                    Nothing -> hPutStrLn h $ intercalate "," [show sid, "", "gone", ""]
-                    Just tid -> do
-                      label <- threadLabel tid
-                      status <- threadStatus tid
-                      hPutStrLn h $ intercalate "," [show sid, show tid, show status, fromMaybe "" label]
+                unliftIO u (asks sockets) >>= readTVarIO >>= mapM_ putSocketThreads
+                where
+                  putSocketThreads (tcpPort, (_, _, active')) = do
+                    active <- readTVarIO active'
+                    forM_ (IM.toList active) $ \(sid, tid') ->
+                      deRefWeak tid' >>= \case
+                        Nothing -> hPutStrLn h $ intercalate "," [tcpPort, show sid, "", "gone", ""]
+                        Just tid -> do
+                          label <- threadLabel tid
+                          status <- threadStatus tid
+                          hPutStrLn h $ intercalate "," [tcpPort, show sid, show tid, show status, fromMaybe "" label]
 #else
                 hPutStrLn h "Not available on GHC 8.10"
 #endif
@@ -830,12 +835,13 @@ clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, connecte
   subs <- atomically $ swapTVar subscriptions M.empty
   ntfSubs <- atomically $ swapTVar ntfSubscriptions M.empty
   liftIO $ mapM_ cancelSub subs
-  Server {subscribers, notifiers, subClients, ntfSubClients} <- asks server
-  liftIO $ updateSubscribers subs subscribers
-  liftIO $ updateSubscribers ntfSubs notifiers
-  asks clients >>= atomically . (`modifyTVar'` IM.delete clientId)
-  atomically $ modifyTVar' subClients $ IM.delete clientId
-  atomically $ modifyTVar' ntfSubClients $ IM.delete clientId
+  whenM (asks serverActive >>= readTVarIO) $ do
+    Server {subscribers, notifiers, subClients, ntfSubClients} <- asks server
+    liftIO $ updateSubscribers subs subscribers
+    liftIO $ updateSubscribers ntfSubs notifiers
+    asks clients >>= atomically . (`modifyTVar'` IM.delete clientId)
+    atomically $ modifyTVar' subClients $ IM.delete clientId
+    atomically $ modifyTVar' ntfSubClients $ IM.delete clientId
   tIds <- atomically $ swapTVar endThreads IM.empty
   liftIO $ mapM_ (mapM_ killThread <=< deRefWeak) tIds
   where
@@ -862,8 +868,10 @@ cancelSub s = case subThread s of
 receive :: Transport c => THandleSMP c 'TServer -> Client -> M ()
 receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
+  sa <- asks serverActive
   forever $ do
     ts <- L.toList <$> liftIO (tGet h)
+    unlessM (readTVarIO sa) $ throwIO $ userError "server stopped"
     atomically . (writeTVar rcvActiveAt $!) =<< liftIO getSystemTime
     stats <- asks serverStats
     (errs, cmds) <- partitionEithers <$> mapM (cmdAction stats) ts
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index a485ab73e..debd36c12 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -138,6 +138,7 @@ defaultProxyClientConcurrency = 32
 
 data Env = Env
   { config :: ServerConfig,
+    serverActive :: TVar Bool,
     serverInfo :: ServerInformation,
     server :: Server,
     serverIdentity :: KeyHash,
@@ -149,7 +150,7 @@ data Env = Env
     tlsServerCreds :: T.Credential,
     httpServerCreds :: Maybe T.Credential,
     serverStats :: ServerStats,
-    sockets :: SocketState,
+    sockets :: TVar [(ServiceName, SocketState)],
     clientSeq :: TVar ClientId,
     clients :: TVar (IntMap (Maybe Client)),
     proxyAgent :: ProxyAgent -- senders served on this proxy
@@ -243,6 +244,7 @@ newProhibitedSub = do
 
 newEnv :: ServerConfig -> IO Env
 newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAgentCfg, information, messageExpiration} = do
+  serverActive <- newTVarIO True
   server <- newServer
   queueStore <- newQueueStore
   msgStore <- newMsgStore
@@ -258,11 +260,11 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAg
   Fingerprint fp <- loadFingerprint smpCredentials
   let serverIdentity = KeyHash fp
   serverStats <- newServerStats =<< getCurrentTime
-  sockets <- newSocketState
+  sockets <- newTVarIO []
   clientSeq <- newTVarIO 0
   clients <- newTVarIO mempty
   proxyAgent <- newSMPProxyAgent smpAgentCfg random
-  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, ntfStore, random, storeLog, tlsServerCreds, httpServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
+  pure Env {serverActive, config, serverInfo, server, serverIdentity, queueStore, msgStore, ntfStore, random, storeLog, tlsServerCreds, httpServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
   where
     getCredentials protocol creds = do
       files <- missingCreds
diff --git a/src/Simplex/Messaging/Transport/Server.hs b/src/Simplex/Messaging/Transport/Server.hs
index fe4bd5879..8913ba0c3 100644
--- a/src/Simplex/Messaging/Transport/Server.hs
+++ b/src/Simplex/Messaging/Transport/Server.hs
@@ -132,7 +132,7 @@ runTCPServerSocket :: SocketState -> TMVar Bool -> IO Socket -> (Socket -> IO ()
 runTCPServerSocket (accepted, gracefullyClosed, clients) started getSocket server =
   E.bracket getSocket (closeServer started clients) $ \sock ->
     forever . E.bracketOnError (safeAccept sock) (close . fst) $ \(conn, _peer) -> do
-      cId <- atomically $ stateTVar accepted $ \cId -> let cId' = cId + 1 in cId `seq` (cId', cId')
+      cId <- atomically $ stateTVar accepted $ \cId -> let cId' = cId + 1 in cId' `seq` (cId', cId')
       let closeConn _ = do
             atomically $ modifyTVar' clients $ IM.delete cId
             gracefulClose conn 5000 `catchAll_` pure () -- catchAll_ is needed here in case the connection was closed earlier
@@ -168,8 +168,8 @@ newSocketState = (,,) <$> newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO mempty
 
 closeServer :: TMVar Bool -> TVar (IntMap (Weak ThreadId)) -> Socket -> IO ()
 closeServer started clients sock = do
-  readTVarIO clients >>= mapM_ (deRefWeak >=> mapM_ killThread)
   close sock
+  readTVarIO clients >>= mapM_ (deRefWeak >=> mapM_ killThread)
   void . atomically $ tryPutTMVar started False
 
 startTCPServer :: TMVar Bool -> Maybe HostName -> ServiceName -> IO Socket

From 77ee9bea38587d53552772eca3466f33837f425b Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 18 Oct 2024 10:13:01 +0100
Subject: [PATCH 164/195] smp protocol: add STORE error (#1372)

---
 src/Simplex/Messaging/Protocol.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index bdc0254b4..3c5ba11cb 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -1198,6 +1198,8 @@ data ErrorType
     CRYPTO
   | -- | SMP queue capacity is exceeded on the server
     QUOTA
+  | -- | SMP server storage error
+    STORE {storeErr :: String}
   | -- | ACK command is sent without message to be acknowledged
     NO_MSG
   | -- | sent message is too large (> maxMessageLength = 16088 bytes)
@@ -1513,6 +1515,7 @@ instance Encoding ErrorType where
     AUTH -> "AUTH"
     CRYPTO -> "CRYPTO"
     QUOTA -> "QUOTA"
+    STORE err -> "STORE " <> smpEncode err
     EXPIRED -> "EXPIRED"
     NO_MSG -> "NO_MSG"
     LARGE_MSG -> "LARGE_MSG"
@@ -1528,6 +1531,7 @@ instance Encoding ErrorType where
       "AUTH" -> pure AUTH
       "CRYPTO" -> pure CRYPTO
       "QUOTA" -> pure QUOTA
+      "STORE" -> STORE <$> _smpP
       "EXPIRED" -> pure EXPIRED
       "NO_MSG" -> pure NO_MSG
       "LARGE_MSG" -> pure LARGE_MSG

From 967afaf802d7ea98480eaf280bfc6f35d4d43f05 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Fri, 18 Oct 2024 12:47:27 +0100
Subject: [PATCH 165/195] 6.1.1.0

---
 CHANGELOG.md    | 8 ++++++++
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 3 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 635faf061..820374afc 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,13 @@
+# 6.1.1
+
+SMP:
+- stop server faster (#1371)
+- add STORE error (#1372)
+
 # 6.1.0
 
+Version 6.1.0.7
+
 SMP server and client:
 - transport block encryption (#1317).
 
diff --git a/package.yaml b/package.yaml
index 79ee06bdc..e679be893 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.1.0.7
+version: 6.1.1.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index d73277fb2..95261aac4 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.1.0.7
+version:        6.1.1.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 0414ea59f00bbf97a98d8c87d8749d21401d90bd Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 21 Oct 2024 11:50:30 +0100
Subject: [PATCH 166/195] smp server: journal message store (#1370)

* smp server: remove STM function from MsgStore

* polymorphic MsgStore

* jourmal storage for messages (WIP)

* more journal, test setup

* writeMsg

* test

* tryDelMsg

* delMsgQueue

* remove MsgStoreClass instance of existential wrapper for Msg stores

* store config

* extract common logic out of store instances

* add store type to config

* open journals, cache last message, tests pass

* CLI commands

* refactor import/export messages

* cli commands to import/export journal message store

* export journal without draining, import/export tests

* journal command

* import/export progress

* better progress info

* only log queue state once when importing

* logs

* handle IO errors in journal store, return as STORE error

* recover from state file errors

* fix message files after crash

* fix messages folder
---
 rfcs/2024-09-01-smp-message-storage.md        |   2 +-
 simplexmq.cabal                               |   3 +
 src/Simplex/FileTransfer/Server/Main.hs       |   4 +-
 src/Simplex/Messaging/Agent/Client.hs         |   3 +-
 src/Simplex/Messaging/Agent/Lock.hs           |   5 +
 .../Messaging/Notifications/Server/Main.hs    |   4 +-
 src/Simplex/Messaging/Protocol.hs             |   2 -
 src/Simplex/Messaging/Server.hs               | 281 ++++-----
 src/Simplex/Messaging/Server/CLI.hs           |   6 +-
 src/Simplex/Messaging/Server/Env/STM.hs       |  51 +-
 src/Simplex/Messaging/Server/Main.hs          | 170 ++++--
 .../Messaging/Server/MsgStore/Journal.hs      | 556 ++++++++++++++++++
 src/Simplex/Messaging/Server/MsgStore/STM.hs  | 187 +++---
 .../Messaging/Server/MsgStore/Types.hs        |  81 +++
 src/Simplex/Messaging/Util.hs                 |   8 +-
 tests/AgentTests/FunctionalAPITests.hs        |  21 +-
 tests/CoreTests/MsgStoreTests.hs              | 222 +++++++
 tests/SMPClient.hs                            |  16 +-
 tests/SMPProxyTests.hs                        |  19 +-
 tests/ServerTests.hs                          |  32 +-
 tests/Test.hs                                 |   2 +
 21 files changed, 1360 insertions(+), 315 deletions(-)
 create mode 100644 src/Simplex/Messaging/Server/MsgStore/Journal.hs
 create mode 100644 src/Simplex/Messaging/Server/MsgStore/Types.hs
 create mode 100644 tests/CoreTests/MsgStoreTests.hs

diff --git a/rfcs/2024-09-01-smp-message-storage.md b/rfcs/2024-09-01-smp-message-storage.md
index 66905f5e5..0cad20235 100644
--- a/rfcs/2024-09-01-smp-message-storage.md
+++ b/rfcs/2024-09-01-smp-message-storage.md
@@ -96,7 +96,7 @@ else if write_msg = max_queue_messages:
     add quota_exceeded message to write_file
     update queue state: write_msg += 1
     append updated queue state to queue.log
-else ]
+else
     // It is required that `max_queue_messages < max_file_messages`,
     // so that we never need more than one additional write file.
     if write_msg >= max_file_messages: // queue file rotation
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 95261aac4..5b79044e9 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -174,7 +174,9 @@ library
       Simplex.Messaging.Server.Information
       Simplex.Messaging.Server.Main
       Simplex.Messaging.Server.MsgStore
+      Simplex.Messaging.Server.MsgStore.Journal
       Simplex.Messaging.Server.MsgStore.STM
+      Simplex.Messaging.Server.MsgStore.Types
       Simplex.Messaging.Server.NtfStore
       Simplex.Messaging.Server.QueueStore
       Simplex.Messaging.Server.QueueStore.QueueInfo
@@ -613,6 +615,7 @@ test-suite simplexmq-test
       CoreTests.CryptoFileTests
       CoreTests.CryptoTests
       CoreTests.EncodingTests
+      CoreTests.MsgStoreTests
       CoreTests.RetryIntervalTests
       CoreTests.SOCKSSettings
       CoreTests.StoreLogTests
diff --git a/src/Simplex/FileTransfer/Server/Main.hs b/src/Simplex/FileTransfer/Server/Main.hs
index aca3b60df..a057e2a3c 100644
--- a/src/Simplex/FileTransfer/Server/Main.hs
+++ b/src/Simplex/FileTransfer/Server/Main.hs
@@ -51,7 +51,9 @@ xftpServerCLI cfgPath logPath = do
         True -> readIniFile iniFile >>= either exitError runServer
         _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
     Delete -> do
-      confirmOrExit "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
+      confirmOrExit
+        "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
+        "Server NOT deleted"
       deleteDirIfExists cfgPath
       deleteDirIfExists logPath
       putStrLn "Deleted configuration and log files"
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 13d554f3c..19d1d448f 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -30,6 +30,7 @@ module Simplex.Messaging.Agent.Client
     withConnLocks,
     withInvLock,
     withLockMap,
+    getMapLock,
     ipAddressProtected,
     closeAgentClient,
     closeProtocolServerClients,
@@ -500,7 +501,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
   getMsgLocks <- TM.emptyIO
   connLocks <- TM.emptyIO
   invLocks <- TM.emptyIO
-  deleteLock <- atomically createLock
+  deleteLock <- createLockIO
   smpSubWorkers <- TM.emptyIO
   smpServersStats <- TM.emptyIO
   xftpServersStats <- TM.emptyIO
diff --git a/src/Simplex/Messaging/Agent/Lock.hs b/src/Simplex/Messaging/Agent/Lock.hs
index 69b8169e2..3c087499c 100644
--- a/src/Simplex/Messaging/Agent/Lock.hs
+++ b/src/Simplex/Messaging/Agent/Lock.hs
@@ -1,6 +1,7 @@
 module Simplex.Messaging.Agent.Lock
   ( Lock,
     createLock,
+    createLockIO,
     withLock,
     withLock',
     withGetLock,
@@ -24,6 +25,10 @@ createLock :: STM Lock
 createLock = newEmptyTMVar
 {-# INLINE createLock #-}
 
+createLockIO :: IO Lock
+createLockIO = newEmptyTMVarIO
+{-# INLINE createLockIO #-}
+
 withLock :: MonadUnliftIO m => Lock -> String -> ExceptT e m a -> ExceptT e m a
 withLock lock name = ExceptT . withLock' lock name . runExceptT
 {-# INLINE withLock #-}
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index 0c5d5e54b..7dfde3422 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -53,7 +53,9 @@ ntfServerCLI cfgPath logPath =
         True -> readIniFile iniFile >>= either exitError runServer
         _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
     Delete -> do
-      confirmOrExit "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
+      confirmOrExit
+        "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
+        "Server NOT deleted"
       deleteDirIfExists cfgPath
       deleteDirIfExists logPath
       putStrLn "Deleted configuration and log files"
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index 3c5ba11cb..d5d816bec 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -399,8 +399,6 @@ data Command (p :: Party) where
   NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> Command Recipient
   NDEL :: Command Recipient
   GET :: Command Recipient
-  -- ACK v1 has to be supported for encoding/decoding
-  -- ACK :: Command Recipient
   ACK :: MsgId -> Command Recipient
   OFF :: Command Recipient
   DEL :: Command Recipient
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 29de4ff6d..3e8f556b5 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -30,6 +30,8 @@
 module Simplex.Messaging.Server
   ( runSMPServer,
     runSMPServerBlocking,
+    importMessages,
+    exportMessages,
     disconnectTransport,
     verifyCmdAuthorization,
     dummyVerifyCmd,
@@ -39,7 +41,6 @@ module Simplex.Messaging.Server
 where
 
 import Control.Concurrent.STM (throwSTM)
-import Control.Concurrent.STM.TQueue (flushTQueue)
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
@@ -91,6 +92,7 @@ import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
 import Simplex.Messaging.Server.MsgStore.STM
+import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
@@ -193,11 +195,17 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
     stopServer s = do
       asks serverActive >>= atomically . (`writeTVar` False)
       logInfo "Saving server state..."
-      withLock' (savingLock s) "final" $ saveServer False >> closeServer
+      withLock' (savingLock s) "final" $ saveServer True >> closeServer
       logInfo "Server stopped"
 
     saveServer :: Bool -> M ()
-    saveServer keepMsgs = withLog closeStoreLog >> saveServerMessages keepMsgs >> saveServerNtfs >> saveServerStats
+    saveServer drainMsgs = do
+      withLog closeStoreLog
+      AMS _ ms <- asks msgStore
+      liftIO $ closeMsgStore ms
+      saveServerMessages drainMsgs
+      saveServerNtfs
+      saveServerStats
 
     closeServer :: M ()
     closeServer = asks (smpAgent . proxyAgent) >>= liftIO . closeSMPClientAgent
@@ -351,19 +359,17 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
 
     expireMessagesThread :: ExpirationConfig -> M ()
     expireMessagesThread expCfg = do
-      ms <- asks msgStore
-      quota <- asks $ msgQueueQuota . config
+      AMS _ ms <- asks msgStore
       let interval = checkInterval expCfg * 1000000
       stats <- asks serverStats
       labelMyThread "expireMessagesThread"
-      forever $ do
-        liftIO $ threadDelay' interval
-        old <- liftIO $ expireBeforeEpoch expCfg
-        rIds <- M.keysSet <$> readTVarIO ms
-        forM_ rIds $ \rId -> do
-          q <- liftIO $ getMsgQueue ms rId quota
-          deleted <- liftIO $ deleteExpiredMsgs q old
-          liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
+      liftIO $ forever $ do
+        threadDelay' interval
+        old <- expireBeforeEpoch expCfg
+        void $ withActiveMsgQueues ms $ \_ q -> do
+          runExceptT (deleteExpiredMsgs q old) >>= \case
+            Right deleted -> deleted <$ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
+            Left _ -> pure 0
 
     expireNtfsThread :: ServerConfig -> M ()
     expireNtfsThread ServerConfig {notificationExpiration = expCfg} = do
@@ -767,7 +773,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                           ProhibitSub -> pure (c1, c2, c3, c4 + 1)
               CPDelete queueId' -> withUserRole $ unliftIO u $ do
                 st <- asks queueStore
-                ms <- asks msgStore
+                AMS _ ms <- asks msgStore
                 queueId <- liftIO (getQueue st SSender queueId') >>= \case
                   Left _ -> pure queueId' -- fallback to using as recipientId directly
                   Right QueueRec {recipientId} -> pure recipientId
@@ -782,7 +788,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                     liftIO . hPutStrLn h $ "ok, " <> show numDeleted <> " messages deleted"
               CPSave -> withAdminRole $ withLock' (savingLock srv) "control" $ do
                 hPutStrLn h "saving server state..."
-                unliftIO u $ saveServer True
+                unliftIO u $ saveServer False
                 hPutStrLn h "server state saved!"
               CPHelp -> hPutStrLn h "commands: stats, stats-rts, clients, sockets, socket-threads, threads, server-info, delete, save, help, quit"
               CPQuit -> pure ()
@@ -1166,7 +1172,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           NDEL -> deleteQueueNotifier_ st
           OFF -> suspendQueue_ st
           DEL -> delQueueAndMsgs st
-          QUE -> withQueue getQueueInfo
+          QUE -> withQueue $ fmap (corrId,entId,) . getQueueInfo
       where
         createQueue :: QueueStore -> RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> SenderCanSecure -> M (Transmission BrokerMsg)
         createQueue st recipientKey dhKey subMode sndSecure = time "NEW" $ do
@@ -1262,7 +1268,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           okResp <$> liftIO (suspendQueue st entId)
 
         subscribeQueue :: QueueRec -> RecipientId -> M (Transmission BrokerMsg)
-        subscribeQueue qr rId = do
+        subscribeQueue qr rId =
           atomically (TM.lookup rId subscriptions) >>= \case
             Nothing -> newSub >>= deliver True
             Just s@Sub {subThread} -> do
@@ -1284,11 +1290,13 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               pure sub
             deliver :: Bool -> Sub -> M (Transmission BrokerMsg)
             deliver inc sub = do
-              q <- getStoreMsgQueue "SUB" rId
-              msg_ <- liftIO $ tryPeekMsgIO q
-              when (inc && isJust msg_) $
-                incStat . qSub =<< asks serverStats
-              deliverMessage "SUB" qr rId sub msg_
+              AMS _ ms <- asks msgStore
+              stats <- asks serverStats
+              fmap (either (\e -> (corrId, rId, ERR e)) id) $ liftIO $ runExceptT $ do
+                q <- getMsgQueue ms rId
+                msg_ <- tryPeekMsg q
+                liftIO $ when (inc && isJust msg_) $ incStat (qSub stats)
+                liftIO $ deliverMessage "SUB" qr rId sub msg_
 
         -- clients that use GET are not added to server subscribers
         getMessage :: QueueRec -> M (Transmission BrokerMsg)
@@ -1305,7 +1313,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                 _ -> do
                   stats <- asks serverStats
                   incStat $ msgGetProhibited stats
-                  pure (corrId, entId, ERR $ CMD PROHIBITED)
+                  pure $ err $ CMD PROHIBITED
           where
             newSub :: STM Sub
             newSub = do
@@ -1318,19 +1326,16 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               pure s
             getMessage_ :: Sub -> Maybe MsgId -> M (Transmission BrokerMsg)
             getMessage_ s delivered_ = do
-              q <- getStoreMsgQueue "GET" entId
+              AMS _ ms <- asks msgStore
               stats <- asks serverStats
-              (statCnt, r) <-
-                -- TODO split STM, use tryPeekMsgIO
-                atomically $
-                  tryPeekMsg q >>= \case
-                    Just msg ->
-                      let encMsg = encryptMsg qr msg
-                          cnt = if isJust delivered_ then msgGetDuplicate else msgGet
-                       in setDelivered s msg $> (cnt, (corrId, entId, MSG encMsg))
-                    _ -> pure (msgGetNoMsg, (corrId, entId, OK))
-              incStat $ statCnt stats
-              pure r
+              fmap (either err id) $ liftIO $ runExceptT $ do
+                q <- getMsgQueue ms entId
+                tryPeekMsg q >>= \case
+                  Just msg -> do
+                    let encMsg = encryptMsg qr msg
+                    incStat $ (if isJust delivered_ then msgGetDuplicate else msgGet) stats
+                    atomically $ setDelivered s msg $> (corrId, entId, MSG encMsg)
+                  Nothing -> incStat (msgGetNoMsg stats) $> ok
 
         withQueue :: (QueueRec -> M (Transmission BrokerMsg)) -> M (Transmission BrokerMsg)
         withQueue action = case qr_ of
@@ -1367,16 +1372,19 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
             Just sub ->
               atomically (getDelivered sub) >>= \case
                 Just st -> do
-                  q <- getStoreMsgQueue "ACK" entId
-                  case st of
-                    ProhibitSub -> do
-                      deletedMsg_ <- liftIO $ tryDelMsg q msgId
-                      mapM_ (updateStats True) deletedMsg_
-                      pure ok
-                    _ -> do
-                      (deletedMsg_, msg_) <- liftIO $ tryDelPeekMsg q msgId
-                      mapM_ (updateStats False) deletedMsg_
-                      deliverMessage "ACK" qr entId sub msg_
+                  AMS _ ms <- asks msgStore
+                  stats <- asks serverStats
+                  fmap (either err id) $ liftIO $ runExceptT $ do
+                    q <- getMsgQueue ms entId
+                    case st of
+                      ProhibitSub -> do
+                        deletedMsg_ <- tryDelMsg q msgId
+                        liftIO $ mapM_ (updateStats stats True) deletedMsg_
+                        pure ok
+                      _ -> do
+                        (deletedMsg_, msg_) <- tryDelPeekMsg q msgId
+                        liftIO $ mapM_ (updateStats stats False) deletedMsg_
+                        liftIO $ deliverMessage "ACK" qr entId sub msg_
                 _ -> pure $ err NO_MSG
           where
             getDelivered :: Sub -> STM (Maybe ServerSub)
@@ -1385,11 +1393,10 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                 if msgId == msgId' || B.null msgId
                   then pure $ Just subThread
                   else putTMVar delivered msgId' $> Nothing
-            updateStats :: Bool -> Message -> M ()
-            updateStats isGet = \case
+            updateStats :: ServerStats -> Bool -> Message -> IO ()
+            updateStats stats isGet = \case
               MessageQuota {} -> pure ()
               Message {msgFlags} -> do
-                stats <- asks serverStats
                 incStat $ msgRecv stats
                 if isGet
                   then incStat $ msgRecvGet stats
@@ -1399,11 +1406,11 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                   --   ns <- asks ntfStore
                   --   atomically $ TM.lookup nId ns >>=
                   --     mapM_ (\MsgNtf {ntfMsgId} -> when (msgId == msgId') $ TM.delete nId ns)
-                liftIO $ atomicModifyIORef'_ (msgCount stats) (subtract 1)
-                liftIO $ updatePeriodStats (activeQueues stats) entId
+                atomicModifyIORef'_ (msgCount stats) (subtract 1)
+                updatePeriodStats (activeQueues stats) entId
                 when (notification msgFlags) $ do
                   incStat $ msgRecvNtf stats
-                  liftIO $ updatePeriodStats (activeQueuesNtf stats) entId
+                  updatePeriodStats (activeQueuesNtf stats) entId
 
         sendMessage :: QueueRec -> MsgFlags -> MsgBody -> M (Transmission BrokerMsg)
         sendMessage qr msgFlags msgBody
@@ -1421,15 +1428,20 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                   case C.maxLenBS msgBody of
                     Left _ -> pure $ err LARGE_MSG
                     Right body -> do
-                      msg_ <- time "SEND" $ do
-                        q <- getStoreMsgQueue "SEND" $ recipientId qr
-                        expireMessages q
-                        liftIO . writeMsg q =<< mkMessage body
+                      AMS _ ms <- asks msgStore
+                      ServerConfig {messageExpiration, msgIdBytes} <- asks config
+                      msgId <- randomId' msgIdBytes
+                      msg_ <- liftIO $ time "SEND" $ runExceptT $ do
+                        q <- getMsgQueue ms $ recipientId qr
+                        expireMessages q messageExpiration stats
+                        msg <- liftIO $ mkMessage msgId body
+                        writeMsg q True msg
                       case msg_ of
-                        Nothing -> do
+                        Left e -> pure $ err e
+                        Right Nothing -> do
                           incStat $ msgSentQuota stats
                           pure $ err QUOTA
-                        Just (msg, wasEmpty) -> time "SEND ok" $ do
+                        Right (Just (msg, wasEmpty)) -> time "SEND ok" $ do
                           when wasEmpty $ liftIO $ tryDeliverMessage msg
                           when (notification msgFlags) $ do
                             mapM_ (`enqueueNotification` msg) (notifier qr)
@@ -1441,20 +1453,15 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                           pure ok
           where
             THandleParams {thVersion} = thParams'
-            mkMessage :: C.MaxLenBS MaxMessageLen -> M Message
-            mkMessage body = do
-              msgId <- randomId' =<< asks (msgIdBytes . config)
-              msgTs <- liftIO getSystemTime
+            mkMessage :: MsgId -> C.MaxLenBS MaxMessageLen -> IO Message
+            mkMessage msgId body = do
+              msgTs <- getSystemTime
               pure $! Message msgId msgTs msgFlags body
 
-            expireMessages :: MsgQueue -> M ()
-            expireMessages q = do
-              msgExp <- asks $ messageExpiration . config
-              old <- liftIO $ mapM expireBeforeEpoch msgExp
-              deleted <- liftIO $ sum <$> mapM (deleteExpiredMsgs q) old
-              when (deleted > 0) $ do
-                stats <- asks serverStats
-                liftIO $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
+            expireMessages :: MsgStoreClass s => MsgQueue s -> Maybe ExpirationConfig -> ServerStats -> ExceptT ErrorType IO ()
+            expireMessages q msgExp stats = do
+              deleted <- maybe (pure 0) (deleteExpiredMsgs q <=< liftIO . expireBeforeEpoch) msgExp
+              liftIO $ when (deleted > 0) $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
 
             -- The condition for delivery of the message is:
             -- - the queue was empty when the message was sent,
@@ -1472,7 +1479,6 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                 atomically deliverToSub >>= mapM_ forkDeliver
               where
                 rId = recipientId qr
-                -- remove tryPeekMsg
                 deliverToSub =
                   -- lookup has ot be in the same transaction,
                   -- so that if subscription ends, it re-evalutates
@@ -1586,7 +1592,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                     verified = \case
                       VRVerified qr -> Right (qr, (corrId', entId', cmd'))
                       VRFailed -> Left (corrId', entId', ERR AUTH)
-        deliverMessage :: T.Text -> QueueRec -> RecipientId -> Sub -> Maybe Message -> M (Transmission BrokerMsg)
+        deliverMessage :: T.Text -> QueueRec -> RecipientId -> Sub -> Maybe Message -> IO (Transmission BrokerMsg)
         deliverMessage name qr rId s@Sub {subThread} msg_ = time (name <> " deliver") . atomically $
           case subThread of
             ProhibitSub -> pure resp
@@ -1614,16 +1620,10 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
         setDelivered :: Sub -> Message -> STM Bool
         setDelivered s msg = tryPutTMVar (delivered s) $! messageId msg
 
-        getStoreMsgQueue :: T.Text -> RecipientId -> M MsgQueue
-        getStoreMsgQueue name rId = time (name <> " getMsgQueue") $ do
-          ms <- asks msgStore
-          quota <- asks $ msgQueueQuota . config
-          liftIO $ getMsgQueue ms rId quota
-
         delQueueAndMsgs :: QueueStore -> M (Transmission BrokerMsg)
         delQueueAndMsgs st = do
           withLog (`logDeleteQueue` entId)
-          ms <- asks msgStore
+          AMS _ ms <- asks msgStore
           liftIO (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case
             Right q -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
@@ -1643,14 +1643,16 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               pure ok
             Left e -> pure $ err e
 
-        getQueueInfo :: QueueRec -> M (Transmission BrokerMsg)
+        getQueueInfo :: QueueRec -> M BrokerMsg
         getQueueInfo QueueRec {senderKey, notifier} = do
-          q <- getStoreMsgQueue "getQueueInfo" entId
-          qiSub <- liftIO $ TM.lookupIO entId subscriptions >>= mapM mkQSub
-          qiSize <- liftIO $ getQueueSize q
-          qiMsg <- liftIO $ toMsgInfo <$$> tryPeekMsgIO q
-          let info = QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
-          pure (corrId, entId, INFO info)
+          AMS _ ms <- asks msgStore
+          fmap (either ERR id) $ liftIO $ runExceptT $ do
+            q <- getMsgQueue ms entId
+            qiSub <- liftIO $ TM.lookupIO entId subscriptions >>= mapM mkQSub
+            qiSize <- liftIO $ getQueueSize q
+            qiMsg <- toMsgInfo <$$> tryPeekMsg q
+            let info = QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
+            pure $ INFO info
           where
             mkQSub Sub {subThread, delivered} = do
               qSubThread <- case subThread of
@@ -1710,59 +1712,69 @@ randomId = fmap EntityId . randomId'
 {-# INLINE randomId #-}
 
 saveServerMessages :: Bool -> M ()
-saveServerMessages keepMsgs = asks (storeMsgsFile . config) >>= mapM_ saveMessages
+saveServerMessages drainMsgs =
+  asks msgStore >>= \case
+    AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
+      Just f -> liftIO $ exportMessages ms f $ getQueueMessages drainMsgs
+      Nothing -> logInfo "undelivered messages are not saved"
+    AMS SMSJournal _ -> logInfo "closed journal message storage"
+
+exportMessages :: MsgStoreClass s => s -> FilePath -> (MsgQueue s -> IO [Message]) -> IO ()
+exportMessages ms f getMessages = do
+  logInfo $ "saving messages to file " <> T.pack f
+  total <- liftIO $ withFile f WriteMode $ withAllMsgQueues ms . saveQueueMsgs
+  logInfo $ "messages saved: " <> tshow total
   where
-    saveMessages f = do
-      logInfo $ "saving messages to file " <> T.pack f
-      ms <- asks msgStore
-      liftIO . withFile f WriteMode $ \h ->
-        readTVarIO ms >>= mapM_ (saveQueueMsgs h) . M.assocs
-      logInfo "messages saved"
-      where
-        saveQueueMsgs h (rId, q) = BLD.hPutBuilder h . encodeMessages rId =<< atomically (getMessages $ msgQueue q)
-        getMessages = if keepMsgs then snapshotTQueue else flushTQueue
-        snapshotTQueue q = do
-          msgs <- flushTQueue q
-          mapM_ (writeTQueue q) msgs
-          pure msgs
-        encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
+    saveQueueMsgs h rId q = getMessages q >>= \msgs -> length msgs <$ BLD.hPutBuilder h (encodeMessages rId msgs)
+    encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
 
 restoreServerMessages :: M Int
 restoreServerMessages =
-  asks (storeMsgsFile . config) >>= \case
-    Just f -> ifM (doesFileExist f) (restoreMessages f) (pure 0)
-    Nothing -> pure 0
-  where
-    restoreMessages f = do
-      logInfo $ "restoring messages from file " <> T.pack f
-      ms <- asks msgStore
-      quota <- asks $ msgQueueQuota . config
+  asks msgStore >>= \case
+    AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath = Just f}} -> do
       old_ <- asks (messageExpiration . config) $>>= (liftIO . fmap Just . expireBeforeEpoch)
-      runExceptT (liftIO (LB.readFile f) >>= foldM (\expired -> restoreMsg expired ms quota old_) 0 . LB.lines) >>= \case
-        Left e -> do
-          logError . T.pack $ "error restoring messages: " <> e
-          liftIO exitFailure
-        Right expired -> do
-          renameFile f $ f <> ".bak"
-          logInfo "messages restored"
-          pure expired
+      liftIO $ ifM (doesFileExist f) (importMessages ms f old_) (pure 0)
+    _ -> logInfo "using journal message storage" $> 0
+
+importMessages :: MsgStoreClass s => s -> FilePath -> Maybe Int64 -> IO Int
+importMessages ms f old_ = do
+  logInfo $ "restoring messages from file " <> T.pack f
+  LB.readFile f >>= runExceptT . foldM restoreMsg (0, 0, 0) . zip [0..] . LB.lines >>= \case
+    Left e -> do
+      putStrLn ""
+      logError . T.pack $ "error restoring messages: " <> e
+      liftIO exitFailure
+    Right (count, total, expired) -> do
+      putStrLn ""
+      renameFile f $ f <> ".bak"
+      logQueueStates ms
+      qCount <- M.size <$> readTVarIO (activeMsgQueues ms)
+      logInfo $ "Processed " <> tshow count <> " lines, imported " <> tshow total <> " messages into " <> tshow qCount <> " queues, expired " <> tshow expired <> " messages"
+      pure expired
+  where
+    progress i = do
+      liftIO $ putStr $ "Processed " <> show i <> " lines\r"
+      hFlush stdout
+    restoreMsg :: (Int, Int, Int) -> (Int, LB.ByteString) -> ExceptT String IO (Int, Int, Int)
+    restoreMsg (!count, !total, !expired) (i, s') = do
+      when (i `mod` 1000 == 0) $ progress i
+      MLRv3 rId msg <- liftEither . first (msgErr "parsing") $ strDecode s
+      liftError show $ addToMsgQueue rId msg
       where
-        restoreMsg !expired ms quota old_ s' = do
-          MLRv3 rId msg <- liftEither . first (msgErr "parsing") $ strDecode s
-          addToMsgQueue rId msg
-          where
-            s = LB.toStrict s'
-            addToMsgQueue rId msg = do
-              q <- liftIO $ getMsgQueue ms rId quota
-              (isExpired, logFull) <- liftIO $ case msg of
-                Message {msgTs}
-                  | maybe True (systemSeconds msgTs >=) old_ -> (False,) . isNothing <$> writeMsg q msg
-                  | otherwise -> pure (True, False)
-                MessageQuota {} -> writeMsg q msg $> (False, False)
-              when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
-              pure $ if isExpired then expired + 1 else expired
-            msgErr :: Show e => String -> e -> String
-            msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
+        s = LB.toStrict s'
+        addToMsgQueue rId msg = do
+          q <- getMsgQueue ms rId
+          (isExpired, logFull) <- case msg of
+            Message {msgTs}
+              | maybe True (systemSeconds msgTs >=) old_ -> (False,) . isNothing <$> writeMsg q False msg
+              | otherwise -> pure (True, False)
+            MessageQuota {} -> writeMsg q False msg $> (False, False)
+          when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
+          let total' = if logFull then total else total + 1
+              expired' = if isExpired then expired + 1 else expired
+          pure (count + 1, total', expired')
+        msgErr :: Show e => String -> e -> String
+        msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
 
 saveServerNtfs :: M ()
 saveServerNtfs = asks (storeNtfsFile . config) >>= mapM_ saveNtfs
@@ -1827,7 +1839,10 @@ restoreServerStats expiredMsgs expiredNtfs = asks (serverStatsBackupFile . confi
         Right d@ServerStatsData {_qCount = statsQCount} -> do
           s <- asks serverStats
           _qCount <- fmap M.size . readTVarIO . queues =<< asks queueStore
-          _msgCount <- liftIO . foldM (\(!n) q -> (n +) <$> getQueueSize q) 0 =<< readTVarIO =<< asks msgStore
+          _msgCount <-
+            asks msgStore >>= \case
+              AMS SMSMemory ms -> liftIO $ readTVarIO (msgQueues ms) >>= foldM (\(!n) q -> (n +) <$> getQueueSize q) 0
+              _ -> pure 0
           NtfStore ns <- asks ntfStore
           _ntfCount <- liftIO . foldM (\(!n) q -> (n +) . length <$> readTVarIO q) 0 =<< readTVarIO ns
           liftIO $ setServerStats s d {_qCount, _msgCount, _ntfCount, _msgExpired = _msgExpired d + expiredMsgs, _msgNtfExpired = _msgNtfExpired d + expiredNtfs}
diff --git a/src/Simplex/Messaging/Server/CLI.hs b/src/Simplex/Messaging/Server/CLI.hs
index 30e5a0b58..feead1163 100644
--- a/src/Simplex/Messaging/Server/CLI.hs
+++ b/src/Simplex/Messaging/Server/CLI.hs
@@ -44,11 +44,11 @@ import Text.Read (readMaybe)
 exitError :: String -> IO a
 exitError msg = putStrLn msg >> exitFailure
 
-confirmOrExit :: String -> IO ()
-confirmOrExit s =
+confirmOrExit :: String -> String -> IO ()
+confirmOrExit s no =
   withPrompt (s <> "\nContinue (Y/n): ") $ do
     ok <- getLine
-    when (ok /= "Y") $ putStrLn "Server NOT deleted" >> exitFailure
+    when (ok /= "Y") $ putStrLn no >> exitFailure
 
 data SignAlgorithm = ED448 | ED25519
   deriving (Read, Show)
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index debd36c12..c8169fbc7 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -1,10 +1,14 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Simplex.Messaging.Server.Env.STM where
 
@@ -37,7 +41,9 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
+import Simplex.Messaging.Server.MsgStore.Journal
 import Simplex.Messaging.Server.MsgStore.STM
+import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.QueueStore (NtfCreds (..), QueueRec (..))
 import Simplex.Messaging.Server.QueueStore.STM
@@ -57,7 +63,10 @@ data ServerConfig = ServerConfig
   { transports :: [(ServiceName, ATransport, AddHTTP)],
     smpHandshakeTimeout :: Int,
     tbqSize :: Natural,
+    msgStoreType :: AMSType,
     msgQueueQuota :: Int,
+    maxJournalMsgCount :: Int,
+    maxJournalStateLines :: Int,
     queueIdBytes :: Int,
     msgIdBytes :: Int,
     storeLogFile :: Maybe FilePath,
@@ -136,6 +145,18 @@ defaultInactiveClientExpiration =
 defaultProxyClientConcurrency :: Int
 defaultProxyClientConcurrency = 32
 
+journalMsgStoreDepth :: Int
+journalMsgStoreDepth = 5
+
+defaultMaxJournalStateLines :: Int
+defaultMaxJournalStateLines = 16
+
+defaultMaxJournalMsgCount :: Int
+defaultMaxJournalMsgCount = 256
+
+defaultMsgQueueQuota :: Int
+defaultMsgQueueQuota = 128
+
 data Env = Env
   { config :: ServerConfig,
     serverActive :: TVar Bool,
@@ -143,7 +164,7 @@ data Env = Env
     server :: Server,
     serverIdentity :: KeyHash,
     queueStore :: QueueStore,
-    msgStore :: STMMsgStore,
+    msgStore :: AMsgStore,
     ntfStore :: NtfStore,
     random :: TVar ChaChaDRG,
     storeLog :: Maybe (StoreLog 'WriteMode),
@@ -156,6 +177,20 @@ data Env = Env
     proxyAgent :: ProxyAgent -- senders served on this proxy
   }
 
+type family MsgStore s where
+  MsgStore 'MSMemory = STMMsgStore
+  MsgStore 'MSJournal = JournalMsgStore
+
+data AMsgStore = forall s. MsgStoreClass (MsgStore s) => AMS (SMSType s) (MsgStore s)
+
+data AMsgQueue = forall s. MsgStoreClass (MsgStore s) => AMQ (SMSType s) (MsgQueue (MsgStore s))
+
+data AMsgStoreCfg = forall s. MsgStoreClass (MsgStore s) => AMSC (SMSType s) (MsgStoreConfig (MsgStore s))
+
+msgPersistence :: AMsgStoreCfg -> Bool
+msgPersistence (AMSC SMSMemory (STMStoreConfig {storePath})) = isJust storePath
+msgPersistence (AMSC SMSJournal _) = True
+
 type Subscribed = Bool
 
 data Server = Server
@@ -213,7 +248,7 @@ newServer = do
   ntfSubClients <- newTVarIO IM.empty
   pendingSubEvents <- newTVarIO IM.empty
   pendingNtfSubEvents <- newTVarIO IM.empty
-  savingLock <- atomically createLock
+  savingLock <- createLockIO
   return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, subClients, ntfSubClients, pendingSubEvents, pendingNtfSubEvents, savingLock}
 
 newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
@@ -243,11 +278,17 @@ newProhibitedSub = do
   return Sub {subThread = ProhibitSub, delivered}
 
 newEnv :: ServerConfig -> IO Env
-newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAgentCfg, information, messageExpiration} = do
+newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, msgStoreType, storeMsgsFile, smpAgentCfg, information, messageExpiration, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines} = do
   serverActive <- newTVarIO True
   server <- newServer
   queueStore <- newQueueStore
-  msgStore <- newMsgStore
+  msgStore <- case msgStoreType of
+    AMSType SMSMemory -> AMS SMSMemory <$> newMsgStore STMStoreConfig {storePath = storeMsgsFile, quota = msgQueueQuota}
+    AMSType SMSJournal -> case storeMsgsFile of
+      Just storePath -> 
+        let cfg = JournalStoreConfig {storePath, quota = msgQueueQuota, pathParts = journalMsgStoreDepth, maxMsgCount = maxJournalMsgCount, maxStateLines = maxJournalStateLines}
+         in AMS SMSJournal <$> newMsgStore cfg
+      Nothing -> putStrLn "Error: journal msg store require path in [STORE_LOG], restore_messages" >> exitFailure
   ntfStore <- NtfStore <$> TM.emptyIO
   random <- C.newRandom
   storeLog <-
@@ -314,7 +355,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAg
       where
         persistence
           | isNothing storeLogFile = SPMMemoryOnly
-          | isJust (storeMsgsFile config) = SPMMessages
+          | isJust storeMsgsFile = SPMMessages
           | otherwise = SPMQueues
 
 newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO ProxyAgent
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 685b28048..ddd51e815 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
@@ -20,6 +20,7 @@ import Control.Monad
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (isAlpha, isAscii, toUpper)
+import Data.Either (fromRight)
 import Data.Functor (($>))
 import Data.Ini (Ini, lookupValue, readIniFile)
 import Data.List (find, isPrefixOf)
@@ -27,7 +28,7 @@ import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8, decodeLatin1)
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
@@ -38,17 +39,19 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
-import Simplex.Messaging.Server (AttachHTTP, runSMPServer)
+import Simplex.Messaging.Server (AttachHTTP, exportMessages, importMessages, runSMPServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
+import Simplex.Messaging.Server.MsgStore.Journal (JournalStoreConfig (..), getQueueMessages)
+import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..), newMsgStore)
 import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedServerSMPRelayVRange)
 import Simplex.Messaging.Transport.Client (SocksProxy, TransportHost (..), defaultSocksProxy)
 import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow)
 import Simplex.Messaging.Version (mkVersionRange)
-import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
@@ -70,25 +73,73 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       doesFileExist iniFile >>= \case
         True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `" <> executableName <> " start`."
         _ -> initializeServer opts
-    OnlineCert certOpts ->
-      doesFileExist iniFile >>= \case
-        True -> genOnline cfgPath certOpts
-        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
-    Start ->
-      doesFileExist iniFile >>= \case
-        True -> readIniFile iniFile >>= either exitError runServer
-        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
+    OnlineCert certOpts -> withIniFile $ \_ -> genOnline cfgPath certOpts
+    Start -> withIniFile runServer
     Delete -> do
-      confirmOrExit "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
+      confirmOrExit
+        "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
+        "Server NOT deleted"
       deleteDirIfExists cfgPath
       deleteDirIfExists logPath
       putStrLn "Deleted configuration and log files"
+    Journal cmd -> withIniFile $ \ini -> do
+      msgsDirExists <- doesDirectoryExist storeMsgsJournalDir
+      msgsFileExists <- doesFileExist storeMsgsFilePath
+      when (msgsFileExists && msgsDirExists) exitConfigureMsgStorage
+      case cmd of
+        JCImport
+          | msgsDirExists -> do
+              putStrLn $ storeMsgsJournalDir <> " directory already exists."
+              exitFailure
+          | not msgsFileExists -> do
+              putStrLn $ storeMsgsFilePath <> " file does not exists."
+              exitFailure
+          | otherwise -> do
+              confirmOrExit
+                ("WARNING: message log file " <> storeMsgsFilePath <> " will be imported to journal directory " <> storeMsgsJournalDir)
+                "Messages not imported"
+              ms <- newJournalMsgStore
+              void $ importMessages ms storeMsgsFilePath Nothing -- no expiration
+              putStrLn "Import completed"
+              putStrLn $ case readMsgStoreType ini of
+                Right (AMSType SMSMemory) -> "store_messages set to `memory`, update it to `journal` in INI file"
+                Right (AMSType SMSJournal) -> "store_messages set to `journal`"
+                Left e -> e <> ", update it to `journal` in INI file"
+        JCExport
+          | msgsFileExists -> do
+              putStrLn $ storeMsgsFilePath <> " file already exists."
+              exitFailure
+          | otherwise -> do
+              confirmOrExit
+                ("WARNING: journal directory " <> storeMsgsJournalDir <> " will be exported to message log file " <> storeMsgsFilePath)
+                "Journal not exported"
+              ms <- newJournalMsgStore
+              exportMessages ms storeMsgsFilePath $ getQueueMessages False
+              putStrLn "Export completed"
+              putStrLn $ case readMsgStoreType ini of
+                Right (AMSType SMSMemory) -> "store_messages set to `memory`"
+                Right (AMSType SMSJournal) -> "store_messages set to `journal`, update it to `memory` in INI file"
+                Left e -> e <> ", update it to `memory` in INI file"
   where
+    withIniFile a =
+      doesFileExist iniFile >>= \case
+        True -> readIniFile iniFile >>= either exitError a
+        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
+    newJournalMsgStore = newMsgStore JournalStoreConfig {storePath = storeMsgsJournalDir, pathParts = journalMsgStoreDepth, quota = defaultMsgQueueQuota, maxMsgCount = defaultMaxJournalMsgCount, maxStateLines = defaultMaxJournalStateLines}
     iniFile = combine cfgPath "smp-server.ini"
     serverVersion = "SMP server v" <> simplexMQVersion
     defaultServerPorts = "5223,443"
     executableName = "smp-server"
     storeLogFilePath = combine logPath "smp-server-store.log"
+    storeMsgsFilePath = combine logPath "smp-server-messages.log"
+    storeMsgsJournalDir = combine logPath "messages"
+    storeNtfsFilePath = combine logPath "smp-server-ntfs.log"
+    readMsgStoreType :: Ini -> Either String AMSType
+    readMsgStoreType = textToMsgStoreType . fromRight "memory" . lookupValue "STORE_LOG" "store_messages"
+    textToMsgStoreType = \case
+      "memory" -> Right $ AMSType SMSMemory
+      "journal" -> Right $ AMSType SMSJournal
+      s -> Left $ "invalid store_messages: " <> T.unpack s
     httpsCertFile = combine cfgPath "web.crt"
     httpsKeyFile = combine cfgPath "web.key"
     defaultStaticPath = combine logPath "www"
@@ -128,7 +179,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 _ -> putStrLn "Invalid password. Only latin letters, digits and symbols other than '@' and ':' are allowed" >> serverPassword
         checkInitOptions InitOptions {sourceCode, serverInfo, operatorCountry, hostingCountry} = do
           let err_
-                | isNothing sourceCode && hasServerInfo serverInfo = 
+                | isNothing sourceCode && hasServerInfo serverInfo =
                     Just "Error: passing any server information requires passing --source-code"
                 | isNothing (operator serverInfo) && isJust operatorCountry =
                     Just "Error: passing --operator-country requires passing --operator"
@@ -168,9 +219,12 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                    \# and restoring it when the server is started.\n\
                    \# Log is compacted on start (deleted objects are removed).\n"
                 <> ("enable: " <> onOff enableStoreLog <> "\n\n")
-                <> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
-                   \# they are preserved in the .bak file until the next restart.\n"
-                <> ("restore_messages: " <> onOff enableStoreLog <> "\n")
+                <> "# Message storage mode: `memory` or `journal`.\n\
+                   \store_messages: memory\n\n\
+                   \# When store_messages is `memory`, undelivered messages are optionally saved and restored\n\
+                   \# when the server restarts, they are preserved in the .bak file until the next restart.\n"
+                <> ("restore_messages: " <> onOff enableStoreLog <> "\n\n")
+                <> "# Messages and notifications expiration periods.\n"
                 <> ("expire_messages_days: " <> tshow defMsgExpirationDays <> "\n")
                 <> ("expire_ntfs_hours: " <> tshow defNtfExpirationHours <> "\n\n")
                 <> "# Log daily server statistics to CSV file\n"
@@ -248,12 +302,13 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       fp <- checkSavedFingerprint cfgPath defaultX509Config
       let host = either (const "<hostnames>") T.unpack $ lookupValue "TRANSPORT" "host" ini
           port = T.unpack $ strictIni "TRANSPORT" "port" ini
-          cfg@ServerConfig {information, storeLogFile, newQueueBasicAuth, messageExpiration, inactiveClientExpiration} = serverConfig
+          cfg@ServerConfig {information, storeLogFile, msgStoreType, newQueueBasicAuth, messageExpiration, inactiveClientExpiration} = serverConfig
           sourceCode' = (\ServerPublicInfo {sourceCode} -> sourceCode) <$> information
           srv = ProtoServerWithAuth (SMPServer [THDomainName host] (if port == "5223" then "" else port) (C.KeyHash fp)) newQueueBasicAuth
       printServiceInfo serverVersion srv
       printSourceCode sourceCode'
       printServerConfig transports storeLogFile
+      checkMsgStoreMode msgStoreType
       putStrLn $ case messageExpiration of
         Just ExpirationConfig {ttl} -> "expiring messages after " <> showTTL ttl
         _ -> "not expiring messages"
@@ -302,12 +357,16 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
           _ -> enableStoreLog $> path
         transports = iniTransports ini
         sharedHTTP = any (\(_, _, addHTTP) -> addHTTP) transports
+        iniMsgStoreType = either error id $! readMsgStoreType ini
         serverConfig =
           ServerConfig
             { transports,
               smpHandshakeTimeout = 120000000,
               tbqSize = 128,
-              msgQueueQuota = 128,
+              msgStoreType = iniMsgStoreType,
+              msgQueueQuota = defaultMsgQueueQuota,
+              maxJournalMsgCount = defaultMaxJournalMsgCount,
+              maxJournalStateLines = defaultMaxJournalStateLines,
               queueIdBytes = 24,
               msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
               smpCredentials =
@@ -318,8 +377,10 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                   },
               httpCredentials = (\WebHttpsParams {key, cert} -> ServerCredentials {caCertificateFile = Nothing, privateKeyFile = key, certificateFile = cert}) <$> webHttpsParams',
               storeLogFile = enableStoreLog $> storeLogFilePath,
-              storeMsgsFile = restoreMessagesFile $ combine logPath "smp-server-messages.log",
-              storeNtfsFile = restoreMessagesFile $ combine logPath "smp-server-ntfs.log",
+              storeMsgsFile = case iniMsgStoreType of
+                AMSType SMSMemory -> restoreMessagesFile storeMsgsFilePath
+                AMSType SMSJournal -> Just storeMsgsJournalDir,
+              storeNtfsFile = restoreMessagesFile storeNtfsFilePath,
               -- allow creating new queues by default
               allowNewQueues = fromMaybe True $ iniOnOff "AUTH" "new_queues" ini,
               newQueueBasicAuth = either error id <$!> strDecodeIni "AUTH" "create_password" ini,
@@ -393,6 +454,31 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
             pure WebHttpsParams {port, cert, key}
         webStaticPath' = eitherToMaybe $ T.unpack <$> lookupValue "WEB" "static_path" ini
 
+    checkMsgStoreMode :: AMSType -> IO ()
+    checkMsgStoreMode mode = do
+      msgsDirExists <- doesDirectoryExist storeMsgsJournalDir
+      msgsFileExists <- doesFileExist storeMsgsFilePath
+      case mode of
+        _ | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
+        AMSType SMSJournal
+          | msgsFileExists -> do
+              putStrLn $ "Error: store_messages is `journal` with " <> storeMsgsFilePath <> " file present."
+              putStrLn "Set store_messages to `memory` or use `smp-server journal export` to migrate."
+              exitFailure
+          | not msgsDirExists ->
+              putStrLn $ "store_messages is `journal`, " <> storeMsgsJournalDir <> " directory will be created."
+        AMSType SMSMemory
+          | msgsDirExists -> do
+              putStrLn $ "Error: store_messages is `memory` with " <> storeMsgsJournalDir <> " directory present."
+              putStrLn "Set store_messages to `journal` or use `smp-server journal import` to migrate."
+              exitFailure
+        _ -> pure ()
+
+    exitConfigureMsgStorage = do
+      putStrLn $ "Error: both " <> storeMsgsFilePath <> " file and " <> storeMsgsJournalDir <> " directory are present."
+      putStrLn "Configure memory storage."
+      exitFailure
+
 data EmbeddedWebParams = EmbeddedWebParams
   { webStaticPath :: FilePath,
     webHttpPort :: Maybe Int,
@@ -458,12 +544,13 @@ informationIniContent InitOptions {sourceCode, serverInfo} =
        \# Hosting type can be `virtual`, `dedicated`, `colocation`, `owned`\n"
     <> ("hosting_type: " <> maybe "virtual" (decodeLatin1 . strEncode) hostingType <> "\n\n")
   where
-    ServerPublicInfo {operator, website, hosting, hostingType, serverCountry}= serverInfo
+    ServerPublicInfo {operator, website, hosting, hostingType, serverCountry} = serverInfo
     countryStr optName country = optDisabled country <> optName <> "_country: " <> fromMaybe "ISO-3166 2-letter code" country <> "\n"
     enitiyStrs optName entity =
       optDisabled entity
-        <> optName <> ": "
-        <> maybe ("entity (organization or person name)") name entity
+        <> optName
+        <> ": "
+        <> maybe "entity (organization or person name)" name entity
         <> "\n"
         <> countryStr optName (country =<< entity)
 
@@ -519,6 +606,9 @@ data CliCommand
   | OnlineCert CertOptions
   | Start
   | Delete
+  | Journal JournalCmd
+
+data JournalCmd = JCImport | JCExport
 
 data InitOptions = InitOptions
   { enableStoreLog :: Bool,
@@ -550,6 +640,7 @@ cliCommandP cfgPath logPath iniFile =
         <> command "cert" (info (OnlineCert <$> certOptionsP) (progDesc $ "Generate new online TLS server credentials (configuration: " <> iniFile <> ")"))
         <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
         <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
+        <> command "journal" (info (Journal <$> journalCmdP) (progDesc "Import/export messages to/from journal storage"))
     )
   where
     initP :: Parser InitOptions
@@ -607,22 +698,21 @@ cliCommandP cfgPath logPath iniFile =
           <|> option strParse (long "control-port" <> help "Enable control port" <> metavar "PORT" <> value Nothing)
       socksProxy <-
         flag' (Just defaultSocksProxy) (long "socks-proxy" <> help "Outgoing SOCKS proxy on port 9050")
-          <|>
-            option
-              strParse
-              ( long "socks-proxy"
-                  <> metavar "PROXY"
-                  <> help "Outgoing SOCKS proxy to forward messages to onion-only servers"
-                  <> value Nothing
-              )
+          <|> option
+            strParse
+            ( long "socks-proxy"
+                <> metavar "PROXY"
+                <> help "Outgoing SOCKS proxy to forward messages to onion-only servers"
+                <> value Nothing
+            )
       ownDomains :: Maybe (L.NonEmpty TransportHost) <-
         option
           strParse
-            ( long "own-domains"
-                <> metavar "DOMAINS"
-                <> help "Own server domain names (comma-separated)"
-                <> value Nothing
-            )
+          ( long "own-domains"
+              <> metavar "DOMAINS"
+              <> help "Own server domain names (comma-separated)"
+              <> value Nothing
+          )
       sourceCode <-
         flag' (Just simplexmqSource) (long "source-code" <> help ("Server source code (default: " <> simplexmqSource <> ")"))
           <|> (optional . strOption) (long "source-code" <> metavar "URI" <> help "Server source code")
@@ -690,6 +780,12 @@ cliCommandP cfgPath logPath iniFile =
             disableWeb,
             scripted
           }
+    journalCmdP =
+      hsubparser
+        ( command "import" (info (pure JCImport) (progDesc "Import message log file into a new journal storage"))
+            <> command "export" (info (pure JCExport) (progDesc "Export journal storage to message log file"))
+        )
+
     parseBasicAuth :: ReadM ServerPassword
     parseBasicAuth = eitherReader $ fmap ServerPassword . strDecode . B.pack
     entityP :: String -> String -> String -> Parser (Maybe Entity, Maybe Text)
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
new file mode 100644
index 000000000..29a022668
--- /dev/null
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -0,0 +1,556 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Simplex.Messaging.Server.MsgStore.Journal
+  ( JournalMsgStore (msgQueues, random),
+    JournalMsgQueue,
+    JournalStoreConfig (..),
+    getQueueMessages,
+    -- below are exported for tests
+    MsgQueueState (..),
+    JournalState (..),
+    msgQueueDirectory,
+    readWriteQueueState,
+    newMsgQueueState,
+    newJournalId,
+    logQueueState,
+    queueLogFileName,
+    logFileExt,
+  )
+where
+
+import Control.Concurrent.STM
+import qualified Control.Exception as E
+import Control.Logger.Simple
+import Control.Monad
+import Control.Monad.Trans.Except
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Functor (($>))
+import Data.Maybe (catMaybes, fromMaybe)
+import qualified Data.Text as T
+import Data.Time.Clock (getCurrentTime)
+import Data.Time.Format.ISO8601 (iso8601Show)
+import GHC.IO (catchAny)
+import Simplex.Messaging.Agent.Client (getMapLock, withLockMap)
+import Simplex.Messaging.Agent.Lock
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (ErrorType (..), Message (..), RecipientId)
+import Simplex.Messaging.Server.MsgStore.Types
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Util (ifM, tshow, ($>>=))
+import System.Directory
+import System.FilePath ((</>))
+import System.IO (BufferMode (..), Handle, IOMode (..), SeekMode (..), stdout)
+import qualified System.IO as IO
+import System.Random (StdGen, genByteString, newStdGen)
+
+data JournalMsgStore = JournalMsgStore
+  { config :: JournalStoreConfig,
+    random :: TVar StdGen,
+    queueLocks :: TMap RecipientId Lock,
+    msgQueues :: TMap RecipientId JournalMsgQueue
+  }
+
+data JournalStoreConfig = JournalStoreConfig
+  { storePath :: FilePath,
+    pathParts :: Int,
+    quota :: Int,
+    -- Max number of messages per journal file - ignored in STM store.
+    -- When this limit is reached, the file will be changed.
+    -- This number should be set bigger than queue quota.
+    maxMsgCount :: Int,
+    maxStateLines :: Int
+  }
+
+data JournalMsgQueue = JournalMsgQueue
+  { config :: JournalStoreConfig,
+    queueDirectory :: FilePath,
+    queueLock :: Lock,
+    state :: TVar MsgQueueState,
+    -- Last message and length incl. newline
+    -- Nothing - unknown, Just Nothing - empty queue.
+    -- This optimization  prevents reading each message at least twice,
+    -- or reading it after it was just written.
+    tipMsg :: TVar (Maybe (Maybe (Message, Int))),
+    handles :: TVar (Maybe MsgQueueHandles),
+    random :: TVar StdGen
+  }
+
+data MsgQueueState = MsgQueueState
+  { writeState :: JournalState,
+    readState :: JournalState,
+    canWrite :: Bool,
+    size :: Int
+  }
+  deriving (Show)
+
+data MsgQueueHandles = MsgQueueHandles
+  { stateHandle :: Handle, -- handle to queue state log file, rotates and removes old backups when server is restarted
+    readHandle :: Handle,
+    writeHandle :: Maybe Handle -- optional, used when write file is different from read file
+  }
+
+data JournalState = JournalState
+  { journalId :: ByteString,
+    msgPos :: Int,
+    msgCount :: Int,
+    bytePos :: Int
+  }
+  deriving (Show)
+
+newMsgQueueState :: ByteString -> MsgQueueState
+newMsgQueueState journalId =
+  let st = newJournalState journalId
+   in MsgQueueState {writeState = st, readState = st, canWrite = True, size = 0}
+
+newJournalState :: ByteString -> JournalState
+newJournalState journalId = JournalState {journalId, msgPos = 0, msgCount = 0, bytePos = 0}
+
+journalFilePath :: FilePath -> ByteString -> FilePath
+journalFilePath dir journalId = dir </> (msgLogFileName <> "." <> B.unpack journalId <> logFileExt)
+
+instance StrEncoding MsgQueueState where
+  strEncode MsgQueueState {writeState, readState, canWrite, size} =
+    B.unwords
+      [ "write=" <> strEncode writeState,
+        "read=" <> strEncode readState,
+        "canWrite=" <> strEncode canWrite,
+        "size=" <> strEncode size
+      ]
+  strP = do
+    writeState <- "write=" *> strP
+    readState <- " read=" *> strP
+    canWrite <- " canWrite=" *> strP
+    size <- " size=" *> strP
+    pure MsgQueueState {writeState, readState, canWrite, size}
+
+instance StrEncoding JournalState where
+  strEncode JournalState {journalId, msgPos, msgCount, bytePos} =
+    B.intercalate "," [journalId, strEncode msgPos, strEncode msgCount, strEncode bytePos]
+  strP = do
+    journalId <- A.takeTill (== ',')
+    msgPos <- A.char ',' *> strP
+    msgCount <- A.char ',' *> strP
+    bytePos <- A.char ',' *> strP
+    pure JournalState {journalId, msgPos, msgCount, bytePos}
+
+queueLogFileName :: String
+queueLogFileName = "queue_state"
+
+msgLogFileName :: String
+msgLogFileName = "messages"
+
+logFileExt :: String
+logFileExt = ".log"
+
+newtype NonAtomicIO a = NonAtomicIO (IO a)
+  deriving newtype (Functor, Applicative, Monad)
+
+instance MsgStoreClass JournalMsgStore where
+  type StoreMonad JournalMsgStore = NonAtomicIO
+  type MsgQueue JournalMsgStore = JournalMsgQueue
+  type MsgStoreConfig JournalMsgStore = JournalStoreConfig
+
+  newMsgStore :: JournalStoreConfig -> IO JournalMsgStore
+  newMsgStore config = do
+    random <- newTVarIO =<< newStdGen
+    queueLocks <- TM.emptyIO
+    msgQueues <- TM.emptyIO
+    pure JournalMsgStore {config, random, queueLocks, msgQueues}
+
+  closeMsgStore st = readTVarIO (msgQueues st) >>= mapM_ closeMsgQueue_
+
+  activeMsgQueues = msgQueues
+  {-# INLINE activeMsgQueues #-}
+
+  -- This function opens and closes all queues.
+  -- It is used to export storage to a single file, not during normal server execution.
+  withAllMsgQueues :: JournalMsgStore -> (RecipientId -> JournalMsgQueue -> IO Int) -> IO Int
+  withAllMsgQueues st@JournalMsgStore {config} action = do
+    closeMsgStore st
+    lock <- createLockIO -- the same lock is used for all queues
+    dirs <- zip [0..] <$> listQueueDirs 0 ("", storePath)
+    let count = length dirs
+    total <- foldM (processQueue lock count) 0 dirs
+    progress count count
+    putStrLn ""
+    pure total
+    where
+      JournalStoreConfig {storePath, pathParts} = config
+      processQueue lock count !total (i :: Int, (queueId, dir)) = do
+        when (i `mod` 100 == 0) $ progress i count
+        q <- openMsgQueue st dir lock
+        total' <- case strDecode $ B.pack queueId of
+          Right rId -> (total +) <$> action rId q
+          Left e -> total <$ putStrLn ("Error: message queue directory " <> dir <> " is invalid: " <> e)
+        closeMsgQueue_ q
+        pure total'
+      progress i count = do
+        putStr $ "Processed: " <> show i <> "/" <> show count <> " queues\r"
+        IO.hFlush stdout
+      listQueueDirs depth (queueId, path)
+        | depth == pathParts - 1 = listDirs
+        | otherwise = fmap concat . mapM (listQueueDirs (depth + 1)) =<< listDirs
+        where
+          listDirs = fmap catMaybes . mapM queuePath =<< listDirectory path
+          queuePath dir = do
+            let path' = path </> dir
+            ifM
+              (doesDirectoryExist path')
+              (pure $ Just (queueId <> dir, path'))
+              (Nothing <$ putStrLn ("Error: path " <> path' <> " is not a directory, skipping"))
+
+  logQueueStates :: JournalMsgStore -> IO ()
+  logQueueStates st =
+    void $ withActiveMsgQueues st $ \_ q ->
+      readTVarIO (handles q)
+        >>= maybe (pure ()) (\hs -> readTVarIO (state q) >>= logQueueState (stateHandle hs))
+        >> pure 0
+
+  getMsgQueue :: JournalMsgStore -> RecipientId -> ExceptT ErrorType IO JournalMsgQueue
+  getMsgQueue store@JournalMsgStore {queueLocks, msgQueues, random} rId =
+    tryStore "getMsgQueue" $ withLockMap queueLocks rId "getMsgQueue" $
+      TM.lookupIO rId msgQueues >>= maybe newQ pure
+    where
+      newQ = do
+        let dir = msgQueueDirectory store rId
+        queueLock <- atomically $ getMapLock queueLocks rId
+        q <- ifM (doesDirectoryExist dir) (openMsgQueue store dir queueLock) (createQ dir queueLock)
+        atomically $ TM.insert rId q msgQueues
+        pure q
+        where
+          createQ :: FilePath -> Lock -> IO JournalMsgQueue
+          createQ dir queueLock = do
+            -- folder and files are not created here,
+            -- to avoid file IO for queues without messages during subscription
+            journalId <- newJournalId random
+            mkJournalQueue store dir queueLock (newMsgQueueState journalId, Nothing)
+
+  delMsgQueue :: JournalMsgStore -> RecipientId -> IO ()
+  delMsgQueue st rId = withLockMap (queueLocks st) rId "delMsgQueue" $ do
+    void $ closeMsgQueue st rId
+    removeQueueDirectory st rId
+
+  delMsgQueueSize :: JournalMsgStore -> RecipientId -> IO Int
+  delMsgQueueSize st rId = withLockMap (queueLocks st) rId "delMsgQueue" $ do
+    state_ <- closeMsgQueue st rId
+    sz <- maybe (pure $ -1) (fmap size . readTVarIO) state_
+    removeQueueDirectory st rId
+    pure sz
+
+  getQueueMessages :: Bool -> JournalMsgQueue -> IO [Message]
+  getQueueMessages drainMsgs q = readTVarIO (handles q) >>= maybe (pure []) (getMsg [])
+    where
+      getMsg ms hs = chooseReadJournal q drainMsgs hs >>= maybe (pure ms) readMsg
+        where
+          readMsg (rs, h) = do
+            -- TODO handle errors
+            s <- hGetLineAt h $ bytePos rs
+            -- TODO handle errors
+            Right msg <- pure $ strDecode s
+            updateReadPos q drainMsgs (B.length s + 1) hs -- 1 is to account for new line
+            (msg :) <$> getMsg ms hs
+
+  writeMsg :: JournalMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  writeMsg q@JournalMsgQueue {queueDirectory, handles, config, random} logState !msg =
+    tryStore "writeMsg" $ withLock' (queueLock q) "writeMsg" $ do
+      st@MsgQueueState {canWrite, size} <- readTVarIO (state q)
+      let empty = size == 0
+      if canWrite || empty
+        then do
+          let canWrt' = quota > size
+          if canWrt'
+            then writeToJournal st canWrt' msg $> Just (msg, empty)
+            else writeToJournal st canWrt' msgQuota $> Nothing
+        else pure Nothing
+    where
+      JournalStoreConfig {quota, maxMsgCount} = config
+      msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
+      writeToJournal st@MsgQueueState {writeState, readState = rs, size} canWrt' msg' = do
+        let msgStr = strEncode msg' `B.snoc` '\n'
+            msgLen = B.length msgStr
+        hs <- maybe createQueueDir pure =<< readTVarIO handles
+        (ws, wh) <- case writeHandle hs of
+          Nothing | msgCount writeState >= maxMsgCount -> switchWriteJournal hs
+          wh_ -> pure (writeState, fromMaybe (readHandle hs) wh_)
+        let msgCount' = msgCount ws + 1
+            ws' = ws {msgPos = msgPos ws + 1, msgCount = msgCount', bytePos = bytePos ws + msgLen}
+            rs' = if journalId ws == journalId rs then rs {msgCount = msgCount'} else rs
+            !st' = st {writeState = ws', readState = rs', canWrite = canWrt', size = size + 1}
+        when (size == 0) $ atomically $ writeTVar (tipMsg q) $ Just (Just (msg, msgLen))
+        hAppend wh msgStr
+        updateQueueState q logState hs st'
+        where
+          createQueueDir = do
+            createDirectoryIfMissing True queueDirectory
+            let statePath = queueDirectory </> (queueLogFileName <> logFileExt)
+            sh <- openFile statePath AppendMode
+            B.hPutStr sh ""
+            rh <- createNewJournal queueDirectory $ journalId rs
+            let hs = MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = Nothing}
+            atomically $ writeTVar handles $ Just hs
+            pure hs
+          switchWriteJournal hs = do
+            journalId <- newJournalId random
+            wh <- createNewJournal queueDirectory journalId
+            atomically $ writeTVar handles $ Just $ hs {writeHandle = Just wh}
+            pure (newJournalState journalId, wh)
+
+  getQueueSize :: JournalMsgQueue -> IO Int
+  getQueueSize JournalMsgQueue {state} = size <$> readTVarIO state
+
+  tryPeekMsg_ :: JournalMsgQueue -> NonAtomicIO (Maybe Message)
+  tryPeekMsg_ q@JournalMsgQueue {tipMsg, handles} =
+    NonAtomicIO $ readTVarIO handles $>>= chooseReadJournal q True $>>= peekMsg
+    where
+      peekMsg (rs, h) = readTVarIO tipMsg >>= maybe readMsg (pure . fmap fst)
+        where
+          readMsg = do
+            -- TODO handle errors
+            s <- hGetLineAt h $ bytePos rs
+            -- TODO handle errors
+            Right msg <- pure $ strDecode s
+            atomically $ writeTVar tipMsg $ Just (Just (msg, B.length s + 1)) -- 1 is to account for new line
+            pure $ Just msg
+
+  tryDeleteMsg_ :: JournalMsgQueue -> NonAtomicIO ()
+  tryDeleteMsg_ q@JournalMsgQueue {tipMsg, handles} = NonAtomicIO $
+    void $
+      readTVarIO tipMsg -- if there is no cached tipMsg, do nothing
+        $>>= (pure . fmap snd)
+        $>>= \len -> readTVarIO handles
+        $>>= \hs -> updateReadPos q True len hs $> Just ()
+
+  atomicQueue :: JournalMsgQueue -> String -> NonAtomicIO a -> ExceptT ErrorType IO a
+  atomicQueue mq op (NonAtomicIO a) = tryStore op $ withLock' (queueLock mq) op $ a
+
+tryStore :: String -> IO a -> ExceptT ErrorType IO a
+tryStore op a =
+  ExceptT $
+    (Right <$> a) `catchAny` \e ->
+      let e' = op <> " " <> show e
+       in logError ("STORE ERROR " <> T.pack e') $> Left (STORE e')
+
+openMsgQueue :: JournalMsgStore -> FilePath -> Lock -> IO JournalMsgQueue
+openMsgQueue store dir queueLock = do
+  let statePath = dir </> (queueLogFileName <> logFileExt)
+  (st, sh) <- readWriteQueueState store statePath
+  (st', rh, wh_) <- openJournals dir st
+  let hs = MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = wh_}
+  mkJournalQueue store dir queueLock (st', Just hs)
+
+mkJournalQueue :: JournalMsgStore -> FilePath -> Lock -> (MsgQueueState, Maybe MsgQueueHandles) -> IO JournalMsgQueue
+mkJournalQueue JournalMsgStore {random, config} dir queueLock (st, hs_) = do
+  state <- newTVarIO st
+  tipMsg <- newTVarIO Nothing
+  handles <- newTVarIO hs_
+  -- using the same queue lock which is currently locked,
+  -- to avoid map lookup on queue operations
+  pure
+    JournalMsgQueue
+      { config,
+        queueDirectory = dir,
+        queueLock,
+        state,
+        tipMsg,
+        handles,
+        random
+      }
+
+chooseReadJournal :: JournalMsgQueue -> Bool -> MsgQueueHandles -> IO (Maybe (JournalState, Handle))
+chooseReadJournal q log' hs = do
+  st@MsgQueueState {writeState = ws, readState = rs} <- readTVarIO (state q)
+  case writeHandle hs of
+    Just wh | msgPos rs >= msgCount rs && journalId rs /= journalId ws -> do
+      -- switching to write journal
+      atomically $ writeTVar (handles q) $ Just hs {readHandle = wh, writeHandle = Nothing}
+      hClose $ readHandle hs
+      removeJournal (queueDirectory q) rs
+      let !rs' = (newJournalState $ journalId ws) {msgCount = msgCount ws}
+          !st' = st {readState = rs'}
+      updateQueueState q log' hs st'
+      pure $ Just (rs', wh)
+    _ | msgPos rs >= msgCount rs && journalId rs == journalId ws -> pure Nothing
+    _ -> pure $ Just (rs, readHandle hs)
+
+updateQueueState :: JournalMsgQueue -> Bool -> MsgQueueHandles -> MsgQueueState -> IO ()
+updateQueueState q log' hs st = do
+  atomically $ writeTVar (state q) st
+  when log' $ logQueueState (stateHandle hs) st
+
+logQueueState :: Handle -> MsgQueueState -> IO ()
+logQueueState h st = B.hPutStr h $ strEncode st `B.snoc` '\n'
+
+updateReadPos :: JournalMsgQueue -> Bool -> Int -> MsgQueueHandles -> IO ()
+updateReadPos q log' len hs = do
+  st@MsgQueueState {readState = rs, size} <- readTVarIO (state q)
+  let JournalState {msgPos, bytePos} = rs
+  let msgPos' = msgPos + 1
+      rs' = rs {msgPos = msgPos', bytePos = bytePos + len}
+      st' = st {readState = rs', size = size - 1}
+  updateQueueState q log' hs st'              
+  atomically $ writeTVar (tipMsg q) Nothing
+
+msgQueueDirectory :: JournalMsgStore -> RecipientId -> FilePath
+msgQueueDirectory JournalMsgStore {config = JournalStoreConfig {storePath, pathParts}} rId =
+  storePath </> B.unpack (B.intercalate "/" $ splitSegments pathParts $ strEncode rId)
+  where
+    splitSegments _ "" = []
+    splitSegments 1 s = [s]
+    splitSegments n s =
+      let (seg, s') = B.splitAt 2 s
+       in seg : splitSegments (n - 1) s'
+
+createNewJournal :: FilePath -> ByteString -> IO Handle
+createNewJournal dir journalId = do
+  let path = journalFilePath dir journalId -- TODO retry if file exists
+  h <- openFile path ReadWriteMode
+  B.hPutStr h ""
+  pure h
+
+newJournalId :: TVar StdGen -> IO ByteString
+newJournalId g = strEncode <$> atomically (stateTVar g $ genByteString 12)
+
+openJournals :: FilePath -> MsgQueueState -> IO (MsgQueueState, Handle, Maybe Handle)
+openJournals dir st@MsgQueueState {readState = rs, writeState = ws} = do
+  -- TODO verify that file exists, what to do if it's not, or if its state diverges
+  -- TODO check current position matches state, fix if not
+  let rjId = journalId rs
+      wjId = journalId ws
+  openJournal rs >>= \case
+    Left path -> do
+      logError $ "STORE ERROR no read file " <> T.pack path <> ", creating new file"
+      rh <- createNewJournal dir rjId
+      let st' = newMsgQueueState rjId
+      pure (st', rh, Nothing)
+    Right rh
+      | rjId == wjId -> do
+          st' <- fixWriteFileSize rh
+          pure (st', rh, Nothing)
+      | otherwise ->
+          openJournal ws >>= \case
+            Left path -> do
+              logError $ "STORE ERROR no write file " <> T.pack path <> ", creating new file"
+              wh <- createNewJournal dir wjId
+              let size' = msgCount rs + msgPos rs
+                  st' = st {writeState = newJournalState wjId, size = size'} -- we don't amend canWrite to trigger QCONT
+              pure (st', rh, Just wh)
+            Right wh -> do
+              st' <- fixWriteFileSize wh
+              pure (st', rh, Just wh)
+  where
+    openJournal JournalState {journalId} =
+      let path = journalFilePath dir journalId
+       in ifM (doesFileExist path) (Right <$> openFile path ReadWriteMode) (pure $ Left path)
+    fixWriteFileSize h = do
+      let sz = fromIntegral $ bytePos ws
+      sz' <- IO.hFileSize h
+      if
+        | sz' > sz -> logWarn "STORE WARNING" >> IO.hSetFileSize h sz $> st
+        | sz' == sz -> pure st
+        | otherwise -> pure st -- TODO re-read file to recover what is possible ???
+
+removeJournal :: FilePath -> JournalState -> IO ()
+removeJournal dir JournalState {journalId} = do
+  let path = journalFilePath dir journalId
+  removeFile path `catchAny` (\e -> logError $ "STORE ERROR removing file " <> T.pack path <> ": " <> tshow e)
+
+-- This function is supposed to be resilient to crashes while updating state files,
+-- and also resilient to crashes during its execution.
+readWriteQueueState :: JournalMsgStore -> FilePath -> IO (MsgQueueState, Handle)
+readWriteQueueState JournalMsgStore {random, config} statePath =
+  ifM
+    (doesFileExist tempBackup)
+    (renameFile tempBackup statePath >> readQueueState)
+    (ifM (doesFileExist statePath) readQueueState writeNewQueueState)
+  where
+    tempBackup = statePath <> ".bak"
+    readQueueState = do
+      ls <- LB.lines <$> LB.readFile statePath
+      case ls of
+        [] -> writeNewQueueState
+        _ -> useLastLine (length ls) True ls
+    writeNewQueueState = do
+      logWarn $ "STORE WARNING: empty queue state in " <> T.pack statePath <> ", initialized"
+      st <- newMsgQueueState <$> newJournalId random
+      writeQueueState st
+    useLastLine len isLastLine ls = case strDecode $ LB.toStrict $ last ls of
+      Right st
+        | len > maxStateLines config || not isLastLine ->
+            backupWriteQueueState st
+        | otherwise -> do
+            -- when state file has fewer than maxStateLines, we don't compact it
+            sh <- openFile statePath AppendMode
+            pure (st, sh)
+      Left e -- if the last line failed to parse
+        | isLastLine -> case init ls of -- or use the previous line
+            [] -> do
+              logWarn $ "STORE WARNING: invalid 1-line queue state " <> T.pack statePath <> ", initialized"
+              st <- newMsgQueueState <$> newJournalId random
+              backupWriteQueueState st
+            ls' -> do
+              logWarn $ "STORE WARNING: invalid last line in queue state " <> T.pack statePath <> ", using the previous line"
+              useLastLine len False ls'
+        | otherwise -> do
+            logError $ "STORE ERROR invalid queue state in " <> T.pack statePath <> ": " <> tshow e
+            E.throwIO $ userError $ "Error reading queue state " <> statePath <> ": " <> show e
+    backupWriteQueueState st = do
+      -- State backup is made in two steps to mitigate the crash during the backup.
+      -- Temporary backup file will be used when it is present.
+      renameFile statePath tempBackup -- 1) temp backup
+      r <- writeQueueState st -- 2) save state
+      ts <- getCurrentTime
+      renameFile tempBackup (statePath <> "." <> iso8601Show ts <> ".bak") -- 3) timed backup
+      pure r
+    writeQueueState st = do
+      sh <- openFile statePath AppendMode
+      logQueueState sh st
+      pure (st, sh)
+
+closeMsgQueue :: JournalMsgStore -> RecipientId -> IO (Maybe (TVar MsgQueueState))
+closeMsgQueue st rId =
+  atomically (TM.lookupDelete rId (msgQueues st))
+    >>= mapM (\q -> closeMsgQueue_ q $> state q)
+
+closeMsgQueue_ :: JournalMsgQueue -> IO ()
+closeMsgQueue_ q = readTVarIO (handles q) >>= mapM_ closeHandles
+  where
+    closeHandles (MsgQueueHandles sh rh wh_) = do
+      hClose sh
+      hClose rh
+      mapM_ hClose wh_
+
+removeQueueDirectory :: JournalMsgStore -> RecipientId -> IO ()
+removeQueueDirectory st rId =
+  let dir = msgQueueDirectory st rId
+   in removePathForcibly dir `catchAny` (\e -> logError $ "STORE ERROR removeQueueDirectory " <> T.pack dir <> ": " <> tshow e)
+
+hAppend :: Handle -> ByteString -> IO ()
+hAppend h s = IO.hSeek h SeekFromEnd 0 >> B.hPutStr h s
+
+hGetLineAt :: Handle -> Int -> IO ByteString
+hGetLineAt h pos = IO.hSeek h AbsoluteSeek (fromIntegral pos) >> B.hGetLine h
+
+openFile :: FilePath -> IOMode -> IO Handle
+openFile f mode = do
+  h <- IO.openFile f mode
+  IO.hSetBuffering h LineBuffering
+  pure h
+
+hClose :: Handle -> IO ()
+hClose h = IO.hClose h `catchAny` (\e -> logError $ "Error closing file" <> tshow e)
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index de994c17a..df4507175 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -1,129 +1,126 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Simplex.Messaging.Server.MsgStore.STM
-  ( STMMsgStore,
-    MsgQueue (msgQueue),
-    newMsgStore,
-    getMsgQueue,
-    delMsgQueue,
-    delMsgQueueSize,
-    writeMsg,
-    tryPeekMsg,
-    tryPeekMsgIO,
-    tryDelMsg,
-    tryDelPeekMsg,
-    deleteExpiredMsgs,
-    getQueueSize,
+  ( STMMsgStore (..),
+    STMMsgQueue (msgQueue),
+    STMStoreConfig (..),
   )
 where
 
-import qualified Data.ByteString.Char8 as B
+import Control.Concurrent.STM
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
 import Data.Functor (($>))
-import Data.Int (Int64)
-import Data.Time.Clock.System (SystemTime (systemSeconds))
-import Simplex.Messaging.Protocol (Message (..), MsgId, RecipientId)
+import Simplex.Messaging.Protocol (ErrorType, Message (..), RecipientId)
+import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import UnliftIO.STM
 
-data MsgQueue = MsgQueue
+data STMMsgQueue = STMMsgQueue
   { msgQueue :: TQueue Message,
     quota :: Int,
     canWrite :: TVar Bool,
     size :: TVar Int
   }
 
-type STMMsgStore = TMap RecipientId MsgQueue
+data STMMsgStore = STMMsgStore
+  { storeConfig :: STMStoreConfig,
+    msgQueues :: TMap RecipientId STMMsgQueue
+  }
 
-newMsgStore :: IO STMMsgStore
-newMsgStore = TM.emptyIO
+data STMStoreConfig = STMStoreConfig
+  { storePath :: Maybe FilePath,
+    quota :: Int
+  }
 
--- The reason for double lookup is that majority of messaging queues exist,
--- because multiple messages are sent to the same queue,
--- so the first lookup without STM transaction will return the queue faster.
--- In case the queue does not exist, it needs to be looked-up again inside transaction.
-getMsgQueue :: STMMsgStore -> RecipientId -> Int -> IO MsgQueue
-getMsgQueue st rId quota = TM.lookupIO rId st >>= maybe (atomically maybeNewQ) pure
-  where
-    maybeNewQ = TM.lookup rId st >>= maybe newQ pure
-    newQ = do
-      msgQueue <- newTQueue
-      canWrite <- newTVar True
-      size <- newTVar 0
-      let q = MsgQueue {msgQueue, quota, canWrite, size}
-      TM.insert rId q st
-      pure q
+instance MsgStoreClass STMMsgStore where
+  type StoreMonad STMMsgStore = STM
+  type MsgQueue STMMsgStore = STMMsgQueue
+  type MsgStoreConfig STMMsgStore = STMStoreConfig
 
-delMsgQueue :: STMMsgStore -> RecipientId -> IO ()
-delMsgQueue st rId = atomically $ TM.delete rId st
+  newMsgStore :: STMStoreConfig -> IO STMMsgStore
+  newMsgStore storeConfig = do
+    msgQueues <- TM.emptyIO
+    pure STMMsgStore {storeConfig, msgQueues}
 
-delMsgQueueSize :: STMMsgStore -> RecipientId -> IO Int
-delMsgQueueSize st rId = atomically (TM.lookupDelete rId st) >>= maybe (pure 0) (\MsgQueue {size} -> readTVarIO size)
+  closeMsgStore _ = pure ()
 
-writeMsg :: MsgQueue -> Message -> IO (Maybe (Message, Bool))
-writeMsg MsgQueue {msgQueue = q, quota, canWrite, size} !msg = atomically $ do
-  canWrt <- readTVar canWrite
-  empty <- isEmptyTQueue q
-  if canWrt || empty
-    then do
-      canWrt' <- (quota >) <$> readTVar size
-      writeTVar canWrite $! canWrt'
-      modifyTVar' size (+ 1)
-      if canWrt'
-        then writeTQueue q msg $> Just (msg, empty)
-        else (writeTQueue q $! msgQuota) $> Nothing
-    else pure Nothing
-  where
-    msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
+  activeMsgQueues = msgQueues
+  {-# INLINE activeMsgQueues #-}
 
-tryPeekMsgIO :: MsgQueue -> IO (Maybe Message)
-tryPeekMsgIO = atomically . tryPeekTQueue . msgQueue
-{-# INLINE tryPeekMsgIO #-}
+  withAllMsgQueues = withActiveMsgQueues
+  {-# INLINE withAllMsgQueues #-}
 
--- TODO remove once deliverToSub is split
-tryPeekMsg :: MsgQueue -> STM (Maybe Message)
-tryPeekMsg = tryPeekTQueue . msgQueue
-{-# INLINE tryPeekMsg #-}
+  logQueueStates _ = pure ()
 
-tryDelMsg :: MsgQueue -> MsgId -> IO (Maybe Message)
-tryDelMsg mq msgId' = atomically $
-  tryPeekMsg mq >>= \case
-    msg_@(Just msg)
-      | msgId msg == msgId' || B.null msgId' -> tryDeleteMsg_ mq >> pure msg_
-      | otherwise -> pure Nothing
-    _ -> pure Nothing
+  -- The reason for double lookup is that majority of messaging queues exist,
+  -- because multiple messages are sent to the same queue,
+  -- so the first lookup without STM transaction will return the queue faster.
+  -- In case the queue does not exist, it needs to be looked-up again inside transaction.
+  getMsgQueue :: STMMsgStore -> RecipientId -> ExceptT ErrorType IO STMMsgQueue
+  getMsgQueue STMMsgStore {msgQueues = qs, storeConfig = STMStoreConfig {quota}} rId =
+    liftIO $ TM.lookupIO rId qs >>= maybe (atomically maybeNewQ) pure
+    where
+      maybeNewQ = TM.lookup rId qs >>= maybe newQ pure
+      newQ = do
+        msgQueue <- newTQueue
+        canWrite <- newTVar True
+        size <- newTVar 0
+        let q = STMMsgQueue {msgQueue, quota, canWrite, size}
+        TM.insert rId q qs
+        pure q
 
--- atomic delete (== read) last and peek next message if available
-tryDelPeekMsg :: MsgQueue -> MsgId -> IO (Maybe Message, Maybe Message)
-tryDelPeekMsg mq msgId' = atomically $
-  tryPeekMsg mq >>= \case
-    msg_@(Just msg)
-      | msgId msg == msgId' || B.null msgId' -> (msg_,) <$> (tryDeleteMsg_ mq >> tryPeekMsg mq)
-      | otherwise -> pure (Nothing, msg_)
-    _ -> pure (Nothing, Nothing)
+  delMsgQueue :: STMMsgStore -> RecipientId -> IO ()
+  delMsgQueue st rId = atomically $ TM.delete rId $ msgQueues st
 
-deleteExpiredMsgs :: MsgQueue -> Int64 -> IO Int
-deleteExpiredMsgs mq old = atomically $ loop 0
-  where
-    loop dc =
-      tryPeekMsg mq >>= \case
-        Just Message {msgTs}
-          | systemSeconds msgTs < old ->
-              tryDeleteMsg_ mq >> loop (dc + 1)
-        _ -> pure dc
+  delMsgQueueSize :: STMMsgStore -> RecipientId -> IO Int
+  delMsgQueueSize st rId = atomically (TM.lookupDelete rId $ msgQueues st) >>= maybe (pure 0) (\STMMsgQueue {size} -> readTVarIO size)
 
-tryDeleteMsg_ :: MsgQueue -> STM ()
-tryDeleteMsg_ MsgQueue {msgQueue = q, size} =
-  tryReadTQueue q >>= \case
-    Just _ -> modifyTVar' size (subtract 1)
-    _ -> pure ()
+  getQueueMessages :: Bool -> STMMsgQueue -> IO [Message]
+  getQueueMessages drainMsgs = atomically . (if drainMsgs then flushTQueue else snapshotTQueue) . msgQueue
+    where
+      snapshotTQueue q = do
+        msgs <- flushTQueue q
+        mapM_ (writeTQueue q) msgs
+        pure msgs
 
-getQueueSize :: MsgQueue -> IO Int
-getQueueSize MsgQueue {size} = readTVarIO size
+  writeMsg :: STMMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  writeMsg STMMsgQueue {msgQueue = q, quota, canWrite, size} _logState !msg = liftIO $ atomically $ do
+    canWrt <- readTVar canWrite
+    empty <- isEmptyTQueue q
+    if canWrt || empty
+      then do
+        canWrt' <- (quota >) <$> readTVar size
+        writeTVar canWrite $! canWrt'
+        modifyTVar' size (+ 1)
+        if canWrt'
+          then writeTQueue q msg $> Just (msg, empty)
+          else (writeTQueue q $! msgQuota) $> Nothing
+      else pure Nothing
+    where
+      msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
+
+  getQueueSize :: STMMsgQueue -> IO Int
+  getQueueSize STMMsgQueue {size} = readTVarIO size
+
+  tryPeekMsg_ :: STMMsgQueue -> STM (Maybe Message)
+  tryPeekMsg_ = tryPeekTQueue . msgQueue
+  {-# INLINE tryPeekMsg_ #-}
+
+  tryDeleteMsg_ :: STMMsgQueue -> STM ()
+  tryDeleteMsg_ STMMsgQueue {msgQueue = q, size} =
+    tryReadTQueue q >>= \case
+      Just _ -> modifyTVar' size (subtract 1)
+      _ -> pure ()
+
+  atomicQueue :: STMMsgQueue -> String -> STM a -> ExceptT ErrorType IO a
+  atomicQueue _ _ = liftIO . atomically
diff --git a/src/Simplex/Messaging/Server/MsgStore/Types.hs b/src/Simplex/Messaging/Server/MsgStore/Types.hs
new file mode 100644
index 000000000..68693883d
--- /dev/null
+++ b/src/Simplex/Messaging/Server/MsgStore/Types.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+
+module Simplex.Messaging.Server.MsgStore.Types where
+
+import Control.Concurrent.STM
+import Control.Monad.Trans.Except
+import Data.Int (Int64)
+import Data.Kind
+import qualified Data.Map.Strict as M
+import Data.Time.Clock.System (SystemTime (systemSeconds))
+import Simplex.Messaging.Protocol (ErrorType, Message (..), MsgId, RecipientId)
+import Simplex.Messaging.TMap (TMap)
+
+class Monad (StoreMonad s) => MsgStoreClass s where
+  type StoreMonad s = (m :: Type -> Type) | m -> s
+  type MsgStoreConfig s = c | c -> s
+  type MsgQueue s = q | q -> s
+  newMsgStore :: MsgStoreConfig s -> IO s
+  closeMsgStore :: s -> IO ()
+  activeMsgQueues :: s -> TMap RecipientId (MsgQueue s)
+  withAllMsgQueues :: s -> (RecipientId -> MsgQueue s -> IO Int) -> IO Int
+  logQueueStates :: s -> IO ()
+  getMsgQueue :: s -> RecipientId -> ExceptT ErrorType IO (MsgQueue s)
+  delMsgQueue :: s -> RecipientId -> IO ()
+  delMsgQueueSize :: s -> RecipientId -> IO Int
+  getQueueMessages :: Bool -> MsgQueue s -> IO [Message]
+  writeMsg :: MsgQueue s -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  getQueueSize :: MsgQueue s -> IO Int
+  tryPeekMsg_ :: MsgQueue s -> StoreMonad s (Maybe Message)
+  tryDeleteMsg_ :: MsgQueue s -> StoreMonad s ()
+  atomicQueue :: MsgQueue s -> String -> StoreMonad s a -> ExceptT ErrorType IO a
+
+data MSType = MSMemory | MSJournal
+
+data SMSType :: MSType -> Type where
+  SMSMemory :: SMSType 'MSMemory
+  SMSJournal :: SMSType 'MSJournal
+
+data AMSType = forall s. AMSType (SMSType s)
+
+withActiveMsgQueues :: MsgStoreClass s => s -> (RecipientId -> MsgQueue s -> IO Int) -> IO Int
+withActiveMsgQueues st f = readTVarIO (activeMsgQueues st) >>= M.foldrWithKey (\k v -> ((+) <$> f k v <*>)) (pure 0)
+
+tryPeekMsg :: MsgStoreClass s => MsgQueue s -> ExceptT ErrorType IO (Maybe Message)
+tryPeekMsg mq = atomicQueue mq "tryPeekMsg" $ tryPeekMsg_ mq
+{-# INLINE tryPeekMsg #-}
+
+tryDelMsg :: MsgStoreClass s => MsgQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message)
+tryDelMsg mq msgId' =
+  atomicQueue mq "tryDelMsg" $
+    tryPeekMsg_ mq >>= \case
+      msg_@(Just msg)
+        | msgId msg == msgId' ->
+            tryDeleteMsg_ mq >> pure msg_
+      _ -> pure Nothing
+
+-- atomic delete (== read) last and peek next message if available
+tryDelPeekMsg :: MsgStoreClass s => MsgQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
+tryDelPeekMsg mq msgId' =
+  atomicQueue mq "tryDelPeekMsg" $
+    tryPeekMsg_ mq >>= \case
+      msg_@(Just msg)
+        | msgId msg == msgId' -> (msg_,) <$> (tryDeleteMsg_ mq >> tryPeekMsg_ mq)
+        | otherwise -> pure (Nothing, msg_)
+      _ -> pure (Nothing, Nothing)
+
+deleteExpiredMsgs :: MsgStoreClass s => MsgQueue s -> Int64 -> ExceptT ErrorType IO Int
+deleteExpiredMsgs mq old = atomicQueue mq "deleteExpiredMsgs" $ loop 0
+  where
+    loop dc =
+      tryPeekMsg_ mq >>= \case
+        Just Message {msgTs}
+          | systemSeconds msgTs < old ->
+              tryDeleteMsg_ mq >> loop (dc + 1)
+        _ -> pure dc
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index fde54ab01..ea0322b74 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -14,11 +14,13 @@ import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Int (Int64)
 import Data.IORef
+import Data.Int (Int64)
 import Data.List (groupBy, sortOn)
 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.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
@@ -185,3 +187,7 @@ encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
 
 decodeJSON :: FromJSON a => Text -> Maybe a
 decodeJSON = J.decode . LB.fromStrict . encodeUtf8
+
+traverseWithKey_ :: Monad m => (k -> v -> m ()) -> Map k v -> m ()
+traverseWithKey_ f = M.foldrWithKey (\k v -> (f k v >>)) (pure ())
+{-# INLINE traverseWithKey_ #-}
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 86a6651f4..38a187ec5 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -77,7 +77,7 @@ import Data.Word (Word16)
 import qualified Database.SQLite.Simple as SQL
 import GHC.Stack (withFrozenCallStack)
 import SMPAgentClient
-import SMPClient (cfg, prevRange, prevVersion, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerOn, withSmpServerProxy, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
+import SMPClient (cfg, prevRange, prevVersion, testPort, testPort2, testStoreLogFile2, testStoreMsgsDir2, withSmpServer, withSmpServerConfigOn, withSmpServerProxy, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import qualified Simplex.Messaging.Agent as A
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), ServerQueueInfo (..), UserNetworkInfo (..), UserNetworkType (..), waitForUserNetwork)
@@ -96,6 +96,7 @@ import Simplex.Messaging.Protocol (BasicAuth, ErrorType (..), MsgBody, ProtocolS
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Server.Expiration
+import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..))
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, basicAuthSMPVersion, batchCmdsSMPVersion, currentServerSMPRelayVersion, sndAuthKeySMPVersion, supportedSMPHandshakes)
 import Simplex.Messaging.Util (bshow, diffToMicroseconds)
@@ -530,7 +531,7 @@ testRatchetMatrix2 t runTest = do
 testServerMatrix2 :: HasCallStack => ATransport -> (InitialAgentServers -> IO ()) -> Spec
 testServerMatrix2 t runTest = do
   it "1 server" $ withSmpServer t $ runTest initAgentServers
-  it "2 servers" $ withSmpServer t . withSmpServerOn t testPort2 $ runTest initAgentServers2
+  it "2 servers" $ withSmpServer t $ withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2, storeMsgsFile = Just testStoreMsgsDir2} testPort2 $ \_ -> runTest initAgentServers2
 
 testPQMatrix2 :: HasCallStack => ATransport -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
 testPQMatrix2 = pqMatrix2_ True
@@ -1282,7 +1283,7 @@ testSkippedMessages :: HasCallStack => ATransport -> IO ()
 testSkippedMessages t = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
-  (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \_ -> do
+  (aliceId, bobId) <- withSmpServerConfigOn t cfg' testPort $ \_ -> do
     (aliceId, bobId) <- runRight $ makeConnection alice bob
     runRight_ $ do
       2 <- sendMessage alice bobId SMP.noMsgFlags "hello"
@@ -1310,7 +1311,7 @@ testSkippedMessages t = do
   alice2 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB
   bob2 <- getSMPAgentClient' 4 agentCfg initAgentServers testDB2
 
-  withSmpServerStoreLogOn t testPort $ \_ -> do
+  withSmpServerConfigOn t cfg' testPort $ \_ -> do
     runRight_ $ do
       subscribeConnection bob2 aliceId
       subscribeConnection alice2 bobId
@@ -1326,6 +1327,8 @@ testSkippedMessages t = do
       ackMessage bob2 aliceId 4 Nothing
   disposeAgentClient alice2
   disposeAgentClient bob2
+  where
+    cfg' = cfg {msgStoreType = AMSType SMSMemory, storeMsgsFile = Nothing}
 
 testDeliveryAfterSubscriptionError :: HasCallStack => ATransport -> IO ()
 testDeliveryAfterSubscriptionError t = do
@@ -1429,7 +1432,7 @@ withUP a bId p =
       ]
 
 testExpireMessageQuota :: HasCallStack => ATransport -> IO ()
-testExpireMessageQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1} testPort $ \_ -> do
+testExpireMessageQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1, maxJournalMsgCount = 2} testPort $ \_ -> do
   a <- getSMPAgentClient' 1 agentCfg {quotaExceededTimeout = 1, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB
   b <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
   (aId, bId) <- runRight $ do
@@ -1455,7 +1458,7 @@ testExpireMessageQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1} testP
   disposeAgentClient a
 
 testExpireManyMessagesQuota :: ATransport -> IO ()
-testExpireManyMessagesQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1} testPort $ \_ -> do
+testExpireManyMessagesQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1, maxJournalMsgCount = 2} testPort $ \_ -> do
   a <- getSMPAgentClient' 1 agentCfg {quotaExceededTimeout = 2, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB
   b <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
   (aId, bId) <- runRight $ do
@@ -2356,7 +2359,7 @@ testJoinConnectionAsyncReplyErrorV8 t = do
         ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
         pure (aId, bId)
       nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
-      withSmpServerOn t testPort2 $ do
+      withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2, storeMsgsFile = Just testStoreMsgsDir2} testPort2 $ \_ -> do
         get b =##> \case ("2", c, JOINED sqSecured) -> c == aId && not sqSecured; _ -> False
         confId <- withSmpServerStoreLogOn t testPort $ \_ -> do
           pGet a >>= \case
@@ -2395,7 +2398,7 @@ testJoinConnectionAsyncReplyError t = do
         ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
         pure (aId, bId)
       nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
-      withSmpServerOn t testPort2 $ do
+      withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2, storeMsgsFile = Just testStoreMsgsDir2} testPort2 $ \_ -> do
         confId <- withSmpServerStoreLogOn t testPort $ \_ -> do
           -- both servers need to be online for connection to progress because of SKEY
           get b =##> \case ("2", c, JOINED sqSecured) -> c == aId && sqSecured; _ -> False
@@ -2974,7 +2977,7 @@ testDeliveryReceiptsVersion t = do
 
 testDeliveryReceiptsConcurrent :: HasCallStack => ATransport -> IO ()
 testDeliveryReceiptsConcurrent t =
-  withSmpServerConfigOn t cfg {msgQueueQuota = 256} testPort $ \_ -> do
+  withSmpServerConfigOn t cfg {msgQueueQuota = 256, maxJournalMsgCount = 512} testPort $ \_ -> do
     withAgentClients2 $ \a b -> do
       (aId, bId) <- runRight $ makeConnection a b
       t1 <- liftIO getCurrentTime
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
new file mode 100644
index 000000000..150312a60
--- /dev/null
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -0,0 +1,222 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module CoreTests.MsgStoreTests where
+
+import AgentTests.FunctionalAPITests (runRight_)
+import Control.Concurrent.STM
+import Control.Exception (bracket)
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Time.Clock.System (getSystemTime)
+import Simplex.Messaging.Crypto (pattern MaxLenBS)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Protocol (EntityId (..), Message (..), noMsgFlags)
+import Simplex.Messaging.Server (exportMessages, importMessages)
+import Simplex.Messaging.Server.MsgStore.Journal
+import Simplex.Messaging.Server.MsgStore.STM
+import Simplex.Messaging.Server.MsgStore.Types
+import SMPClient (testStoreMsgsDir, testStoreMsgsDir2, testStoreMsgsFile, testStoreMsgsFile2)
+import System.Directory (copyFile, createDirectoryIfMissing, listDirectory, removeFile, renameFile)
+import System.FilePath ((</>))
+import System.IO (IOMode (..), hClose, withFile)
+import Test.Hspec
+
+msgStoreTests :: Spec
+msgStoreTests = do
+  around (withMsgStore testSMTStoreConfig) $ describe "STM message store" someMsgStoreTests
+  around (withMsgStore testJournalStoreCfg) $ describe "Journal message store" $ do
+    someMsgStoreTests
+    it "should export and import journal store" testExportImportStore
+    describe "queue state" $ do
+      it "should restore queue state from the last line" testQueueState
+  where
+    someMsgStoreTests :: MsgStoreClass s => SpecWith s
+    someMsgStoreTests = do
+      it "should get queue and store/read messages" testGetQueue
+      it "should not fail on EOF when changing read journal" testChangeReadJournal
+
+withMsgStore :: MsgStoreClass s => MsgStoreConfig s -> (s -> IO ()) -> IO ()
+withMsgStore cfg = bracket (newMsgStore cfg) closeMsgStore
+
+testSMTStoreConfig :: STMStoreConfig
+testSMTStoreConfig = STMStoreConfig {storePath = Nothing, quota = 3}
+
+testJournalStoreCfg :: JournalStoreConfig
+testJournalStoreCfg =
+  JournalStoreConfig
+    { storePath = testStoreMsgsDir,
+      pathParts = 4,
+      quota = 3,
+      maxMsgCount = 4,
+      maxStateLines = 2
+    }
+
+mkMessage :: MonadIO m => ByteString -> m Message
+mkMessage body = liftIO $ do
+  g <- C.newRandom
+  msgTs <- getSystemTime
+  msgId <- atomically $ C.randomBytes 24 g
+  pure Message {msgId, msgTs, msgFlags = noMsgFlags, msgBody = C.unsafeMaxLenBS body}
+
+pattern Msg :: ByteString -> Maybe Message
+pattern Msg s <- Just Message {msgBody = MaxLenBS s}
+
+deriving instance Eq MsgQueueState
+
+deriving instance Eq JournalState
+
+testGetQueue :: MsgStoreClass s => s -> IO ()
+testGetQueue st = do
+  g <- C.newRandom
+  rId <- EntityId <$> atomically (C.randomBytes 24 g)
+  runRight_ $ do
+    q <- getMsgQueue st rId
+    Just (Message {msgId = mId1}, True) <- writeMsg q True =<< mkMessage "message 1"
+    Just (Message {msgId = mId2}, False) <- writeMsg q True =<< mkMessage "message 2"
+    Just (Message {msgId = mId3}, False) <- writeMsg q True =<< mkMessage "message 3"
+    Msg "message 1" <- tryPeekMsg q
+    Msg "message 1" <- tryPeekMsg q
+    Nothing <- tryDelMsg q mId2
+    Msg "message 1" <- tryDelMsg q mId1
+    Nothing <- tryDelMsg q mId1
+    Msg "message 2" <- tryPeekMsg q
+    Nothing <- tryDelMsg q mId1
+    (Nothing, Msg "message 2") <- tryDelPeekMsg q mId1
+    (Msg "message 2", Msg "message 3") <- tryDelPeekMsg q mId2
+    (Nothing, Msg "message 3") <- tryDelPeekMsg q mId2
+    Msg "message 3" <- tryPeekMsg q
+    (Msg "message 3", Nothing) <- tryDelPeekMsg q mId3
+    Nothing <- tryDelMsg q mId2
+    Nothing <- tryDelMsg q mId3
+    Nothing <- tryPeekMsg q
+    Just (Message {msgId = mId4}, True) <- writeMsg q True =<< mkMessage "message 4"
+    Msg "message 4" <- tryPeekMsg q
+    Just (Message {msgId = mId5}, False) <- writeMsg q True =<< mkMessage "message 5"
+    (Nothing, Msg "message 4") <- tryDelPeekMsg q mId3
+    (Msg "message 4", Msg "message 5") <- tryDelPeekMsg q mId4
+    Just (Message {msgId = mId6}, False) <- writeMsg q True =<< mkMessage "message 6"
+    Just (Message {msgId = mId7}, False) <- writeMsg q True =<< mkMessage "message 7"
+    Nothing <- writeMsg q True =<< mkMessage "message 8"
+    Msg "message 5" <- tryPeekMsg q
+    (Nothing, Msg "message 5") <- tryDelPeekMsg q mId4
+    (Msg "message 5", Msg "message 6") <- tryDelPeekMsg q mId5
+    (Msg "message 6", Msg "message 7") <- tryDelPeekMsg q mId6
+    (Msg "message 7", Just MessageQuota {msgId = mId8}) <- tryDelPeekMsg q mId7
+    (Just MessageQuota {}, Nothing) <- tryDelPeekMsg q mId8
+    (Nothing, Nothing) <- tryDelPeekMsg q mId8
+    pure ()
+  delMsgQueue st rId
+
+testChangeReadJournal :: MsgStoreClass s => s -> IO ()
+testChangeReadJournal st = do
+  g <- C.newRandom
+  rId <- EntityId <$> atomically (C.randomBytes 24 g)
+  runRight_ $ do
+    q <- getMsgQueue st rId
+    Just (Message {msgId = mId1}, True) <- writeMsg q True =<< mkMessage "message 1"
+    (Msg "message 1", Nothing) <- tryDelPeekMsg q mId1
+    Just (Message {msgId = mId2}, True) <- writeMsg q True =<< mkMessage "message 2"
+    (Msg "message 2", Nothing) <- tryDelPeekMsg q mId2
+    Just (Message {msgId = mId3}, True) <- writeMsg q True =<< mkMessage "message 3"
+    (Msg "message 3", Nothing) <- tryDelPeekMsg q mId3
+    Just (Message {msgId = mId4}, True) <- writeMsg q True =<< mkMessage "message 4"
+    (Msg "message 4", Nothing) <- tryDelPeekMsg q mId4
+    Just (Message {msgId = mId5}, True) <- writeMsg q True =<< mkMessage "message 5"
+    (Msg "message 5", Nothing) <- tryDelPeekMsg q mId5
+    pure ()
+  delMsgQueue st rId
+
+testExportImportStore :: JournalMsgStore -> IO ()
+testExportImportStore st = do
+  g <- C.newRandom
+  rId1 <- EntityId <$> atomically (C.randomBytes 24 g)
+  rId2 <- EntityId <$> atomically (C.randomBytes 24 g)
+  runRight_ $ do
+    q1 <- getMsgQueue st rId1
+    Just (Message {}, True) <- writeMsg q1 True =<< mkMessage "message 1"
+    Just (Message {}, False) <- writeMsg q1 True =<< mkMessage "message 2"
+    q2 <- getMsgQueue st rId2
+    Just (Message {}, True) <- writeMsg q2 True =<< mkMessage "message 3"
+    Just (Message {}, False) <- writeMsg q2 True =<< mkMessage "message 4"
+    Just (Message {}, False) <- writeMsg q2 True =<< mkMessage "message 5"
+    Nothing <- writeMsg q2 True =<< mkMessage "message 6"
+    pure ()
+  length <$> listDirectory (msgQueueDirectory st rId1) `shouldReturn` 2
+  length <$> listDirectory (msgQueueDirectory st rId2) `shouldReturn` 2
+  exportMessages st testStoreMsgsFile $ getQueueMessages False
+  let cfg = (testJournalStoreCfg :: JournalStoreConfig) {storePath = testStoreMsgsDir2}
+  st' <- newMsgStore cfg
+  0 <- importMessages st' testStoreMsgsFile Nothing
+  length <$> listDirectory (msgQueueDirectory st rId1) `shouldReturn` 2
+  length <$> listDirectory (msgQueueDirectory st rId2) `shouldReturn` 3 -- state file is backed up
+  exportMessages st' testStoreMsgsFile2 $ getQueueMessages False
+  (B.readFile testStoreMsgsFile2 `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".bak")
+  stmStore <- newMsgStore testSMTStoreConfig
+  0 <- importMessages stmStore testStoreMsgsFile2 Nothing
+  exportMessages stmStore testStoreMsgsFile $ getQueueMessages False
+  (B.sort <$> B.readFile testStoreMsgsFile `shouldReturn`) =<< (B.sort <$> B.readFile (testStoreMsgsFile2 <> ".bak"))
+
+testQueueState :: JournalMsgStore -> IO ()
+testQueueState st = do
+  g <- C.newRandom
+  rId <- EntityId <$> atomically (C.randomBytes 24 g)
+  let dir = msgQueueDirectory st rId
+      statePath = dir </> (queueLogFileName <> logFileExt)
+  createDirectoryIfMissing True dir
+  state <- newMsgQueueState <$> newJournalId (random st)
+  withFile statePath WriteMode (`logQueueState` state)
+  length . lines <$> readFile statePath `shouldReturn` 1
+  readQueueState statePath `shouldReturn` state
+  length <$> listDirectory dir `shouldReturn` 1 -- no backup
+
+  let state1 = state {size = 1, writeState = (writeState state) {msgPos = 1, msgCount = 1, bytePos = 100}}
+  withFile statePath AppendMode (`logQueueState` state1)
+  length . lines <$> readFile statePath `shouldReturn` 2
+  readQueueState statePath `shouldReturn` state1
+  length <$> listDirectory dir `shouldReturn` 1 -- no backup
+
+  let state2 = state {size = 2, writeState = (writeState state) {msgPos = 2, msgCount = 2, bytePos = 200}}
+  withFile statePath AppendMode (`logQueueState` state2)
+  length . lines <$> readFile statePath `shouldReturn` 3
+  copyFile statePath (statePath <> ".2")
+  readQueueState statePath `shouldReturn` state2
+  length <$> listDirectory dir `shouldReturn` 3 -- new state, copy + backup
+  length . lines <$> readFile statePath `shouldReturn` 1
+
+  -- corrupt the only line
+  corruptFile statePath
+  newState <- readQueueState statePath
+  newState `shouldBe` newMsgQueueState (journalId $ writeState newState)
+
+  -- corrupt the last line
+  renameFile (statePath <> ".2") statePath
+  removeOtherFiles dir statePath
+  length . lines <$> readFile statePath `shouldReturn` 3
+  corruptFile statePath
+  readQueueState statePath `shouldReturn` state1
+  length <$> listDirectory dir `shouldReturn` 2
+  length . lines <$> readFile statePath `shouldReturn` 1
+  where
+    readQueueState statePath = do
+      (state, h) <- readWriteQueueState st statePath
+      hClose h
+      pure state
+    corruptFile f = do
+      s <- readFile f
+      removeFile f
+      writeFile f $ take (length s - 4) s
+    removeOtherFiles dir keep = do
+      names <- listDirectory dir
+      forM_ names $ \name ->
+        let f = dir </> name
+         in unless (f == keep) $ removeFile f
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 273cc90ad..0055e8503 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -23,6 +23,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server (runSMPServerBlocking)
 import Simplex.Messaging.Server.Env.STM
+import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..))
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
 import qualified Simplex.Messaging.Transport.Client as Client
@@ -62,6 +63,12 @@ testStoreMsgsFile = "tests/tmp/smp-server-messages.log"
 testStoreMsgsFile2 :: FilePath
 testStoreMsgsFile2 = "tests/tmp/smp-server-messages.log.2"
 
+testStoreMsgsDir :: FilePath
+testStoreMsgsDir = "tests/tmp/messages"
+
+testStoreMsgsDir2 :: FilePath
+testStoreMsgsDir2 = "tests/tmp/messages.2"
+
 testStoreNtfsFile :: FilePath
 testStoreNtfsFile = "tests/tmp/smp-server-ntfs.log"
 
@@ -105,11 +112,14 @@ cfg =
     { transports = [],
       smpHandshakeTimeout = 60000000,
       tbqSize = 1,
+      msgStoreType = AMSType SMSJournal,
       msgQueueQuota = 4,
+      maxJournalMsgCount = 5,
+      maxJournalStateLines = 2,
       queueIdBytes = 24,
       msgIdBytes = 24,
-      storeLogFile = Nothing,
-      storeMsgsFile = Nothing,
+      storeLogFile = Just testStoreLogFile,
+      storeMsgsFile = Just testStoreMsgsDir,
       storeNtfsFile = Nothing,
       allowNewQueues = True,
       newQueueBasicAuth = Nothing,
@@ -173,7 +183,7 @@ withSmpServerStoreMsgLogOn t =
     t
     cfg
       { storeLogFile = Just testStoreLogFile,
-        storeMsgsFile = Just testStoreMsgsFile,
+        storeMsgsFile = Just testStoreMsgsDir,
         storeNtfsFile = Just testStoreNtfsFile,
         serverStatsBackupFile = Just testServerStatsBackupFile
       }
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 75f1f46b3..b1bf469a3 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -135,14 +135,15 @@ smpProxyTests = do
         let deliver nAgents nMsgs = agentDeliverMessagesViaProxyConc (replicate nAgents [srv1]) (map bshow [1 :: Int .. nMsgs])
         it "25 agents, 300 pairs, 17 messages" . oneServer . withNumCapabilities 4 $ deliver 25 17
   where
-    oneServer = withSmpServerConfigOn (transport @TLS) proxyCfg {msgQueueQuota = 128} testPort . const
+    oneServer = withSmpServerConfigOn (transport @TLS) proxyCfg {msgQueueQuota = 128, maxJournalMsgCount = 256} testPort . const
     twoServers = twoServers_ proxyCfg proxyCfg
-    twoServersFirstProxy = twoServers_ proxyCfg cfgV8 {msgQueueQuota = 128}
-    twoServersMoreConc = twoServers_ proxyCfg {serverClientConcurrency = 128} cfgV8 {msgQueueQuota = 128}
-    twoServersNoConc = twoServers_ proxyCfg {serverClientConcurrency = 1} cfgV8 {msgQueueQuota = 128}
+    twoServersFirstProxy = twoServers_ proxyCfg cfgV8 {msgQueueQuota = 128, maxJournalMsgCount = 256}
+    twoServersMoreConc = twoServers_ proxyCfg {serverClientConcurrency = 128} cfgV8 {msgQueueQuota = 128, maxJournalMsgCount = 256}
+    twoServersNoConc = twoServers_ proxyCfg {serverClientConcurrency = 1} cfgV8 {msgQueueQuota = 128, maxJournalMsgCount = 256}
     twoServers_ cfg1 cfg2 runTest =
       withSmpServerConfigOn (transport @TLS) cfg1 testPort $ \_ ->
-        withSmpServerConfigOn (transport @TLS) cfg2 testPort2 $ const runTest
+        let cfg2' = cfg2 {storeLogFile = Just testStoreLogFile2, storeMsgsFile = Just testStoreMsgsDir2}
+         in withSmpServerConfigOn (transport @TLS) cfg2' testPort2 $ const runTest
 
 deliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => SMPServer -> SMPServer -> C.SAlgorithm a -> ByteString -> ByteString -> IO ()
 deliverMessageViaProxy proxyServ relayServ alg msg msg' = deliverMessagesViaProxy proxyServ relayServ alg [msg] [msg']
@@ -379,11 +380,11 @@ agentViaProxyRetryOffline = do
             ackMessage alice bobId (baseId + 4) Nothing
   where
     withServer :: (ThreadId -> IO a) -> IO a
-    withServer = withServer_ testStoreLogFile testStoreMsgsFile testStoreNtfsFile testPort
+    withServer = withServer_ testStoreLogFile testStoreMsgsDir testStoreNtfsFile testPort
     withServer2 :: (ThreadId -> IO a) -> IO a
-    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsFile2 testStoreNtfsFile2 testPort2
-    withServer_ storeLog storeMsgs storeNtfs port =
-      withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just storeLog, storeMsgsFile = Just storeMsgs, storeNtfsFile = Just storeNtfs} port
+    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsDir2 testStoreNtfsFile2 testPort2
+    withServer_ storeLog storeMsgs storeNtfs =
+      withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just storeLog, storeMsgsFile = Just storeMsgs, storeNtfsFile = Just storeNtfs}
     a `up` cId = nGet a =##> \case ("", "", UP _ [c]) -> c == cId; _ -> False
     a `down` cId = nGet a =##> \case ("", "", DOWN _ [c]) -> c == cId; _ -> False
     aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index d66f7363f..38db97f3f 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -37,10 +37,12 @@ import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Server.Expiration
+import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..))
 import Simplex.Messaging.Server.Stats (PeriodStatsData (..), ServerStatsData (..))
 import Simplex.Messaging.Transport
+import Simplex.Messaging.Util (whenM)
 import Simplex.Messaging.Version (mkVersionRange)
-import System.Directory (removeFile)
+import System.Directory (doesDirectoryExist, removeDirectoryRecursive, removeFile)
 import System.TimeIt (timeItT)
 import System.Timeout
 import Test.HUnit
@@ -64,8 +66,8 @@ serverTests t@(ATransport t') = do
     describe "GET & SUB commands" $ testGetSubCommands t'
     describe "Exceeding queue quota" $ testExceedQueueQuota t'
   describe "Store log" $ testWithStoreLog t
-  describe "Restore messages" $ testRestoreMessages t
-  describe "Restore messages (old / v2)" $ testRestoreExpireMessages t
+  xdescribe "Restore messages" $ testRestoreMessages t
+  xdescribe "Restore messages (old / v2)" $ testRestoreExpireMessages t
   describe "Timing of AUTH error" $ testTiming t
   describe "Message notifications" $ testMessageNotifications t
   describe "Message expiration" $ do
@@ -601,7 +603,8 @@ testWithStoreLog at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 6
 
-    withSmpServerThreadOn at testPort . runTest t $ \h -> do
+    let cfg' = cfg {msgStoreType = AMSType SMSMemory, storeLogFile = Nothing, storeMsgsFile = Nothing}
+    withSmpServerConfigOn at cfg' testPort . runTest t $ \h -> do
       sId1 <- readTVarIO senderId1
       -- fails if store log is disabled
       Resp "bcda" _ (ERR AUTH) <- signSendRecv h sKey1 ("bcda", sId1, _SEND "hello")
@@ -646,6 +649,7 @@ testRestoreMessages at@(ATransport t) =
   it "should store messages on exit and restore on start" $ do
     removeFileIfExists testStoreLogFile
     removeFileIfExists testStoreMsgsFile
+    whenM (doesDirectoryExist testStoreMsgsDir) $ removeDirectoryRecursive testStoreMsgsDir
     removeFileIfExists testServerStatsBackupFile
 
     g <- C.newRandom
@@ -679,7 +683,7 @@ testRestoreMessages at@(ATransport t) =
     rId <- readTVarIO recipientId
 
     logSize testStoreLogFile `shouldReturn` 2
-    logSize testStoreMsgsFile `shouldReturn` 5
+    -- logSize testStoreMsgsFile `shouldReturn` 5
     logSize testServerStatsBackupFile `shouldReturn` 74
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
@@ -697,7 +701,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
-    logSize testStoreMsgsFile `shouldReturn` 3
+    -- logSize testStoreMsgsFile `shouldReturn` 3
     logSize testServerStatsBackupFile `shouldReturn` 74
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
@@ -714,15 +718,15 @@ testRestoreMessages at@(ATransport t) =
       (dec mId6 msg6, Left "ClientRcvMsgQuota") #== "restored message delivered"
       Resp "7" _ OK <- signSendRecv h rKey ("7", rId, ACK mId6)
       pure ()
-
     logSize testStoreLogFile `shouldReturn` 1
-    logSize testStoreMsgsFile `shouldReturn` 0
+    -- logSize testStoreMsgsFile `shouldReturn` 0
     logSize testServerStatsBackupFile `shouldReturn` 74
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
 
     removeFile testStoreLogFile
-    removeFile testStoreMsgsFile
+    removeFileIfExists testStoreMsgsFile
+    whenM (doesDirectoryExist testStoreMsgsDir) $ removeDirectoryRecursive testStoreMsgsDir
     removeFile testServerStatsBackupFile
   where
     runTest :: Transport c => TProxy c -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
@@ -780,7 +784,7 @@ testRestoreExpireMessages at@(ATransport t) =
     length (B.lines msgs) `shouldBe` 4
 
     let expCfg1 = Just ExpirationConfig {ttl = 86400, checkInterval = 43200}
-        cfg1 = cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, messageExpiration = expCfg1, serverStatsBackupFile = Just testServerStatsBackupFile}
+        cfg1 = cfg {messageExpiration = expCfg1, serverStatsBackupFile = Just testServerStatsBackupFile}
     withSmpServerConfigOn at cfg1 testPort . runTest t $ \_ -> pure ()
 
     logSize testStoreLogFile `shouldReturn` 1
@@ -788,14 +792,14 @@ testRestoreExpireMessages at@(ATransport t) =
     msgs' `shouldBe` msgs
 
     let expCfg2 = Just ExpirationConfig {ttl = 2, checkInterval = 43200}
-        cfg2 = cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, messageExpiration = expCfg2, serverStatsBackupFile = Just testServerStatsBackupFile}
+        cfg2 = cfg {messageExpiration = expCfg2, serverStatsBackupFile = Just testServerStatsBackupFile}
     withSmpServerConfigOn at cfg2 testPort . runTest t $ \_ -> pure ()
 
     logSize testStoreLogFile `shouldReturn` 1
     -- two messages expired
-    msgs'' <- B.readFile testStoreMsgsFile
-    length (B.lines msgs'') `shouldBe` 2
-    B.lines msgs'' `shouldBe` drop 2 (B.lines msgs)
+    -- msgs'' <- B.readFile testStoreMsgsFile
+    -- length (B.lines msgs'') `shouldBe` 2
+    -- B.lines msgs'' `shouldBe` drop 2 (B.lines msgs)
     Right ServerStatsData {_msgExpired} <- strDecode <$> B.readFile testServerStatsBackupFile
     _msgExpired `shouldBe` 2
   where
diff --git a/tests/Test.hs b/tests/Test.hs
index bb1896be4..89672cd4f 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -11,6 +11,7 @@ import CoreTests.BatchingTests
 import CoreTests.CryptoFileTests
 import CoreTests.CryptoTests
 import CoreTests.EncodingTests
+import CoreTests.MsgStoreTests
 import CoreTests.RetryIntervalTests
 import CoreTests.SOCKSSettings
 import CoreTests.StoreLogTests
@@ -53,6 +54,7 @@ main = do
           describe "Version range" versionRangeTests
           describe "Encryption tests" cryptoTests
           describe "Encrypted files tests" cryptoFileTests
+          describe "Message store tests" msgStoreTests
           describe "Retry interval tests" retryIntervalTests
           describe "SOCKS settings tests" socksSettingsTests
           describe "Store log tests" storeLogTests

From dc17402896138fc4b420c72414082a6bea20231c Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 21 Oct 2024 16:50:07 +0100
Subject: [PATCH 167/195] smp server: updated journal store API (#1374)

* core: updated journal store API

* parameterize JournalState by read/write type

* collect stats when importing/expiring

* compare stored stats and store for messages and notifications

* simplify
---
 src/Simplex/Messaging/Server.hs               | 154 ++++++++-----
 src/Simplex/Messaging/Server/Main.hs          |   5 +-
 .../Messaging/Server/MsgStore/Journal.hs      | 213 ++++++++++--------
 src/Simplex/Messaging/Server/MsgStore/STM.hs  |   8 +-
 .../Messaging/Server/MsgStore/Types.hs        |  18 +-
 tests/AgentTests/FunctionalAPITests.hs        |   5 +-
 tests/CoreTests/MsgStoreTests.hs              |  93 ++++----
 7 files changed, 292 insertions(+), 204 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 3e8f556b5..214cd0790 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -32,11 +32,13 @@ module Simplex.Messaging.Server
     runSMPServerBlocking,
     importMessages,
     exportMessages,
+    printMessageStats,
     disconnectTransport,
     verifyCmdAuthorization,
     dummyVerifyCmd,
     randomId,
     AttachHTTP,
+    MessageStats (..),
   )
 where
 
@@ -91,6 +93,7 @@ import Simplex.Messaging.Server.Control
 import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
+import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgQueue (..), closeMsgQueue)
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.NtfStore
@@ -139,13 +142,24 @@ runSMPServerBlocking started cfg attachHTTP_ = newEnv cfg >>= runReaderT (smpSer
 type M a = ReaderT Env IO a
 type AttachHTTP = Socket -> TLS.Context -> IO ()
 
+data MessageStats = MessageStats
+  { storedMsgsCount :: Int,
+    expiredMsgsCount :: Int,
+    storedQueues :: Int
+  }
+
+newMessageStats :: MessageStats
+newMessageStats = MessageStats 0 0 0
+
 smpServer :: TMVar Bool -> ServerConfig -> Maybe AttachHTTP -> M ()
 smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHTTP_ = do
   s <- asks server
   pa <- asks proxyAgent
-  expiredMsgs <- restoreServerMessages
-  expiredNtfs <- restoreServerNtfs
-  restoreServerStats expiredMsgs expiredNtfs
+  msgStats <- restoreServerMessages
+  ntfStats <- restoreServerNtfs
+  liftIO $ printMessageStats "messages" msgStats
+  liftIO $ printMessageStats "notifications" ntfStats
+  restoreServerStats msgStats ntfStats
   raceAny_
     ( serverThread s "server subscribedQ" subscribedQ subscribers subClients pendingSubEvents subscriptions cancelSub
         : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubClients pendingNtfSubEvents ntfSubscriptions (\_ -> pure ())
@@ -366,9 +380,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
       liftIO $ forever $ do
         threadDelay' interval
         old <- expireBeforeEpoch expCfg
-        void $ withActiveMsgQueues ms $ \_ q -> do
+        void $ withActiveMsgQueues ms (\_ -> expireQueueMsgs stats old) 0
+      where
+        expireQueueMsgs stats old q acc =
           runExceptT (deleteExpiredMsgs q old) >>= \case
-            Right deleted -> deleted <$ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
+            Right deleted -> (acc + deleted) <$ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
             Left _ -> pure 0
 
     expireNtfsThread :: ServerConfig -> M ()
@@ -1435,7 +1451,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                         q <- getMsgQueue ms $ recipientId qr
                         expireMessages q messageExpiration stats
                         msg <- liftIO $ mkMessage msgId body
-                        writeMsg q True msg
+                        writeMsg ms q True msg
                       case msg_ of
                         Left e -> pure $ err e
                         Right Nothing -> do
@@ -1722,21 +1738,47 @@ saveServerMessages drainMsgs =
 exportMessages :: MsgStoreClass s => s -> FilePath -> (MsgQueue s -> IO [Message]) -> IO ()
 exportMessages ms f getMessages = do
   logInfo $ "saving messages to file " <> T.pack f
-  total <- liftIO $ withFile f WriteMode $ withAllMsgQueues ms . saveQueueMsgs
+  total <- liftIO $ withFile f WriteMode $ \h -> withAllMsgQueues ms (saveQueueMsgs h) 0
   logInfo $ "messages saved: " <> tshow total
   where
-    saveQueueMsgs h rId q = getMessages q >>= \msgs -> length msgs <$ BLD.hPutBuilder h (encodeMessages rId msgs)
+    saveQueueMsgs h rId q acc = getMessages q >>= \msgs -> (acc + length msgs) <$ BLD.hPutBuilder h (encodeMessages rId msgs)
     encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
 
-restoreServerMessages :: M Int
-restoreServerMessages =
-  asks msgStore >>= \case
-    AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath = Just f}} -> do
-      old_ <- asks (messageExpiration . config) $>>= (liftIO . fmap Just . expireBeforeEpoch)
-      liftIO $ ifM (doesFileExist f) (importMessages ms f old_) (pure 0)
-    _ -> logInfo "using journal message storage" $> 0
+restoreServerMessages :: M MessageStats
+restoreServerMessages = do
+  old_ <- asks (messageExpiration . config) $>>= (liftIO . fmap Just . expireBeforeEpoch)
+  asks msgStore >>= liftIO . processMessages old_
+    where
+      processMessages :: Maybe Int64 -> AMsgStore -> IO MessageStats
+      processMessages old_ = \case
+        AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
+          Just f -> ifM (doesFileExist f) (importMessages ms f old_) (pure newMessageStats)
+          Nothing -> pure newMessageStats
+        AMS SMSJournal ms -> case old_ of
+          Just old -> do
+            logInfo "expiring journal store messages..."
+            (storedMsgsCount, expiredMsgsCount, storedQueues) <- withAllMsgQueues ms (\_ -> processExpireQueue old) (0, 0, 0)
+            pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues}
+          Nothing -> do
+            logInfo "validating journal store messages..."
+            (storedMsgsCount, storedQueues) <- withAllMsgQueues ms (\_ -> processValidateQueue) (0, 0)
+            pure MessageStats {storedMsgsCount, expiredMsgsCount = 0, storedQueues}
+        where
+          processExpireQueue old q (!stored, !expired, !qCount) =
+            runExceptT expireQueue >>= \case
+              Right (stored', expired') -> pure (stored + stored', expired + expired', qCount + 1)
+              Left e -> do
+                logInfo $ "failed expiring messages in queue " <> T.pack (queueDirectory q) <> ": " <> tshow e
+                exitFailure
+            where
+              expireQueue = do
+                expired'' <- deleteExpiredMsgs q old
+                stored'' <- liftIO $ getQueueSize q
+                liftIO $ closeMsgQueue q
+                pure (stored'', expired'')
+          processValidateQueue q (!stored, !qCount) = getQueueSize q >>= \stored' -> pure (stored + stored', qCount + 1)
 
-importMessages :: MsgStoreClass s => s -> FilePath -> Maybe Int64 -> IO Int
+importMessages :: MsgStoreClass s => s -> FilePath -> Maybe Int64 -> IO MessageStats
 importMessages ms f old_ = do
   logInfo $ "restoring messages from file " <> T.pack f
   LB.readFile f >>= runExceptT . foldM restoreMsg (0, 0, 0) . zip [0..] . LB.lines >>= \case
@@ -1744,19 +1786,18 @@ importMessages ms f old_ = do
       putStrLn ""
       logError . T.pack $ "error restoring messages: " <> e
       liftIO exitFailure
-    Right (count, total, expired) -> do
-      putStrLn ""
+    Right (lineCount, storedMsgsCount, expiredMsgsCount) -> do
+      putStrLn $ "Processed " <> show lineCount <> " lines"
       renameFile f $ f <> ".bak"
       logQueueStates ms
-      qCount <- M.size <$> readTVarIO (activeMsgQueues ms)
-      logInfo $ "Processed " <> tshow count <> " lines, imported " <> tshow total <> " messages into " <> tshow qCount <> " queues, expired " <> tshow expired <> " messages"
-      pure expired
+      storedQueues <- M.size <$> readTVarIO (activeMsgQueues ms)
+      pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues}
   where
     progress i = do
       liftIO $ putStr $ "Processed " <> show i <> " lines\r"
       hFlush stdout
     restoreMsg :: (Int, Int, Int) -> (Int, LB.ByteString) -> ExceptT String IO (Int, Int, Int)
-    restoreMsg (!count, !total, !expired) (i, s') = do
+    restoreMsg (!lineCount, !stored, !expired) (i, s') = do
       when (i `mod` 1000 == 0) $ progress i
       MLRv3 rId msg <- liftEither . first (msgErr "parsing") $ strDecode s
       liftError show $ addToMsgQueue rId msg
@@ -1766,16 +1807,20 @@ importMessages ms f old_ = do
           q <- getMsgQueue ms rId
           (isExpired, logFull) <- case msg of
             Message {msgTs}
-              | maybe True (systemSeconds msgTs >=) old_ -> (False,) . isNothing <$> writeMsg q False msg
+              | maybe True (systemSeconds msgTs >=) old_ -> (False,) . isNothing <$> writeMsg ms q False msg
               | otherwise -> pure (True, False)
-            MessageQuota {} -> writeMsg q False msg $> (False, False)
+            MessageQuota {} -> writeMsg ms q False msg $> (False, False)
           when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
-          let total' = if logFull then total else total + 1
-              expired' = if isExpired then expired + 1 else expired
-          pure (count + 1, total', expired')
+          let !stored' = if logFull || isExpired then stored else stored + 1
+              !expired' = if isExpired then expired + 1 else expired
+          pure (lineCount + 1, stored', expired')
         msgErr :: Show e => String -> e -> String
         msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
 
+printMessageStats :: T.Text -> MessageStats -> IO ()
+printMessageStats name MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues} =
+  logInfo $ name <> " stored: " <> tshow storedMsgsCount <> ", expired: " <> tshow expiredMsgsCount <> ", queues: " <> tshow storedQueues
+
 saveServerNtfs :: M ()
 saveServerNtfs = asks (storeNtfsFile . config) >>= mapM_ saveNtfs
   where
@@ -1790,33 +1835,37 @@ saveServerNtfs = asks (storeNtfsFile . config) >>= mapM_ saveNtfs
         saveQueueNtfs h (nId, v) = BLD.hPutBuilder h . encodeNtfs nId . reverse =<< readTVarIO v
         encodeNtfs nId = mconcat . map (\ntf -> BLD.byteString (strEncode $ NLRv1 nId ntf) <> BLD.char8 '\n')
 
-restoreServerNtfs :: M Int
+restoreServerNtfs :: M MessageStats
 restoreServerNtfs =
   asks (storeNtfsFile . config) >>= \case
-    Just f -> ifM (doesFileExist f) (restoreNtfs f) (pure 0)
-    Nothing -> pure 0
+    Just f -> ifM (doesFileExist f) (restoreNtfs f) (pure newMessageStats)
+    Nothing -> pure newMessageStats
   where
     restoreNtfs f = do
       logInfo $ "restoring notifications from file " <> T.pack f
       ns <- asks ntfStore
       old <- asks (notificationExpiration . config) >>= liftIO . expireBeforeEpoch
-      runExceptT (liftIO (LB.readFile f) >>= foldM (restoreNtf ns old) 0 . LB.lines) >>= \case
-        Left e -> do
-          logError . T.pack $ "error restoring notifications: " <> e
-          liftIO exitFailure
-        Right expired -> do
-          renameFile f $ f <> ".bak"
-          logInfo "notifications restored"
-          pure expired
+      liftIO $
+        LB.readFile f >>= runExceptT . foldM (restoreNtf ns old) (0, 0, 0) . LB.lines >>= \case
+          Left e -> do
+            logError . T.pack $ "error restoring notifications: " <> e
+            liftIO exitFailure
+          Right (lineCount, storedMsgsCount, expiredMsgsCount) -> do
+            renameFile f $ f <> ".bak"
+            let NtfStore ns' = ns
+            storedQueues <- M.size <$> readTVarIO ns'
+            logInfo $ "notifications restored, " <> tshow lineCount <> " lines processed" 
+            pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues}
       where
-        restoreNtf ns old !expired s' = do
+        restoreNtf :: NtfStore -> Int64 -> (Int, Int, Int) -> LB.ByteString -> ExceptT String IO (Int, Int, Int)
+        restoreNtf ns old (!lineCount, !stored, !expired) s' = do
           NLRv1 nId ntf <- liftEither . first (ntfErr "parsing") $ strDecode s
           liftIO $ addToNtfs nId ntf
           where
             s = LB.toStrict s'
             addToNtfs nId ntf@MsgNtf {ntfTs}
-              | systemSeconds ntfTs < old = pure (expired + 1)
-              | otherwise = storeNtf ns nId ntf $> expired
+              | systemSeconds ntfTs < old = pure (lineCount + 1, stored, expired + 1)
+              | otherwise = storeNtf ns nId ntf $> (lineCount + 1, stored + 1, expired)
             ntfErr :: Show e => String -> e -> String
             ntfErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
 
@@ -1830,26 +1879,25 @@ saveServerStats =
       B.writeFile f $ strEncode stats
       logInfo "server stats saved"
 
-restoreServerStats :: Int -> Int -> M ()
-restoreServerStats expiredMsgs expiredNtfs = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
+restoreServerStats :: MessageStats -> MessageStats -> M ()
+restoreServerStats msgStats ntfStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
   where
     restoreStats f = whenM (doesFileExist f) $ do
       logInfo $ "restoring server stats from file " <> T.pack f
       liftIO (strDecode <$> B.readFile f) >>= \case
-        Right d@ServerStatsData {_qCount = statsQCount} -> do
+        Right d@ServerStatsData {_qCount = statsQCount, _msgCount = statsMsgCount, _ntfCount = statsNtfCount} -> do
           s <- asks serverStats
           _qCount <- fmap M.size . readTVarIO . queues =<< asks queueStore
-          _msgCount <-
-            asks msgStore >>= \case
-              AMS SMSMemory ms -> liftIO $ readTVarIO (msgQueues ms) >>= foldM (\(!n) q -> (n +) <$> getQueueSize q) 0
-              _ -> pure 0
-          NtfStore ns <- asks ntfStore
-          _ntfCount <- liftIO . foldM (\(!n) q -> (n +) . length <$> readTVarIO q) 0 =<< readTVarIO ns
-          liftIO $ setServerStats s d {_qCount, _msgCount, _ntfCount, _msgExpired = _msgExpired d + expiredMsgs, _msgNtfExpired = _msgNtfExpired d + expiredNtfs}
+          let _msgCount = storedMsgsCount msgStats
+              _ntfCount = storedMsgsCount ntfStats
+          liftIO $ setServerStats s d {_qCount, _msgCount, _ntfCount, _msgExpired = _msgExpired d + expiredMsgsCount msgStats, _msgNtfExpired = _msgNtfExpired d + expiredMsgsCount ntfStats}
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
-          when (_qCount /= statsQCount) $ logWarn $ "Queue count differs: stats: " <> tshow statsQCount <> ", store: " <> tshow _qCount
-          logInfo $ "Restored " <> tshow _msgCount <> " messages in " <> tshow _qCount <> " queues"
+          compareCounts "Queue" statsQCount _qCount
+          compareCounts "Message" statsMsgCount _msgCount
+          compareCounts "Notification" statsNtfCount _ntfCount
         Left e -> do
           logInfo $ "error restoring server stats: " <> T.pack e
           liftIO exitFailure
+    compareCounts name statsCnt storeCnt =
+      when (statsCnt /= storeCnt) $ logWarn $ name <> " count differs: stats: " <> tshow statsCnt <> ", store: " <> tshow storeCnt
\ No newline at end of file
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index ddd51e815..f1f0808fa 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -39,7 +39,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
-import Simplex.Messaging.Server (AttachHTTP, exportMessages, importMessages, runSMPServer)
+import Simplex.Messaging.Server (AttachHTTP, exportMessages, importMessages, printMessageStats, runSMPServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.Expiration
@@ -99,8 +99,9 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 ("WARNING: message log file " <> storeMsgsFilePath <> " will be imported to journal directory " <> storeMsgsJournalDir)
                 "Messages not imported"
               ms <- newJournalMsgStore
-              void $ importMessages ms storeMsgsFilePath Nothing -- no expiration
+              msgStats <- importMessages ms storeMsgsFilePath Nothing -- no expiration
               putStrLn "Import completed"
+              printMessageStats "Messages" msgStats
               putStrLn $ case readMsgStoreType ini of
                 Right (AMSType SMSMemory) -> "store_messages set to `memory`, update it to `journal` in INI file"
                 Right (AMSType SMSJournal) -> "store_messages set to `journal`"
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index 29a022668..e0ba446ad 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -10,16 +10,19 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Simplex.Messaging.Server.MsgStore.Journal
   ( JournalMsgStore (msgQueues, random),
-    JournalMsgQueue,
+    JournalMsgQueue (queueDirectory),
     JournalStoreConfig (..),
     getQueueMessages,
+    closeMsgQueue,
     -- below are exported for tests
     MsgQueueState (..),
     JournalState (..),
+    SJournalType (..),
     msgQueueDirectory,
     readWriteQueueState,
     newMsgQueueState,
@@ -54,6 +57,7 @@ import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (ifM, tshow, ($>>=))
 import System.Directory
+import System.Exit
 import System.FilePath ((</>))
 import System.IO (BufferMode (..), Handle, IOMode (..), SeekMode (..), stdout)
 import qualified System.IO as IO
@@ -78,22 +82,20 @@ data JournalStoreConfig = JournalStoreConfig
   }
 
 data JournalMsgQueue = JournalMsgQueue
-  { config :: JournalStoreConfig,
-    queueDirectory :: FilePath,
+  { queueDirectory :: FilePath,
     queueLock :: Lock,
     state :: TVar MsgQueueState,
-    -- Last message and length incl. newline
+    -- tipMsg contains last message and length incl. newline
     -- Nothing - unknown, Just Nothing - empty queue.
-    -- This optimization  prevents reading each message at least twice,
-    -- or reading it after it was just written.
+    -- It  prevents reading each message twice,
+    -- and reading it after it was just written.
     tipMsg :: TVar (Maybe (Maybe (Message, Int))),
-    handles :: TVar (Maybe MsgQueueHandles),
-    random :: TVar StdGen
+    handles :: TVar (Maybe MsgQueueHandles)
   }
 
 data MsgQueueState = MsgQueueState
-  { writeState :: JournalState,
-    readState :: JournalState,
+  { readState :: JournalState 'JTRead,
+    writeState :: JournalState 'JTWrite,
     canWrite :: Bool,
     size :: Int
   }
@@ -105,21 +107,49 @@ data MsgQueueHandles = MsgQueueHandles
     writeHandle :: Maybe Handle -- optional, used when write file is different from read file
   }
 
-data JournalState = JournalState
-  { journalId :: ByteString,
+data JournalState t = JournalState
+  { journalType :: SJournalType t,
+    journalId :: ByteString,
     msgPos :: Int,
     msgCount :: Int,
-    bytePos :: Int
+    bytePos :: Int,
+    byteCount :: Int
   }
   deriving (Show)
 
+data JournalType = JTRead | JTWrite
+
+data SJournalType (t :: JournalType) where
+  SJTRead :: SJournalType 'JTRead
+  SJTWrite :: SJournalType 'JTWrite
+
+class JournalTypeI t where sJournalType :: SJournalType t
+
+instance JournalTypeI 'JTRead where sJournalType = SJTRead
+
+instance JournalTypeI 'JTWrite where sJournalType = SJTWrite
+
+deriving instance Show (SJournalType t)
+
 newMsgQueueState :: ByteString -> MsgQueueState
 newMsgQueueState journalId =
-  let st = newJournalState journalId
-   in MsgQueueState {writeState = st, readState = st, canWrite = True, size = 0}
+  MsgQueueState
+    { writeState = newJournalState journalId,
+      readState = newJournalState journalId,
+      canWrite = True,
+      size = 0
+    }
 
-newJournalState :: ByteString -> JournalState
-newJournalState journalId = JournalState {journalId, msgPos = 0, msgCount = 0, bytePos = 0}
+newJournalState :: JournalTypeI t => ByteString -> JournalState t
+newJournalState journalId =
+  JournalState
+    { journalType = sJournalType,
+      journalId,
+      msgPos = 0,
+      msgCount = 0,
+      bytePos = 0,
+      byteCount = 0
+    }
 
 journalFilePath :: FilePath -> ByteString -> FilePath
 journalFilePath dir journalId = dir </> (msgLogFileName <> "." <> B.unpack journalId <> logFileExt)
@@ -139,15 +169,15 @@ instance StrEncoding MsgQueueState where
     size <- " size=" *> strP
     pure MsgQueueState {writeState, readState, canWrite, size}
 
-instance StrEncoding JournalState where
-  strEncode JournalState {journalId, msgPos, msgCount, bytePos} =
-    B.intercalate "," [journalId, strEncode msgPos, strEncode msgCount, strEncode bytePos]
+instance JournalTypeI t => StrEncoding (JournalState t) where
+  strEncode JournalState {journalId, msgPos, msgCount, bytePos, byteCount} =
+    B.concat [journalId, ",", strEncodeList [msgPos, msgCount, bytePos, byteCount]]
   strP = do
     journalId <- A.takeTill (== ',')
-    msgPos <- A.char ',' *> strP
-    msgCount <- A.char ',' *> strP
-    bytePos <- A.char ',' *> strP
-    pure JournalState {journalId, msgPos, msgCount, bytePos}
+    A.char ',' *> strListP >>= \case
+      [msgPos, msgCount, bytePos, byteCount] ->
+        pure JournalState {journalType = sJournalType, journalId, msgPos, msgCount, bytePos, byteCount}
+      _ -> fail "bad JournalState"
 
 queueLogFileName :: String
 queueLogFileName = "queue_state"
@@ -158,11 +188,11 @@ msgLogFileName = "messages"
 logFileExt :: String
 logFileExt = ".log"
 
-newtype NonAtomicIO a = NonAtomicIO (IO a)
+newtype StoreIO a = StoreIO (IO a)
   deriving newtype (Functor, Applicative, Monad)
 
 instance MsgStoreClass JournalMsgStore where
-  type StoreMonad JournalMsgStore = NonAtomicIO
+  type StoreMonad JournalMsgStore = StoreIO
   type MsgQueue JournalMsgStore = JournalMsgQueue
   type MsgStoreConfig JournalMsgStore = JournalStoreConfig
 
@@ -173,33 +203,36 @@ instance MsgStoreClass JournalMsgStore where
     msgQueues <- TM.emptyIO
     pure JournalMsgStore {config, random, queueLocks, msgQueues}
 
-  closeMsgStore st = readTVarIO (msgQueues st) >>= mapM_ closeMsgQueue_
+  closeMsgStore st = readTVarIO (msgQueues st) >>= mapM_ closeMsgQueue
 
   activeMsgQueues = msgQueues
   {-# INLINE activeMsgQueues #-}
 
-  -- This function opens and closes all queues.
-  -- It is used to export storage to a single file, not during normal server execution.
-  withAllMsgQueues :: JournalMsgStore -> (RecipientId -> JournalMsgQueue -> IO Int) -> IO Int
-  withAllMsgQueues st@JournalMsgStore {config} action = do
-    closeMsgStore st
-    lock <- createLockIO -- the same lock is used for all queues
-    dirs <- zip [0..] <$> listQueueDirs 0 ("", storePath)
-    let count = length dirs
-    total <- foldM (processQueue lock count) 0 dirs
-    progress count count
-    putStrLn ""
-    pure total
+  -- This function is a "foldr" that opens and closes all queues, processes them as defined by action and accumulates the result.
+  -- It is used to export storage to a single file and also to expire messages and validate all queues when server is started.
+  withAllMsgQueues :: JournalMsgStore -> (RecipientId -> JournalMsgQueue -> a -> IO a) -> a -> IO a
+  withAllMsgQueues ms@JournalMsgStore {config} action res = ifM (doesDirectoryExist storePath) processStore (pure res)
     where
+      processStore = do
+        closeMsgStore ms
+        lock <- createLockIO -- the same lock is used for all queues
+        dirs <- zip [0..] <$> listQueueDirs 0 ("", storePath)
+        let count = length dirs
+        res' <- foldM (processQueue lock count) res dirs
+        progress count count
+        putStrLn ""
+        pure res'
       JournalStoreConfig {storePath, pathParts} = config
-      processQueue lock count !total (i :: Int, (queueId, dir)) = do
+      processQueue lock count acc (i :: Int, (queueId, dir)) = do
         when (i `mod` 100 == 0) $ progress i count
-        q <- openMsgQueue st dir lock
-        total' <- case strDecode $ B.pack queueId of
-          Right rId -> (total +) <$> action rId q
-          Left e -> total <$ putStrLn ("Error: message queue directory " <> dir <> " is invalid: " <> e)
-        closeMsgQueue_ q
-        pure total'
+        q <- openMsgQueue ms dir lock
+        acc' <- case strDecode $ B.pack queueId of
+          Right rId -> action rId q acc
+          Left e -> do
+            putStrLn ("Error: message queue directory " <> dir <> " is invalid: " <> e)
+            exitFailure
+        closeMsgQueue q
+        pure acc'
       progress i count = do
         putStr $ "Processed: " <> show i <> "/" <> show count <> " queues\r"
         IO.hFlush stdout
@@ -216,21 +249,21 @@ instance MsgStoreClass JournalMsgStore where
               (Nothing <$ putStrLn ("Error: path " <> path' <> " is not a directory, skipping"))
 
   logQueueStates :: JournalMsgStore -> IO ()
-  logQueueStates st =
-    void $ withActiveMsgQueues st $ \_ q ->
-      readTVarIO (handles q)
-        >>= maybe (pure ()) (\hs -> readTVarIO (state q) >>= logQueueState (stateHandle hs))
-        >> pure 0
+  logQueueStates st = withActiveMsgQueues st (\_ q _ -> logState q) ()
+    where
+      logState q =
+        readTVarIO (handles q)
+          >>= maybe (pure ()) (\hs -> readTVarIO (state q) >>= logQueueState (stateHandle hs))
 
   getMsgQueue :: JournalMsgStore -> RecipientId -> ExceptT ErrorType IO JournalMsgQueue
-  getMsgQueue store@JournalMsgStore {queueLocks, msgQueues, random} rId =
+  getMsgQueue ms@JournalMsgStore {queueLocks, msgQueues, random} rId =
     tryStore "getMsgQueue" $ withLockMap queueLocks rId "getMsgQueue" $
       TM.lookupIO rId msgQueues >>= maybe newQ pure
     where
       newQ = do
-        let dir = msgQueueDirectory store rId
+        let dir = msgQueueDirectory ms rId
         queueLock <- atomically $ getMapLock queueLocks rId
-        q <- ifM (doesDirectoryExist dir) (openMsgQueue store dir queueLock) (createQ dir queueLock)
+        q <- ifM (doesDirectoryExist dir) (openMsgQueue ms dir queueLock) (createQ dir queueLock)
         atomically $ TM.insert rId q msgQueues
         pure q
         where
@@ -239,24 +272,24 @@ instance MsgStoreClass JournalMsgStore where
             -- folder and files are not created here,
             -- to avoid file IO for queues without messages during subscription
             journalId <- newJournalId random
-            mkJournalQueue store dir queueLock (newMsgQueueState journalId, Nothing)
+            mkJournalQueue dir queueLock (newMsgQueueState journalId, Nothing)
 
   delMsgQueue :: JournalMsgStore -> RecipientId -> IO ()
-  delMsgQueue st rId = withLockMap (queueLocks st) rId "delMsgQueue" $ do
-    void $ closeMsgQueue st rId
-    removeQueueDirectory st rId
+  delMsgQueue ms rId = withLockMap (queueLocks ms) rId "delMsgQueue" $ do
+    void $ deleteMsgQueue_ ms rId
+    removeQueueDirectory ms rId
 
   delMsgQueueSize :: JournalMsgStore -> RecipientId -> IO Int
-  delMsgQueueSize st rId = withLockMap (queueLocks st) rId "delMsgQueue" $ do
-    state_ <- closeMsgQueue st rId
+  delMsgQueueSize ms rId = withLockMap (queueLocks ms) rId "delMsgQueue" $ do
+    state_ <- deleteMsgQueue_ ms rId
     sz <- maybe (pure $ -1) (fmap size . readTVarIO) state_
-    removeQueueDirectory st rId
+    removeQueueDirectory ms rId
     pure sz
 
   getQueueMessages :: Bool -> JournalMsgQueue -> IO [Message]
   getQueueMessages drainMsgs q = readTVarIO (handles q) >>= maybe (pure []) (getMsg [])
     where
-      getMsg ms hs = chooseReadJournal q drainMsgs hs >>= maybe (pure ms) readMsg
+      getMsg msgs hs = chooseReadJournal q drainMsgs hs >>= maybe (pure msgs) readMsg
         where
           readMsg (rs, h) = do
             -- TODO handle errors
@@ -264,10 +297,10 @@ instance MsgStoreClass JournalMsgStore where
             -- TODO handle errors
             Right msg <- pure $ strDecode s
             updateReadPos q drainMsgs (B.length s + 1) hs -- 1 is to account for new line
-            (msg :) <$> getMsg ms hs
+            (msg :) <$> getMsg msgs hs
 
-  writeMsg :: JournalMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  writeMsg q@JournalMsgQueue {queueDirectory, handles, config, random} logState !msg =
+  writeMsg :: JournalMsgStore -> JournalMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  writeMsg ms q@JournalMsgQueue {queueDirectory, handles} logState !msg =
     tryStore "writeMsg" $ withLock' (queueLock q) "writeMsg" $ do
       st@MsgQueueState {canWrite, size} <- readTVarIO (state q)
       let empty = size == 0
@@ -279,7 +312,7 @@ instance MsgStoreClass JournalMsgStore where
             else writeToJournal st canWrt' msgQuota $> Nothing
         else pure Nothing
     where
-      JournalStoreConfig {quota, maxMsgCount} = config
+      JournalStoreConfig {quota, maxMsgCount} = config ms
       msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
       writeToJournal st@MsgQueueState {writeState, readState = rs, size} canWrt' msg' = do
         let msgStr = strEncode msg' `B.snoc` '\n'
@@ -306,7 +339,7 @@ instance MsgStoreClass JournalMsgStore where
             atomically $ writeTVar handles $ Just hs
             pure hs
           switchWriteJournal hs = do
-            journalId <- newJournalId random
+            journalId <- newJournalId $ random ms
             wh <- createNewJournal queueDirectory journalId
             atomically $ writeTVar handles $ Just $ hs {writeHandle = Just wh}
             pure (newJournalState journalId, wh)
@@ -314,9 +347,9 @@ instance MsgStoreClass JournalMsgStore where
   getQueueSize :: JournalMsgQueue -> IO Int
   getQueueSize JournalMsgQueue {state} = size <$> readTVarIO state
 
-  tryPeekMsg_ :: JournalMsgQueue -> NonAtomicIO (Maybe Message)
+  tryPeekMsg_ :: JournalMsgQueue -> StoreIO (Maybe Message)
   tryPeekMsg_ q@JournalMsgQueue {tipMsg, handles} =
-    NonAtomicIO $ readTVarIO handles $>>= chooseReadJournal q True $>>= peekMsg
+    StoreIO $ readTVarIO handles $>>= chooseReadJournal q True $>>= peekMsg
     where
       peekMsg (rs, h) = readTVarIO tipMsg >>= maybe readMsg (pure . fmap fst)
         where
@@ -328,16 +361,16 @@ instance MsgStoreClass JournalMsgStore where
             atomically $ writeTVar tipMsg $ Just (Just (msg, B.length s + 1)) -- 1 is to account for new line
             pure $ Just msg
 
-  tryDeleteMsg_ :: JournalMsgQueue -> NonAtomicIO ()
-  tryDeleteMsg_ q@JournalMsgQueue {tipMsg, handles} = NonAtomicIO $
+  tryDeleteMsg_ :: JournalMsgQueue -> StoreIO ()
+  tryDeleteMsg_ q@JournalMsgQueue {tipMsg, handles} = StoreIO $
     void $
       readTVarIO tipMsg -- if there is no cached tipMsg, do nothing
         $>>= (pure . fmap snd)
         $>>= \len -> readTVarIO handles
         $>>= \hs -> updateReadPos q True len hs $> Just ()
 
-  atomicQueue :: JournalMsgQueue -> String -> NonAtomicIO a -> ExceptT ErrorType IO a
-  atomicQueue mq op (NonAtomicIO a) = tryStore op $ withLock' (queueLock mq) op $ a
+  isolateQueue :: JournalMsgQueue -> String -> StoreIO a -> ExceptT ErrorType IO a
+  isolateQueue mq op (StoreIO a) = tryStore op $ withLock' (queueLock mq) op $ a
 
 tryStore :: String -> IO a -> ExceptT ErrorType IO a
 tryStore op a =
@@ -347,15 +380,15 @@ tryStore op a =
        in logError ("STORE ERROR " <> T.pack e') $> Left (STORE e')
 
 openMsgQueue :: JournalMsgStore -> FilePath -> Lock -> IO JournalMsgQueue
-openMsgQueue store dir queueLock = do
+openMsgQueue ms dir queueLock = do
   let statePath = dir </> (queueLogFileName <> logFileExt)
-  (st, sh) <- readWriteQueueState store statePath
+  (st, sh) <- readWriteQueueState ms statePath
   (st', rh, wh_) <- openJournals dir st
   let hs = MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = wh_}
-  mkJournalQueue store dir queueLock (st', Just hs)
+  mkJournalQueue dir queueLock (st', Just hs)
 
-mkJournalQueue :: JournalMsgStore -> FilePath -> Lock -> (MsgQueueState, Maybe MsgQueueHandles) -> IO JournalMsgQueue
-mkJournalQueue JournalMsgStore {random, config} dir queueLock (st, hs_) = do
+mkJournalQueue :: FilePath -> Lock -> (MsgQueueState, Maybe MsgQueueHandles) -> IO JournalMsgQueue
+mkJournalQueue dir queueLock (st, hs_) = do
   state <- newTVarIO st
   tipMsg <- newTVarIO Nothing
   handles <- newTVarIO hs_
@@ -363,16 +396,14 @@ mkJournalQueue JournalMsgStore {random, config} dir queueLock (st, hs_) = do
   -- to avoid map lookup on queue operations
   pure
     JournalMsgQueue
-      { config,
-        queueDirectory = dir,
+      { queueDirectory = dir,
         queueLock,
         state,
         tipMsg,
-        handles,
-        random
+        handles
       }
 
-chooseReadJournal :: JournalMsgQueue -> Bool -> MsgQueueHandles -> IO (Maybe (JournalState, Handle))
+chooseReadJournal :: JournalMsgQueue -> Bool -> MsgQueueHandles -> IO (Maybe (JournalState 'JTRead, Handle))
 chooseReadJournal q log' hs = do
   st@MsgQueueState {writeState = ws, readState = rs} <- readTVarIO (state q)
   case writeHandle hs of
@@ -390,8 +421,8 @@ chooseReadJournal q log' hs = do
 
 updateQueueState :: JournalMsgQueue -> Bool -> MsgQueueHandles -> MsgQueueState -> IO ()
 updateQueueState q log' hs st = do
-  atomically $ writeTVar (state q) st
   when log' $ logQueueState (stateHandle hs) st
+  atomically $ writeTVar (state q) st
 
 logQueueState :: Handle -> MsgQueueState -> IO ()
 logQueueState h st = B.hPutStr h $ strEncode st `B.snoc` '\n'
@@ -454,9 +485,11 @@ openJournals dir st@MsgQueueState {readState = rs, writeState = ws} = do
               st' <- fixWriteFileSize wh
               pure (st', rh, Just wh)
   where
+    openJournal :: JournalState t -> IO (Either FilePath Handle)
     openJournal JournalState {journalId} =
       let path = journalFilePath dir journalId
        in ifM (doesFileExist path) (Right <$> openFile path ReadWriteMode) (pure $ Left path)
+    -- do that for all append operations
     fixWriteFileSize h = do
       let sz = fromIntegral $ bytePos ws
       sz' <- IO.hFileSize h
@@ -465,7 +498,7 @@ openJournals dir st@MsgQueueState {readState = rs, writeState = ws} = do
         | sz' == sz -> pure st
         | otherwise -> pure st -- TODO re-read file to recover what is possible ???
 
-removeJournal :: FilePath -> JournalState -> IO ()
+removeJournal :: FilePath -> JournalState t -> IO ()
 removeJournal dir JournalState {journalId} = do
   let path = journalFilePath dir journalId
   removeFile path `catchAny` (\e -> logError $ "STORE ERROR removing file " <> T.pack path <> ": " <> tshow e)
@@ -522,13 +555,13 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
       logQueueState sh st
       pure (st, sh)
 
-closeMsgQueue :: JournalMsgStore -> RecipientId -> IO (Maybe (TVar MsgQueueState))
-closeMsgQueue st rId =
+deleteMsgQueue_ :: JournalMsgStore -> RecipientId -> IO (Maybe (TVar MsgQueueState))
+deleteMsgQueue_ st rId =
   atomically (TM.lookupDelete rId (msgQueues st))
-    >>= mapM (\q -> closeMsgQueue_ q $> state q)
+    >>= mapM (\q -> closeMsgQueue q $> state q)
 
-closeMsgQueue_ :: JournalMsgQueue -> IO ()
-closeMsgQueue_ q = readTVarIO (handles q) >>= mapM_ closeHandles
+closeMsgQueue :: JournalMsgQueue -> IO ()
+closeMsgQueue q = readTVarIO (handles q) >>= mapM_ closeHandles
   where
     closeHandles (MsgQueueHandles sh rh wh_) = do
       hClose sh
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index df4507175..17591650c 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -93,8 +93,8 @@ instance MsgStoreClass STMMsgStore where
         mapM_ (writeTQueue q) msgs
         pure msgs
 
-  writeMsg :: STMMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  writeMsg STMMsgQueue {msgQueue = q, quota, canWrite, size} _logState !msg = liftIO $ atomically $ do
+  writeMsg :: STMMsgStore -> STMMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  writeMsg _ STMMsgQueue {msgQueue = q, quota, canWrite, size} _logState !msg = liftIO $ atomically $ do
     canWrt <- readTVar canWrite
     empty <- isEmptyTQueue q
     if canWrt || empty
@@ -122,5 +122,5 @@ instance MsgStoreClass STMMsgStore where
       Just _ -> modifyTVar' size (subtract 1)
       _ -> pure ()
 
-  atomicQueue :: STMMsgQueue -> String -> STM a -> ExceptT ErrorType IO a
-  atomicQueue _ _ = liftIO . atomically
+  isolateQueue :: STMMsgQueue -> String -> STM a -> ExceptT ErrorType IO a
+  isolateQueue _ _ = liftIO . atomically
diff --git a/src/Simplex/Messaging/Server/MsgStore/Types.hs b/src/Simplex/Messaging/Server/MsgStore/Types.hs
index 68693883d..dbaefba6f 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Types.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Types.hs
@@ -24,17 +24,17 @@ class Monad (StoreMonad s) => MsgStoreClass s where
   newMsgStore :: MsgStoreConfig s -> IO s
   closeMsgStore :: s -> IO ()
   activeMsgQueues :: s -> TMap RecipientId (MsgQueue s)
-  withAllMsgQueues :: s -> (RecipientId -> MsgQueue s -> IO Int) -> IO Int
+  withAllMsgQueues :: s -> (RecipientId -> MsgQueue s -> a -> IO a) -> a -> IO a
   logQueueStates :: s -> IO ()
   getMsgQueue :: s -> RecipientId -> ExceptT ErrorType IO (MsgQueue s)
   delMsgQueue :: s -> RecipientId -> IO ()
   delMsgQueueSize :: s -> RecipientId -> IO Int
   getQueueMessages :: Bool -> MsgQueue s -> IO [Message]
-  writeMsg :: MsgQueue s -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  writeMsg :: s -> MsgQueue s -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
   getQueueSize :: MsgQueue s -> IO Int
   tryPeekMsg_ :: MsgQueue s -> StoreMonad s (Maybe Message)
   tryDeleteMsg_ :: MsgQueue s -> StoreMonad s ()
-  atomicQueue :: MsgQueue s -> String -> StoreMonad s a -> ExceptT ErrorType IO a
+  isolateQueue :: MsgQueue s -> String -> StoreMonad s a -> ExceptT ErrorType IO a
 
 data MSType = MSMemory | MSJournal
 
@@ -44,16 +44,16 @@ data SMSType :: MSType -> Type where
 
 data AMSType = forall s. AMSType (SMSType s)
 
-withActiveMsgQueues :: MsgStoreClass s => s -> (RecipientId -> MsgQueue s -> IO Int) -> IO Int
-withActiveMsgQueues st f = readTVarIO (activeMsgQueues st) >>= M.foldrWithKey (\k v -> ((+) <$> f k v <*>)) (pure 0)
+withActiveMsgQueues :: MsgStoreClass s => s -> (RecipientId -> MsgQueue s -> a -> IO a) -> a -> IO a
+withActiveMsgQueues st f a = readTVarIO (activeMsgQueues st) >>= M.foldrWithKey (\k v -> (>>= f k v)) (pure a)
 
 tryPeekMsg :: MsgStoreClass s => MsgQueue s -> ExceptT ErrorType IO (Maybe Message)
-tryPeekMsg mq = atomicQueue mq "tryPeekMsg" $ tryPeekMsg_ mq
+tryPeekMsg mq = isolateQueue mq "tryPeekMsg" $ tryPeekMsg_ mq
 {-# INLINE tryPeekMsg #-}
 
 tryDelMsg :: MsgStoreClass s => MsgQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message)
 tryDelMsg mq msgId' =
-  atomicQueue mq "tryDelMsg" $
+  isolateQueue mq "tryDelMsg" $
     tryPeekMsg_ mq >>= \case
       msg_@(Just msg)
         | msgId msg == msgId' ->
@@ -63,7 +63,7 @@ tryDelMsg mq msgId' =
 -- atomic delete (== read) last and peek next message if available
 tryDelPeekMsg :: MsgStoreClass s => MsgQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
 tryDelPeekMsg mq msgId' =
-  atomicQueue mq "tryDelPeekMsg" $
+  isolateQueue mq "tryDelPeekMsg" $
     tryPeekMsg_ mq >>= \case
       msg_@(Just msg)
         | msgId msg == msgId' -> (msg_,) <$> (tryDeleteMsg_ mq >> tryPeekMsg_ mq)
@@ -71,7 +71,7 @@ tryDelPeekMsg mq msgId' =
       _ -> pure (Nothing, Nothing)
 
 deleteExpiredMsgs :: MsgStoreClass s => MsgQueue s -> Int64 -> ExceptT ErrorType IO Int
-deleteExpiredMsgs mq old = atomicQueue mq "deleteExpiredMsgs" $ loop 0
+deleteExpiredMsgs mq old = isolateQueue mq "deleteExpiredMsgs" $ loop 0
   where
     loop dc =
       tryPeekMsg_ mq >>= \case
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 38a187ec5..425e93f29 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -1042,7 +1042,7 @@ testAllowConnectionClientRestart t = do
   bob <- getSMPAgentClient' 2 agentCfg initAgentServersSrv2 testDB2
   withSmpServerStoreLogOn t testPort $ \_ -> do
     (aliceId, bobId, confId) <-
-      withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \_ -> do
+      withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2, storeMsgsFile = Just testStoreMsgsDir2} testPort2 $ \_ -> do
         runRight $ do
           (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
           (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
@@ -1064,8 +1064,7 @@ testAllowConnectionClientRestart t = do
     alice2 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB
     runRight_ $ subscribeConnection alice2 bobId
     threadDelay 500000
-
-    withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \_ -> do
+    withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2, storeMsgsFile = Just testStoreMsgsDir2} testPort2 $ \_ -> do
       runRight $ do
         ("", "", UP _ _) <- nGet bob
         get alice2 ##> ("", bobId, CON)
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index 150312a60..dd54b1e33 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -21,7 +21,7 @@ import Data.Time.Clock.System (getSystemTime)
 import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (EntityId (..), Message (..), noMsgFlags)
-import Simplex.Messaging.Server (exportMessages, importMessages)
+import Simplex.Messaging.Server (MessageStats (..), exportMessages, importMessages)
 import Simplex.Messaging.Server.MsgStore.Journal
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
@@ -73,17 +73,20 @@ pattern Msg s <- Just Message {msgBody = MaxLenBS s}
 
 deriving instance Eq MsgQueueState
 
-deriving instance Eq JournalState
+deriving instance Eq (JournalState t)
+
+deriving instance Eq (SJournalType t)
 
 testGetQueue :: MsgStoreClass s => s -> IO ()
-testGetQueue st = do
+testGetQueue ms = do
   g <- C.newRandom
   rId <- EntityId <$> atomically (C.randomBytes 24 g)
   runRight_ $ do
-    q <- getMsgQueue st rId
-    Just (Message {msgId = mId1}, True) <- writeMsg q True =<< mkMessage "message 1"
-    Just (Message {msgId = mId2}, False) <- writeMsg q True =<< mkMessage "message 2"
-    Just (Message {msgId = mId3}, False) <- writeMsg q True =<< mkMessage "message 3"
+    q <- getMsgQueue ms rId
+    let write s = writeMsg ms q True =<< mkMessage s
+    Just (Message {msgId = mId1}, True) <- write "message 1"
+    Just (Message {msgId = mId2}, False) <- write "message 2"
+    Just (Message {msgId = mId3}, False) <- write "message 3"
     Msg "message 1" <- tryPeekMsg q
     Msg "message 1" <- tryPeekMsg q
     Nothing <- tryDelMsg q mId2
@@ -99,14 +102,14 @@ testGetQueue st = do
     Nothing <- tryDelMsg q mId2
     Nothing <- tryDelMsg q mId3
     Nothing <- tryPeekMsg q
-    Just (Message {msgId = mId4}, True) <- writeMsg q True =<< mkMessage "message 4"
+    Just (Message {msgId = mId4}, True) <- write "message 4"
     Msg "message 4" <- tryPeekMsg q
-    Just (Message {msgId = mId5}, False) <- writeMsg q True =<< mkMessage "message 5"
+    Just (Message {msgId = mId5}, False) <- write "message 5"
     (Nothing, Msg "message 4") <- tryDelPeekMsg q mId3
     (Msg "message 4", Msg "message 5") <- tryDelPeekMsg q mId4
-    Just (Message {msgId = mId6}, False) <- writeMsg q True =<< mkMessage "message 6"
-    Just (Message {msgId = mId7}, False) <- writeMsg q True =<< mkMessage "message 7"
-    Nothing <- writeMsg q True =<< mkMessage "message 8"
+    Just (Message {msgId = mId6}, False) <- write "message 6"
+    Just (Message {msgId = mId7}, False) <- write "message 7"
+    Nothing <- write "message 8"
     Msg "message 5" <- tryPeekMsg q
     (Nothing, Msg "message 5") <- tryDelPeekMsg q mId4
     (Msg "message 5", Msg "message 6") <- tryDelPeekMsg q mId5
@@ -115,65 +118,69 @@ testGetQueue st = do
     (Just MessageQuota {}, Nothing) <- tryDelPeekMsg q mId8
     (Nothing, Nothing) <- tryDelPeekMsg q mId8
     pure ()
-  delMsgQueue st rId
+  delMsgQueue ms rId
 
 testChangeReadJournal :: MsgStoreClass s => s -> IO ()
-testChangeReadJournal st = do
+testChangeReadJournal ms = do
   g <- C.newRandom
   rId <- EntityId <$> atomically (C.randomBytes 24 g)
   runRight_ $ do
-    q <- getMsgQueue st rId
-    Just (Message {msgId = mId1}, True) <- writeMsg q True =<< mkMessage "message 1"
+    q <- getMsgQueue ms rId
+    let write s = writeMsg ms q True =<< mkMessage s
+    Just (Message {msgId = mId1}, True) <- write "message 1"
     (Msg "message 1", Nothing) <- tryDelPeekMsg q mId1
-    Just (Message {msgId = mId2}, True) <- writeMsg q True =<< mkMessage "message 2"
+    Just (Message {msgId = mId2}, True) <- write "message 2"
     (Msg "message 2", Nothing) <- tryDelPeekMsg q mId2
-    Just (Message {msgId = mId3}, True) <- writeMsg q True =<< mkMessage "message 3"
+    Just (Message {msgId = mId3}, True) <- write "message 3"
     (Msg "message 3", Nothing) <- tryDelPeekMsg q mId3
-    Just (Message {msgId = mId4}, True) <- writeMsg q True =<< mkMessage "message 4"
+    Just (Message {msgId = mId4}, True) <- write "message 4"
     (Msg "message 4", Nothing) <- tryDelPeekMsg q mId4
-    Just (Message {msgId = mId5}, True) <- writeMsg q True =<< mkMessage "message 5"
+    Just (Message {msgId = mId5}, True) <- write "message 5"
     (Msg "message 5", Nothing) <- tryDelPeekMsg q mId5
     pure ()
-  delMsgQueue st rId
+  delMsgQueue ms rId
 
 testExportImportStore :: JournalMsgStore -> IO ()
-testExportImportStore st = do
+testExportImportStore ms = do
   g <- C.newRandom
   rId1 <- EntityId <$> atomically (C.randomBytes 24 g)
   rId2 <- EntityId <$> atomically (C.randomBytes 24 g)
   runRight_ $ do
-    q1 <- getMsgQueue st rId1
-    Just (Message {}, True) <- writeMsg q1 True =<< mkMessage "message 1"
-    Just (Message {}, False) <- writeMsg q1 True =<< mkMessage "message 2"
-    q2 <- getMsgQueue st rId2
-    Just (Message {}, True) <- writeMsg q2 True =<< mkMessage "message 3"
-    Just (Message {}, False) <- writeMsg q2 True =<< mkMessage "message 4"
-    Just (Message {}, False) <- writeMsg q2 True =<< mkMessage "message 5"
-    Nothing <- writeMsg q2 True =<< mkMessage "message 6"
+    let write q s = writeMsg ms q True =<< mkMessage s
+    q1 <- getMsgQueue ms rId1
+    Just (Message {}, True) <- write q1 "message 1"
+    Just (Message {}, False) <- write q1 "message 2"
+    q2 <- getMsgQueue ms rId2
+    Just (Message {}, True) <- write q2 "message 3"
+    Just (Message {}, False) <- write q2 "message 4"
+    Just (Message {}, False) <- write q2 "message 5"
+    Nothing <- write q2 "message 6"
     pure ()
-  length <$> listDirectory (msgQueueDirectory st rId1) `shouldReturn` 2
-  length <$> listDirectory (msgQueueDirectory st rId2) `shouldReturn` 2
-  exportMessages st testStoreMsgsFile $ getQueueMessages False
+  length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
+  length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 2
+  exportMessages ms testStoreMsgsFile $ getQueueMessages False
   let cfg = (testJournalStoreCfg :: JournalStoreConfig) {storePath = testStoreMsgsDir2}
-  st' <- newMsgStore cfg
-  0 <- importMessages st' testStoreMsgsFile Nothing
-  length <$> listDirectory (msgQueueDirectory st rId1) `shouldReturn` 2
-  length <$> listDirectory (msgQueueDirectory st rId2) `shouldReturn` 3 -- state file is backed up
-  exportMessages st' testStoreMsgsFile2 $ getQueueMessages False
+  ms' <- newMsgStore cfg
+  MessageStats {storedMsgsCount = 6, expiredMsgsCount = 0, storedQueues = 2} <-
+    importMessages ms' testStoreMsgsFile Nothing
+  length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
+  length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 3 -- state file is backed up
+  exportMessages ms' testStoreMsgsFile2 $ getQueueMessages False
   (B.readFile testStoreMsgsFile2 `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".bak")
   stmStore <- newMsgStore testSMTStoreConfig
-  0 <- importMessages stmStore testStoreMsgsFile2 Nothing
+  MessageStats {storedMsgsCount = 6, expiredMsgsCount = 0, storedQueues = 2} <-
+    importMessages stmStore testStoreMsgsFile2 Nothing
   exportMessages stmStore testStoreMsgsFile $ getQueueMessages False
   (B.sort <$> B.readFile testStoreMsgsFile `shouldReturn`) =<< (B.sort <$> B.readFile (testStoreMsgsFile2 <> ".bak"))
 
 testQueueState :: JournalMsgStore -> IO ()
-testQueueState st = do
+testQueueState ms = do
   g <- C.newRandom
   rId <- EntityId <$> atomically (C.randomBytes 24 g)
-  let dir = msgQueueDirectory st rId
+  let dir = msgQueueDirectory ms rId
       statePath = dir </> (queueLogFileName <> logFileExt)
   createDirectoryIfMissing True dir
-  state <- newMsgQueueState <$> newJournalId (random st)
+  state <- newMsgQueueState <$> newJournalId (random ms)
   withFile statePath WriteMode (`logQueueState` state)
   length . lines <$> readFile statePath `shouldReturn` 1
   readQueueState statePath `shouldReturn` state
@@ -208,7 +215,7 @@ testQueueState st = do
   length . lines <$> readFile statePath `shouldReturn` 1
   where
     readQueueState statePath = do
-      (state, h) <- readWriteQueueState st statePath
+      (state, h) <- readWriteQueueState ms statePath
       hClose h
       pure state
     corruptFile f = do

From 1484523164445487486ac2372b03808ed01b3dc6 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 22 Oct 2024 12:09:51 +0100
Subject: [PATCH 168/195] smp server, journal store: check file size on append,
 validate queue state (#1377)

* smp server: journal store queue state validation

* validate state on update, refactor

* handle message parsing errors

* typo

* fix test, throw exception when file is smaller than expected

* fix

* fix test in ghc 8.10.7
---
 src/Simplex/Messaging/Server.hs               |  12 +-
 src/Simplex/Messaging/Server/Main.hs          |   4 +-
 .../Messaging/Server/MsgStore/Journal.hs      | 198 ++++++++++--------
 tests/AgentTests/FunctionalAPITests.hs        |   2 +-
 tests/AgentTests/NotificationTests.hs         |   4 +-
 tests/CoreTests/MsgStoreTests.hs              |  24 ++-
 tests/ServerTests.hs                          |  22 +-
 tests/Test.hs                                 |   2 +-
 8 files changed, 161 insertions(+), 107 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 214cd0790..efde4e667 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -93,7 +93,7 @@ import Simplex.Messaging.Server.Control
 import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
-import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgQueue (..), closeMsgQueue)
+import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgQueue (..), JMQueue (..), closeMsgQueue)
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.NtfStore
@@ -1731,17 +1731,17 @@ saveServerMessages :: Bool -> M ()
 saveServerMessages drainMsgs =
   asks msgStore >>= \case
     AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-      Just f -> liftIO $ exportMessages ms f $ getQueueMessages drainMsgs
+      Just f -> liftIO $ exportMessages ms f drainMsgs
       Nothing -> logInfo "undelivered messages are not saved"
     AMS SMSJournal _ -> logInfo "closed journal message storage"
 
-exportMessages :: MsgStoreClass s => s -> FilePath -> (MsgQueue s -> IO [Message]) -> IO ()
-exportMessages ms f getMessages = do
+exportMessages :: MsgStoreClass s => s -> FilePath -> Bool -> IO ()
+exportMessages ms f drainMsgs = do
   logInfo $ "saving messages to file " <> T.pack f
   total <- liftIO $ withFile f WriteMode $ \h -> withAllMsgQueues ms (saveQueueMsgs h) 0
   logInfo $ "messages saved: " <> tshow total
   where
-    saveQueueMsgs h rId q acc = getMessages q >>= \msgs -> (acc + length msgs) <$ BLD.hPutBuilder h (encodeMessages rId msgs)
+    saveQueueMsgs h rId q acc = getQueueMessages drainMsgs q >>= \msgs -> (acc + length msgs) <$ BLD.hPutBuilder h (encodeMessages rId msgs)
     encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
 
 restoreServerMessages :: M MessageStats
@@ -1768,7 +1768,7 @@ restoreServerMessages = do
             runExceptT expireQueue >>= \case
               Right (stored', expired') -> pure (stored + stored', expired + expired', qCount + 1)
               Left e -> do
-                logInfo $ "failed expiring messages in queue " <> T.pack (queueDirectory q) <> ": " <> tshow e
+                logInfo $ "failed expiring messages in queue " <> T.pack (queueDirectory $ queue q) <> ": " <> tshow e
                 exitFailure
             where
               expireQueue = do
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index f1f0808fa..5abe0b331 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -44,7 +44,7 @@ import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
-import Simplex.Messaging.Server.MsgStore.Journal (JournalStoreConfig (..), getQueueMessages)
+import Simplex.Messaging.Server.MsgStore.Journal (JournalStoreConfig (..))
 import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..), newMsgStore)
 import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedServerSMPRelayVRange)
 import Simplex.Messaging.Transport.Client (SocksProxy, TransportHost (..), defaultSocksProxy)
@@ -115,7 +115,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 ("WARNING: journal directory " <> storeMsgsJournalDir <> " will be exported to message log file " <> storeMsgsFilePath)
                 "Journal not exported"
               ms <- newJournalMsgStore
-              exportMessages ms storeMsgsFilePath $ getQueueMessages False
+              exportMessages ms storeMsgsFilePath False
               putStrLn "Export completed"
               putStrLn $ case readMsgStoreType ini of
                 Right (AMSType SMSMemory) -> "store_messages set to `memory`"
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index e0ba446ad..13df614a8 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -15,7 +15,8 @@
 
 module Simplex.Messaging.Server.MsgStore.Journal
   ( JournalMsgStore (msgQueues, random),
-    JournalMsgQueue (queueDirectory),
+    JournalMsgQueue (queue),
+    JMQueue (queueDirectory, statePath),
     JournalStoreConfig (..),
     getQueueMessages,
     closeMsgQueue,
@@ -43,6 +44,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Functor (($>))
+import Data.Int (Int64)
 import Data.Maybe (catMaybes, fromMaybe)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
@@ -81,15 +83,20 @@ data JournalStoreConfig = JournalStoreConfig
     maxStateLines :: Int
   }
 
-data JournalMsgQueue = JournalMsgQueue
+data JMQueue = JMQueue
   { queueDirectory :: FilePath,
     queueLock :: Lock,
+    statePath :: FilePath
+  }
+
+data JournalMsgQueue = JournalMsgQueue
+  { queue :: JMQueue,
     state :: TVar MsgQueueState,
     -- tipMsg contains last message and length incl. newline
     -- Nothing - unknown, Just Nothing - empty queue.
     -- It  prevents reading each message twice,
     -- and reading it after it was just written.
-    tipMsg :: TVar (Maybe (Maybe (Message, Int))),
+    tipMsg :: TVar (Maybe (Maybe (Message, Int64))),
     handles :: TVar (Maybe MsgQueueHandles)
   }
 
@@ -112,8 +119,8 @@ data JournalState t = JournalState
     journalId :: ByteString,
     msgPos :: Int,
     msgCount :: Int,
-    bytePos :: Int,
-    byteCount :: Int
+    bytePos :: Int64,
+    byteCount :: Int64
   }
   deriving (Show)
 
@@ -141,15 +148,7 @@ newMsgQueueState journalId =
     }
 
 newJournalState :: JournalTypeI t => ByteString -> JournalState t
-newJournalState journalId =
-  JournalState
-    { journalType = sJournalType,
-      journalId,
-      msgPos = 0,
-      msgCount = 0,
-      bytePos = 0,
-      byteCount = 0
-    }
+newJournalState journalId = JournalState sJournalType journalId 0 0 0 0
 
 journalFilePath :: FilePath -> ByteString -> FilePath
 journalFilePath dir journalId = dir </> (msgLogFileName <> "." <> B.unpack journalId <> logFileExt)
@@ -171,13 +170,16 @@ instance StrEncoding MsgQueueState where
 
 instance JournalTypeI t => StrEncoding (JournalState t) where
   strEncode JournalState {journalId, msgPos, msgCount, bytePos, byteCount} =
-    B.concat [journalId, ",", strEncodeList [msgPos, msgCount, bytePos, byteCount]]
+    B.intercalate "," [journalId, e msgPos, e msgCount, e bytePos, e byteCount]
+    where
+      e :: StrEncoding a => a -> ByteString
+      e = strEncode
   strP = do
     journalId <- A.takeTill (== ',')
-    A.char ',' *> strListP >>= \case
-      [msgPos, msgCount, bytePos, byteCount] ->
-        pure JournalState {journalType = sJournalType, journalId, msgPos, msgCount, bytePos, byteCount}
-      _ -> fail "bad JournalState"
+    JournalState sJournalType journalId <$> i <*> i <*> i <*> i
+    where
+      i :: Integral a => A.Parser a
+      i = A.char ',' *> A.decimal
 
 queueLogFileName :: String
 queueLogFileName = "queue_state"
@@ -210,6 +212,8 @@ instance MsgStoreClass JournalMsgStore where
 
   -- This function is a "foldr" that opens and closes all queues, processes them as defined by action and accumulates the result.
   -- It is used to export storage to a single file and also to expire messages and validate all queues when server is started.
+  -- TODO this function requires case-sensitive file system, because it uses queue directory as recipient ID.
+  -- It can be made to support case-insensite FS by supporting more than one queue per directory, by getting recipient ID from state file name.
   withAllMsgQueues :: JournalMsgStore -> (RecipientId -> JournalMsgQueue -> a -> IO a) -> a -> IO a
   withAllMsgQueues ms@JournalMsgStore {config} action res = ifM (doesDirectoryExist storePath) processStore (pure res)
     where
@@ -223,9 +227,11 @@ instance MsgStoreClass JournalMsgStore where
         putStrLn ""
         pure res'
       JournalStoreConfig {storePath, pathParts} = config
-      processQueue lock count acc (i :: Int, (queueId, dir)) = do
+      processQueue queueLock count acc (i :: Int, (queueId, dir)) = do
         when (i `mod` 100 == 0) $ progress i count
-        q <- openMsgQueue ms dir lock
+        let statePath = dir </> queueLogFileName <> "." <> queueId <> logFileExt
+            queue = JMQueue {queueDirectory = dir, queueLock, statePath}
+        q <- openMsgQueue ms queue
         acc' <- case strDecode $ B.pack queueId of
           Right rId -> action rId q acc
           Left e -> do
@@ -261,18 +267,20 @@ instance MsgStoreClass JournalMsgStore where
       TM.lookupIO rId msgQueues >>= maybe newQ pure
     where
       newQ = do
-        let dir = msgQueueDirectory ms rId
         queueLock <- atomically $ getMapLock queueLocks rId
-        q <- ifM (doesDirectoryExist dir) (openMsgQueue ms dir queueLock) (createQ dir queueLock)
+        let dir = msgQueueDirectory ms rId
+            statePath = dir </> (queueLogFileName <> "." <> B.unpack (strEncode rId) <> logFileExt)
+            queue = JMQueue {queueDirectory = dir, queueLock, statePath}
+        q <- ifM (doesDirectoryExist dir) (openMsgQueue ms queue) (createQ queue)
         atomically $ TM.insert rId q msgQueues
         pure q
         where
-          createQ :: FilePath -> Lock -> IO JournalMsgQueue
-          createQ dir queueLock = do
+          createQ :: JMQueue -> IO JournalMsgQueue
+          createQ queue = do
             -- folder and files are not created here,
             -- to avoid file IO for queues without messages during subscription
             journalId <- newJournalId random
-            mkJournalQueue dir queueLock (newMsgQueueState journalId, Nothing)
+            mkJournalQueue queue (newMsgQueueState journalId, Nothing)
 
   delMsgQueue :: JournalMsgStore -> RecipientId -> IO ()
   delMsgQueue ms rId = withLockMap (queueLocks ms) rId "delMsgQueue" $ do
@@ -292,16 +300,13 @@ instance MsgStoreClass JournalMsgStore where
       getMsg msgs hs = chooseReadJournal q drainMsgs hs >>= maybe (pure msgs) readMsg
         where
           readMsg (rs, h) = do
-            -- TODO handle errors
-            s <- hGetLineAt h $ bytePos rs
-            -- TODO handle errors
-            Right msg <- pure $ strDecode s
-            updateReadPos q drainMsgs (B.length s + 1) hs -- 1 is to account for new line
+            (msg, len) <- hGetMsgAt h $ bytePos rs
+            updateReadPos q drainMsgs len hs
             (msg :) <$> getMsg msgs hs
 
   writeMsg :: JournalMsgStore -> JournalMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  writeMsg ms q@JournalMsgQueue {queueDirectory, handles} logState !msg =
-    tryStore "writeMsg" $ withLock' (queueLock q) "writeMsg" $ do
+  writeMsg ms q@JournalMsgQueue {queue = JMQueue {queueDirectory, queueLock, statePath}, handles} logState !msg =
+    tryStore "writeMsg" $ withLock' queueLock "writeMsg" $ do
       st@MsgQueueState {canWrite, size} <- readTVarIO (state q)
       let empty = size == 0
       if canWrite || empty
@@ -316,22 +321,22 @@ instance MsgStoreClass JournalMsgStore where
       msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
       writeToJournal st@MsgQueueState {writeState, readState = rs, size} canWrt' msg' = do
         let msgStr = strEncode msg' `B.snoc` '\n'
-            msgLen = B.length msgStr
+            msgLen = fromIntegral $ B.length msgStr
         hs <- maybe createQueueDir pure =<< readTVarIO handles
         (ws, wh) <- case writeHandle hs of
           Nothing | msgCount writeState >= maxMsgCount -> switchWriteJournal hs
           wh_ -> pure (writeState, fromMaybe (readHandle hs) wh_)
-        let msgCount' = msgCount ws + 1
-            ws' = ws {msgPos = msgPos ws + 1, msgCount = msgCount', bytePos = bytePos ws + msgLen}
-            rs' = if journalId ws == journalId rs then rs {msgCount = msgCount'} else rs
+        let msgPos' = msgPos ws + 1
+            bytePos' = bytePos ws + msgLen
+            ws' = ws {msgPos = msgPos', msgCount = msgPos', bytePos = bytePos', byteCount = bytePos'}
+            rs' = if journalId ws == journalId rs then rs {msgCount = msgPos', byteCount = bytePos'} else rs
             !st' = st {writeState = ws', readState = rs', canWrite = canWrt', size = size + 1}
         when (size == 0) $ atomically $ writeTVar (tipMsg q) $ Just (Just (msg, msgLen))
-        hAppend wh msgStr
+        hAppend wh (bytePos ws) msgStr
         updateQueueState q logState hs st'
         where
           createQueueDir = do
             createDirectoryIfMissing True queueDirectory
-            let statePath = queueDirectory </> (queueLogFileName <> logFileExt)
             sh <- openFile statePath AppendMode
             B.hPutStr sh ""
             rh <- createNewJournal queueDirectory $ journalId rs
@@ -354,11 +359,8 @@ instance MsgStoreClass JournalMsgStore where
       peekMsg (rs, h) = readTVarIO tipMsg >>= maybe readMsg (pure . fmap fst)
         where
           readMsg = do
-            -- TODO handle errors
-            s <- hGetLineAt h $ bytePos rs
-            -- TODO handle errors
-            Right msg <- pure $ strDecode s
-            atomically $ writeTVar tipMsg $ Just (Just (msg, B.length s + 1)) -- 1 is to account for new line
+            ml@(msg, _) <- hGetMsgAt h $ bytePos rs
+            atomically $ writeTVar tipMsg $ Just (Just ml)
             pure $ Just msg
 
   tryDeleteMsg_ :: JournalMsgQueue -> StoreIO ()
@@ -370,7 +372,7 @@ instance MsgStoreClass JournalMsgStore where
         $>>= \hs -> updateReadPos q True len hs $> Just ()
 
   isolateQueue :: JournalMsgQueue -> String -> StoreIO a -> ExceptT ErrorType IO a
-  isolateQueue mq op (StoreIO a) = tryStore op $ withLock' (queueLock mq) op $ a
+  isolateQueue q op (StoreIO a) = tryStore op $ withLock' (queueLock $ queue q) op $ a
 
 tryStore :: String -> IO a -> ExceptT ErrorType IO a
 tryStore op a =
@@ -379,29 +381,21 @@ tryStore op a =
       let e' = op <> " " <> show e
        in logError ("STORE ERROR " <> T.pack e') $> Left (STORE e')
 
-openMsgQueue :: JournalMsgStore -> FilePath -> Lock -> IO JournalMsgQueue
-openMsgQueue ms dir queueLock = do
-  let statePath = dir </> (queueLogFileName <> logFileExt)
+openMsgQueue :: JournalMsgStore -> JMQueue -> IO JournalMsgQueue
+openMsgQueue ms q@JMQueue {queueDirectory = dir, statePath} = do
   (st, sh) <- readWriteQueueState ms statePath
   (st', rh, wh_) <- openJournals dir st
   let hs = MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = wh_}
-  mkJournalQueue dir queueLock (st', Just hs)
+  mkJournalQueue q (st', Just hs)
 
-mkJournalQueue :: FilePath -> Lock -> (MsgQueueState, Maybe MsgQueueHandles) -> IO JournalMsgQueue
-mkJournalQueue dir queueLock (st, hs_) = do
+mkJournalQueue :: JMQueue -> (MsgQueueState, Maybe MsgQueueHandles) -> IO JournalMsgQueue
+mkJournalQueue queue (st, hs_) = do
   state <- newTVarIO st
   tipMsg <- newTVarIO Nothing
   handles <- newTVarIO hs_
   -- using the same queue lock which is currently locked,
   -- to avoid map lookup on queue operations
-  pure
-    JournalMsgQueue
-      { queueDirectory = dir,
-        queueLock,
-        state,
-        tipMsg,
-        handles
-      }
+  pure JournalMsgQueue {queue, state, tipMsg, handles}
 
 chooseReadJournal :: JournalMsgQueue -> Bool -> MsgQueueHandles -> IO (Maybe (JournalState 'JTRead, Handle))
 chooseReadJournal q log' hs = do
@@ -411,8 +405,8 @@ chooseReadJournal q log' hs = do
       -- switching to write journal
       atomically $ writeTVar (handles q) $ Just hs {readHandle = wh, writeHandle = Nothing}
       hClose $ readHandle hs
-      removeJournal (queueDirectory q) rs
-      let !rs' = (newJournalState $ journalId ws) {msgCount = msgCount ws}
+      removeJournal (queueDirectory $ queue q) rs
+      let !rs' = (newJournalState $ journalId ws) {msgCount = msgCount ws, byteCount = byteCount ws}
           !st' = st {readState = rs'}
       updateQueueState q log' hs st'
       pure $ Just (rs', wh)
@@ -421,13 +415,14 @@ chooseReadJournal q log' hs = do
 
 updateQueueState :: JournalMsgQueue -> Bool -> MsgQueueHandles -> MsgQueueState -> IO ()
 updateQueueState q log' hs st = do
+  unless (validQueueState st) $ E.throwIO $ userError $ "updating to invalid state: " <> show st
   when log' $ logQueueState (stateHandle hs) st
   atomically $ writeTVar (state q) st
 
 logQueueState :: Handle -> MsgQueueState -> IO ()
 logQueueState h st = B.hPutStr h $ strEncode st `B.snoc` '\n'
 
-updateReadPos :: JournalMsgQueue -> Bool -> Int -> MsgQueueHandles -> IO ()
+updateReadPos :: JournalMsgQueue -> Bool -> Int64 -> MsgQueueHandles -> IO ()
 updateReadPos q log' len hs = do
   st@MsgQueueState {readState = rs, size} <- readTVarIO (state q)
   let JournalState {msgPos, bytePos} = rs
@@ -471,32 +466,39 @@ openJournals dir st@MsgQueueState {readState = rs, writeState = ws} = do
       pure (st', rh, Nothing)
     Right rh
       | rjId == wjId -> do
-          st' <- fixWriteFileSize rh
-          pure (st', rh, Nothing)
-      | otherwise ->
+          fixFileSize rh $ bytePos ws
+          pure (st, rh, Nothing)
+      | otherwise -> do
+          fixFileSize rh $ byteCount rs
           openJournal ws >>= \case
             Left path -> do
               logError $ "STORE ERROR no write file " <> T.pack path <> ", creating new file"
               wh <- createNewJournal dir wjId
-              let size' = msgCount rs + msgPos rs
+              let size' = msgCount rs - msgPos rs
                   st' = st {writeState = newJournalState wjId, size = size'} -- we don't amend canWrite to trigger QCONT
               pure (st', rh, Just wh)
             Right wh -> do
-              st' <- fixWriteFileSize wh
-              pure (st', rh, Just wh)
+              fixFileSize wh $ bytePos ws
+              pure (st, rh, Just wh)
   where
     openJournal :: JournalState t -> IO (Either FilePath Handle)
     openJournal JournalState {journalId} =
       let path = journalFilePath dir journalId
        in ifM (doesFileExist path) (Right <$> openFile path ReadWriteMode) (pure $ Left path)
     -- do that for all append operations
-    fixWriteFileSize h = do
-      let sz = fromIntegral $ bytePos ws
-      sz' <- IO.hFileSize h
-      if
-        | sz' > sz -> logWarn "STORE WARNING" >> IO.hSetFileSize h sz $> st
-        | sz' == sz -> pure st
-        | otherwise -> pure st -- TODO re-read file to recover what is possible ???
+
+fixFileSize :: Handle -> Int64 -> IO ()
+fixFileSize h pos = do
+  let pos' = fromIntegral pos
+  size <- IO.hFileSize h
+  if
+    | size > pos' -> do
+        logWarn $ "STORE WARNING truncating file size from " <> tshow size <> " to " <> tshow pos
+        IO.hSetFileSize h pos'
+    | size < pos' ->
+        -- From code logic this can't happen.
+        E.throwIO $ userError $ "file size " <> show size <> " is smaller than position " <> show pos
+    | otherwise -> pure ()
 
 removeJournal :: FilePath -> JournalState t -> IO ()
 removeJournal dir JournalState {journalId} = do
@@ -517,7 +519,10 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
       ls <- LB.lines <$> LB.readFile statePath
       case ls of
         [] -> writeNewQueueState
-        _ -> useLastLine (length ls) True ls
+        _ -> do
+          r@(st, _) <- useLastLine (length ls) True ls
+          unless (validQueueState st) $ E.throwIO $ userError $ "read invalid invalid: " <> show st
+          pure r
     writeNewQueueState = do
       logWarn $ "STORE WARNING: empty queue state in " <> T.pack statePath <> ", initialized"
       st <- newMsgQueueState <$> newJournalId random
@@ -539,9 +544,7 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
             ls' -> do
               logWarn $ "STORE WARNING: invalid last line in queue state " <> T.pack statePath <> ", using the previous line"
               useLastLine len False ls'
-        | otherwise -> do
-            logError $ "STORE ERROR invalid queue state in " <> T.pack statePath <> ": " <> tshow e
-            E.throwIO $ userError $ "Error reading queue state " <> statePath <> ": " <> show e
+        | otherwise -> E.throwIO $ userError $ "reading queue state " <> statePath <> ": " <> show e
     backupWriteQueueState st = do
       -- State backup is made in two steps to mitigate the crash during the backup.
       -- Temporary backup file will be used when it is present.
@@ -555,6 +558,25 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
       logQueueState sh st
       pure (st, sh)
 
+validQueueState :: MsgQueueState -> Bool
+validQueueState MsgQueueState {readState = rs, writeState = ws, size}
+  | journalId rs == journalId ws =
+      alwaysValid
+        && msgPos rs <= msgPos ws
+        && msgCount rs == msgCount ws
+        && bytePos rs <= bytePos ws
+        && byteCount rs == byteCount ws
+        && size == msgCount rs - msgPos rs
+  | otherwise =
+      alwaysValid
+        && size == msgCount ws + msgCount rs - msgPos rs
+  where
+    alwaysValid =
+      msgPos rs <= msgCount rs
+        && bytePos rs <= byteCount rs
+        && msgPos ws == msgCount ws
+        && bytePos ws == byteCount ws
+
 deleteMsgQueue_ :: JournalMsgStore -> RecipientId -> IO (Maybe (TVar MsgQueueState))
 deleteMsgQueue_ st rId =
   atomically (TM.lookupDelete rId (msgQueues st))
@@ -573,11 +595,21 @@ removeQueueDirectory st rId =
   let dir = msgQueueDirectory st rId
    in removePathForcibly dir `catchAny` (\e -> logError $ "STORE ERROR removeQueueDirectory " <> T.pack dir <> ": " <> tshow e)
 
-hAppend :: Handle -> ByteString -> IO ()
-hAppend h s = IO.hSeek h SeekFromEnd 0 >> B.hPutStr h s
+hAppend :: Handle -> Int64 -> ByteString -> IO ()
+hAppend h pos s = do
+  fixFileSize h pos
+  IO.hSeek h SeekFromEnd 0
+  B.hPutStr h s
 
-hGetLineAt :: Handle -> Int -> IO ByteString
-hGetLineAt h pos = IO.hSeek h AbsoluteSeek (fromIntegral pos) >> B.hGetLine h
+hGetMsgAt :: Handle -> Int64 -> IO (Message, Int64)
+hGetMsgAt h pos = do
+  IO.hSeek h AbsoluteSeek $ fromIntegral pos
+  s <- B.hGetLine h
+  case strDecode s of
+    Right !msg ->
+      let !len = fromIntegral (B.length s) + 1
+       in pure (msg, len)
+    Left e -> E.throwIO $ userError $ "Error parsing message: " <> e
 
 openFile :: FilePath -> IOMode -> IO Handle
 openFile f mode = do
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 425e93f29..646edb4fa 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -1946,7 +1946,7 @@ testBatchedSubscriptions nCreate nDel t =
     runServers :: ExceptT AgentErrorType IO a -> IO a
     runServers a = do
       withSmpServerStoreLogOn t testPort $ \t1 -> do
-        res <- withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \t2 ->
+        res <- withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2, storeMsgsFile = Just testStoreMsgsDir2} testPort2 $ \t2 ->
           runRight a `finally` killThread t2
         killThread t1
         pure res
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 272c6d6d6..37b490f0d 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -54,7 +54,7 @@ import Data.Text.Encoding (encodeUtf8)
 import Database.SQLite.Simple.QQ (sql)
 import NtfClient
 import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testNtfServer, testNtfServer2)
-import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
+import SMPClient (cfg, cfgVPrev, testPort, testPort2, testStoreLogFile2, testStoreMsgsDir2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore')
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, Env (..), InitialAgentServers)
@@ -785,7 +785,7 @@ testNotificationsSMPRestartBatch n t apns =
     runServers :: ExceptT AgentErrorType IO a -> IO a
     runServers a = do
       withSmpServerStoreLogOn t testPort $ \t1 -> do
-        res <- withSmpServerConfigOn t (cfg :: ServerConfig) {storeLogFile = Just testStoreLogFile2} testPort2 $ \t2 ->
+        res <- withSmpServerConfigOn t (cfg :: ServerConfig) {storeLogFile = Just testStoreLogFile2, storeMsgsFile = Just testStoreMsgsDir2} testPort2 $ \t2 ->
           runRight a `finally` killThread t2
         killThread t1
         pure res
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index dd54b1e33..c3344bfa6 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -22,6 +23,7 @@ import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (EntityId (..), Message (..), noMsgFlags)
 import Simplex.Messaging.Server (MessageStats (..), exportMessages, importMessages)
+import Simplex.Messaging.Server.Env.STM (journalMsgStoreDepth)
 import Simplex.Messaging.Server.MsgStore.Journal
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
@@ -55,7 +57,7 @@ testJournalStoreCfg :: JournalStoreConfig
 testJournalStoreCfg =
   JournalStoreConfig
     { storePath = testStoreMsgsDir,
-      pathParts = 4,
+      pathParts = journalMsgStoreDepth,
       quota = 3,
       maxMsgCount = 4,
       maxStateLines = 2
@@ -158,19 +160,19 @@ testExportImportStore ms = do
     pure ()
   length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
   length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 2
-  exportMessages ms testStoreMsgsFile $ getQueueMessages False
+  exportMessages ms testStoreMsgsFile False
   let cfg = (testJournalStoreCfg :: JournalStoreConfig) {storePath = testStoreMsgsDir2}
   ms' <- newMsgStore cfg
   MessageStats {storedMsgsCount = 6, expiredMsgsCount = 0, storedQueues = 2} <-
     importMessages ms' testStoreMsgsFile Nothing
   length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
   length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 3 -- state file is backed up
-  exportMessages ms' testStoreMsgsFile2 $ getQueueMessages False
+  exportMessages ms' testStoreMsgsFile2 False
   (B.readFile testStoreMsgsFile2 `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".bak")
   stmStore <- newMsgStore testSMTStoreConfig
   MessageStats {storedMsgsCount = 6, expiredMsgsCount = 0, storedQueues = 2} <-
     importMessages stmStore testStoreMsgsFile2 Nothing
-  exportMessages stmStore testStoreMsgsFile $ getQueueMessages False
+  exportMessages stmStore testStoreMsgsFile False
   (B.sort <$> B.readFile testStoreMsgsFile `shouldReturn`) =<< (B.sort <$> B.readFile (testStoreMsgsFile2 <> ".bak"))
 
 testQueueState :: JournalMsgStore -> IO ()
@@ -186,13 +188,23 @@ testQueueState ms = do
   readQueueState statePath `shouldReturn` state
   length <$> listDirectory dir `shouldReturn` 1 -- no backup
 
-  let state1 = state {size = 1, writeState = (writeState state) {msgPos = 1, msgCount = 1, bytePos = 100}}
+  let state1 =
+        state
+          { size = 1,
+            readState = (readState state) {msgCount = 1, byteCount = 100},
+            writeState = (writeState state) {msgPos = 1, msgCount = 1, bytePos = 100, byteCount = 100}
+          }
   withFile statePath AppendMode (`logQueueState` state1)
   length . lines <$> readFile statePath `shouldReturn` 2
   readQueueState statePath `shouldReturn` state1
   length <$> listDirectory dir `shouldReturn` 1 -- no backup
 
-  let state2 = state {size = 2, writeState = (writeState state) {msgPos = 2, msgCount = 2, bytePos = 200}}
+  let state2 =
+        state
+          { size = 2,
+            readState = (readState state) {msgCount = 2, byteCount = 200},
+            writeState = (writeState state) {msgPos = 2, msgCount = 2, bytePos = 200, byteCount = 200}
+          }
   withFile statePath AppendMode (`logQueueState` state2)
   length . lines <$> readFile statePath `shouldReturn` 3
   copyFile statePath (statePath <> ".2")
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 38db97f3f..965967878 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -16,6 +16,7 @@
 module ServerTests where
 
 import AgentTests.NotificationTests (removeFileIfExists)
+import CoreTests.MsgStoreTests (testJournalStoreCfg)
 import Control.Concurrent (ThreadId, killThread, threadDelay)
 import Control.Concurrent.STM
 import Control.Exception (SomeException, try)
@@ -35,9 +36,11 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol
+import Simplex.Messaging.Server (exportMessages)
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..))
+import Simplex.Messaging.Server.MsgStore.Journal (JournalStoreConfig (..))
+import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..), newMsgStore)
 import Simplex.Messaging.Server.Stats (PeriodStatsData (..), ServerStatsData (..))
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Util (whenM)
@@ -66,8 +69,8 @@ serverTests t@(ATransport t') = do
     describe "GET & SUB commands" $ testGetSubCommands t'
     describe "Exceeding queue quota" $ testExceedQueueQuota t'
   describe "Store log" $ testWithStoreLog t
-  xdescribe "Restore messages" $ testRestoreMessages t
-  xdescribe "Restore messages (old / v2)" $ testRestoreExpireMessages t
+  describe "Restore messages" $ testRestoreMessages t
+  describe "Restore messages (old / v2)" $ testRestoreExpireMessages t
   describe "Timing of AUTH error" $ testTiming t
   describe "Message notifications" $ testMessageNotifications t
   describe "Message expiration" $ do
@@ -780,6 +783,7 @@ testRestoreExpireMessages at@(ATransport t) =
       pure ()
 
     logSize testStoreLogFile `shouldReturn` 2
+    exportStoreMessages
     msgs <- B.readFile testStoreMsgsFile
     length (B.lines msgs) `shouldBe` 4
 
@@ -788,6 +792,7 @@ testRestoreExpireMessages at@(ATransport t) =
     withSmpServerConfigOn at cfg1 testPort . runTest t $ \_ -> pure ()
 
     logSize testStoreLogFile `shouldReturn` 1
+    exportStoreMessages
     msgs' <- B.readFile testStoreMsgsFile
     msgs' `shouldBe` msgs
 
@@ -797,12 +802,17 @@ testRestoreExpireMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     -- two messages expired
-    -- msgs'' <- B.readFile testStoreMsgsFile
-    -- length (B.lines msgs'') `shouldBe` 2
-    -- B.lines msgs'' `shouldBe` drop 2 (B.lines msgs)
+    exportStoreMessages
+    msgs'' <- B.readFile testStoreMsgsFile
+    length (B.lines msgs'') `shouldBe` 2
+    B.lines msgs'' `shouldBe` drop 2 (B.lines msgs)
     Right ServerStatsData {_msgExpired} <- strDecode <$> B.readFile testServerStatsBackupFile
     _msgExpired `shouldBe` 2
   where
+    exportStoreMessages = do
+      ms <- newMsgStore testJournalStoreCfg {quota = 4}
+      removeFileIfExists testStoreMsgsFile
+      exportMessages ms testStoreMsgsFile False
     runTest :: Transport c => TProxy c -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
     runTest _ test' server = do
       testSMPClient test' `shouldReturn` ()
diff --git a/tests/Test.hs b/tests/Test.hs
index 89672cd4f..6ae4edb41 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -61,7 +61,7 @@ main = do
           describe "TRcvQueues tests" tRcvQueuesTests
           describe "Util tests" utilTests
         describe "SMP server via TLS" $ serverTests (transport @TLS)
-        describe "SMP server via WebSockets" $ serverTests (transport @WS)
+        xdescribe "SMP server via WebSockets" $ serverTests (transport @WS)
         describe "Notifications server" $ ntfServerTests (transport @TLS)
         describe "SMP client agent" $ agentTests (transport @TLS)
         describe "SMP proxy" smpProxyTests

From c9c075fd49689649a63273d27de1317421663c79 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Wed, 23 Oct 2024 09:17:23 +0100
Subject: [PATCH 169/195] smp server: merge quota messages and set queue to
 "over quota" state after restoring, server tests with journal and memory
 store (#1380)

* smp: run server tests with journal and memory store

* merge quota messages, set queue to "over quota" state after restoring

* fix test
---
 src/Simplex/Messaging/Server.hs               |  61 +++--
 .../Messaging/Server/MsgStore/Journal.hs      |  33 +--
 src/Simplex/Messaging/Server/MsgStore/STM.hs  |  13 +-
 .../Messaging/Server/MsgStore/Types.hs        |  14 +-
 tests/CoreTests/MsgStoreTests.hs              |  13 +-
 tests/NtfServerTests.hs                       |   2 +-
 tests/SMPClient.hs                            |  64 ++---
 tests/ServerTests.hs                          | 228 +++++++++---------
 tests/Test.hs                                 |  13 +-
 9 files changed, 243 insertions(+), 198 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index efde4e667..0574b9387 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -155,7 +155,7 @@ smpServer :: TMVar Bool -> ServerConfig -> Maybe AttachHTTP -> M ()
 smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHTTP_ = do
   s <- asks server
   pa <- asks proxyAgent
-  msgStats <- restoreServerMessages
+  msgStats <- processServerMessages
   ntfStats <- restoreServerNtfs
   liftIO $ printMessageStats "messages" msgStats
   liftIO $ printMessageStats "notifications" ntfStats
@@ -215,8 +215,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
     saveServer :: Bool -> M ()
     saveServer drainMsgs = do
       withLog closeStoreLog
-      AMS _ ms <- asks msgStore
-      liftIO $ closeMsgStore ms
       saveServerMessages drainMsgs
       saveServerNtfs
       saveServerStats
@@ -383,7 +381,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
         void $ withActiveMsgQueues ms (\_ -> expireQueueMsgs stats old) 0
       where
         expireQueueMsgs stats old q acc =
-          runExceptT (deleteExpiredMsgs q old) >>= \case
+          runExceptT (deleteExpiredMsgs q True old) >>= \case
             Right deleted -> (acc + deleted) <$ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
             Left _ -> pure 0
 
@@ -1476,7 +1474,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
 
             expireMessages :: MsgStoreClass s => MsgQueue s -> Maybe ExpirationConfig -> ServerStats -> ExceptT ErrorType IO ()
             expireMessages q msgExp stats = do
-              deleted <- maybe (pure 0) (deleteExpiredMsgs q <=< liftIO . expireBeforeEpoch) msgExp
+              deleted <- maybe (pure 0) (deleteExpiredMsgs q True <=< liftIO . expireBeforeEpoch) msgExp
               liftIO $ when (deleted > 0) $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
 
             -- The condition for delivery of the message is:
@@ -1733,7 +1731,9 @@ saveServerMessages drainMsgs =
     AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
       Just f -> liftIO $ exportMessages ms f drainMsgs
       Nothing -> logInfo "undelivered messages are not saved"
-    AMS SMSJournal _ -> logInfo "closed journal message storage"
+    AMS SMSJournal ms -> do
+      liftIO $ closeMsgStore ms
+      logInfo "closed journal message storage"
 
 exportMessages :: MsgStoreClass s => s -> FilePath -> Bool -> IO ()
 exportMessages ms f drainMsgs = do
@@ -1744,8 +1744,8 @@ exportMessages ms f drainMsgs = do
     saveQueueMsgs h rId q acc = getQueueMessages drainMsgs q >>= \msgs -> (acc + length msgs) <$ BLD.hPutBuilder h (encodeMessages rId msgs)
     encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
 
-restoreServerMessages :: M MessageStats
-restoreServerMessages = do
+processServerMessages :: M MessageStats
+processServerMessages = do
   old_ <- asks (messageExpiration . config) $>>= (liftIO . fmap Just . expireBeforeEpoch)
   asks msgStore >>= liftIO . processMessages old_
     where
@@ -1772,23 +1772,25 @@ restoreServerMessages = do
                 exitFailure
             where
               expireQueue = do
-                expired'' <- deleteExpiredMsgs q old
+                expired'' <- deleteExpiredMsgs q False old
                 stored'' <- liftIO $ getQueueSize q
+                liftIO $ logQueueState q
                 liftIO $ closeMsgQueue q
                 pure (stored'', expired'')
           processValidateQueue q (!stored, !qCount) = getQueueSize q >>= \stored' -> pure (stored + stored', qCount + 1)
 
-importMessages :: MsgStoreClass s => s -> FilePath -> Maybe Int64 -> IO MessageStats
+importMessages :: forall s. MsgStoreClass s => s -> FilePath -> Maybe Int64 -> IO MessageStats
 importMessages ms f old_ = do
   logInfo $ "restoring messages from file " <> T.pack f
-  LB.readFile f >>= runExceptT . foldM restoreMsg (0, 0, 0) . zip [0..] . LB.lines >>= \case
+  LB.readFile f >>= runExceptT . foldM restoreMsg (0, Nothing, (0, 0, M.empty)) . zip [0..] . LB.lines >>= \case
     Left e -> do
       putStrLn ""
       logError . T.pack $ "error restoring messages: " <> e
       liftIO exitFailure
-    Right (lineCount, storedMsgsCount, expiredMsgsCount) -> do
+    Right (lineCount, _, (storedMsgsCount, expiredMsgsCount, overQuota)) -> do
       putStrLn $ "Processed " <> show lineCount <> " lines"
       renameFile f $ f <> ".bak"
+      mapM_ setOverQuota_ overQuota
       logQueueStates ms
       storedQueues <- M.size <$> readTVarIO (activeMsgQueues ms)
       pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues}
@@ -1796,24 +1798,37 @@ importMessages ms f old_ = do
     progress i = do
       liftIO $ putStr $ "Processed " <> show i <> " lines\r"
       hFlush stdout
-    restoreMsg :: (Int, Int, Int) -> (Int, LB.ByteString) -> ExceptT String IO (Int, Int, Int)
-    restoreMsg (!lineCount, !stored, !expired) (i, s') = do
+    restoreMsg :: (Int, Maybe (RecipientId, MsgQueue s), (Int, Int, M.Map RecipientId (MsgQueue s))) -> (Int, LB.ByteString) -> ExceptT String IO (Int, Maybe (RecipientId, MsgQueue s), (Int, Int, M.Map RecipientId (MsgQueue s)))
+    restoreMsg (!lineCount, q_, (!stored, !expired, !overQuota)) (i, s') = do
       when (i `mod` 1000 == 0) $ progress i
       MLRv3 rId msg <- liftEither . first (msgErr "parsing") $ strDecode s
       liftError show $ addToMsgQueue rId msg
       where
         s = LB.toStrict s'
         addToMsgQueue rId msg = do
-          q <- getMsgQueue ms rId
-          (isExpired, logFull) <- case msg of
+          q <- case q_ of
+            -- to avoid lookup when restoring the next message to the same queue
+            Just (rId', q') | rId' == rId -> pure q'
+            _ -> getMsgQueue ms rId
+          (lineCount + 1,Just (rId, q),) <$> case msg of
             Message {msgTs}
-              | maybe True (systemSeconds msgTs >=) old_ -> (False,) . isNothing <$> writeMsg ms q False msg
-              | otherwise -> pure (True, False)
-            MessageQuota {} -> writeMsg ms q False msg $> (False, False)
-          when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
-          let !stored' = if logFull || isExpired then stored else stored + 1
-              !expired' = if isExpired then expired + 1 else expired
-          pure (lineCount + 1, stored', expired')
+              | maybe True (systemSeconds msgTs >=) old_ -> do
+                  writeMsg ms q False msg >>= \case
+                    Just _ -> pure (stored + 1, expired, overQuota)
+                    Nothing -> do
+                      logError $ decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
+                      pure (stored, expired, overQuota)
+              | otherwise -> pure (stored, expired + 1, overQuota)
+            MessageQuota {} ->
+              -- queue was over quota at some point,
+              -- it will be set as over quota once fully imported
+              mergeQuotaMsgs >> writeMsg ms q False msg $> (stored, expired, M.insert rId q overQuota)
+              where
+                -- if the first message in queue head is "quota", remove it.
+                mergeQuotaMsgs = isolateQueue q "mergeQuotaMsgs" $
+                  tryPeekMsg_ q >>= \case
+                    Just MessageQuota {} -> tryDeleteMsg_ q False
+                    _ -> pure ()
         msgErr :: Show e => String -> e -> String
         msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
 
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index 13df614a8..564a9a804 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -28,7 +28,7 @@ module Simplex.Messaging.Server.MsgStore.Journal
     readWriteQueueState,
     newMsgQueueState,
     newJournalId,
-    logQueueState,
+    appendState,
     queueLogFileName,
     logFileExt,
   )
@@ -255,11 +255,12 @@ instance MsgStoreClass JournalMsgStore where
               (Nothing <$ putStrLn ("Error: path " <> path' <> " is not a directory, skipping"))
 
   logQueueStates :: JournalMsgStore -> IO ()
-  logQueueStates st = withActiveMsgQueues st (\_ q _ -> logState q) ()
-    where
-      logState q =
-        readTVarIO (handles q)
-          >>= maybe (pure ()) (\hs -> readTVarIO (state q) >>= logQueueState (stateHandle hs))
+  logQueueStates ms = withActiveMsgQueues ms (\_ q _ -> logQueueState q) ()
+
+  logQueueState :: JournalMsgQueue -> IO ()
+  logQueueState q = 
+    readTVarIO (handles q)
+      >>= maybe (pure ()) (\hs -> readTVarIO (state q) >>= appendState (stateHandle hs))
 
   getMsgQueue :: JournalMsgStore -> RecipientId -> ExceptT ErrorType IO JournalMsgQueue
   getMsgQueue ms@JournalMsgStore {queueLocks, msgQueues, random} rId =
@@ -318,7 +319,7 @@ instance MsgStoreClass JournalMsgStore where
         else pure Nothing
     where
       JournalStoreConfig {quota, maxMsgCount} = config ms
-      msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
+      !msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
       writeToJournal st@MsgQueueState {writeState, readState = rs, size} canWrt' msg' = do
         let msgStr = strEncode msg' `B.snoc` '\n'
             msgLen = fromIntegral $ B.length msgStr
@@ -349,6 +350,10 @@ instance MsgStoreClass JournalMsgStore where
             atomically $ writeTVar handles $ Just $ hs {writeHandle = Just wh}
             pure (newJournalState journalId, wh)
 
+  -- can ONLY be used while restoring messages, not while server running
+  setOverQuota_ :: JournalMsgQueue -> IO ()
+  setOverQuota_ JournalMsgQueue {state} = atomically $ modifyTVar' state $ \st -> st {canWrite = False}
+
   getQueueSize :: JournalMsgQueue -> IO Int
   getQueueSize JournalMsgQueue {state} = size <$> readTVarIO state
 
@@ -363,13 +368,13 @@ instance MsgStoreClass JournalMsgStore where
             atomically $ writeTVar tipMsg $ Just (Just ml)
             pure $ Just msg
 
-  tryDeleteMsg_ :: JournalMsgQueue -> StoreIO ()
-  tryDeleteMsg_ q@JournalMsgQueue {tipMsg, handles} = StoreIO $
+  tryDeleteMsg_ :: JournalMsgQueue -> Bool -> StoreIO ()
+  tryDeleteMsg_ q@JournalMsgQueue {tipMsg, handles} logState = StoreIO $
     void $
       readTVarIO tipMsg -- if there is no cached tipMsg, do nothing
         $>>= (pure . fmap snd)
         $>>= \len -> readTVarIO handles
-        $>>= \hs -> updateReadPos q True len hs $> Just ()
+        $>>= \hs -> updateReadPos q logState len hs $> Just ()
 
   isolateQueue :: JournalMsgQueue -> String -> StoreIO a -> ExceptT ErrorType IO a
   isolateQueue q op (StoreIO a) = tryStore op $ withLock' (queueLock $ queue q) op $ a
@@ -416,11 +421,11 @@ chooseReadJournal q log' hs = do
 updateQueueState :: JournalMsgQueue -> Bool -> MsgQueueHandles -> MsgQueueState -> IO ()
 updateQueueState q log' hs st = do
   unless (validQueueState st) $ E.throwIO $ userError $ "updating to invalid state: " <> show st
-  when log' $ logQueueState (stateHandle hs) st
+  when log' $ appendState (stateHandle hs) st
   atomically $ writeTVar (state q) st
 
-logQueueState :: Handle -> MsgQueueState -> IO ()
-logQueueState h st = B.hPutStr h $ strEncode st `B.snoc` '\n'
+appendState :: Handle -> MsgQueueState -> IO ()
+appendState h st = B.hPutStr h $ strEncode st `B.snoc` '\n'
 
 updateReadPos :: JournalMsgQueue -> Bool -> Int64 -> MsgQueueHandles -> IO ()
 updateReadPos q log' len hs = do
@@ -555,7 +560,7 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
       pure r
     writeQueueState st = do
       sh <- openFile statePath AppendMode
-      logQueueState sh st
+      appendState sh st
       pure (st, sh)
 
 validQueueState :: MsgQueueState -> Bool
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index 17591650c..b08e99abe 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -62,6 +62,8 @@ instance MsgStoreClass STMMsgStore where
 
   logQueueStates _ = pure ()
 
+  logQueueState _ = pure ()
+
   -- The reason for double lookup is that majority of messaging queues exist,
   -- because multiple messages are sent to the same queue,
   -- so the first lookup without STM transaction will return the queue faster.
@@ -104,10 +106,13 @@ instance MsgStoreClass STMMsgStore where
         modifyTVar' size (+ 1)
         if canWrt'
           then writeTQueue q msg $> Just (msg, empty)
-          else (writeTQueue q $! msgQuota) $> Nothing
+          else writeTQueue q msgQuota $> Nothing
       else pure Nothing
     where
-      msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
+      !msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
+
+  setOverQuota_ :: STMMsgQueue -> IO ()
+  setOverQuota_ q = atomically $ writeTVar (canWrite q) False
 
   getQueueSize :: STMMsgQueue -> IO Int
   getQueueSize STMMsgQueue {size} = readTVarIO size
@@ -116,8 +121,8 @@ instance MsgStoreClass STMMsgStore where
   tryPeekMsg_ = tryPeekTQueue . msgQueue
   {-# INLINE tryPeekMsg_ #-}
 
-  tryDeleteMsg_ :: STMMsgQueue -> STM ()
-  tryDeleteMsg_ STMMsgQueue {msgQueue = q, size} =
+  tryDeleteMsg_ :: STMMsgQueue -> Bool -> STM ()
+  tryDeleteMsg_ STMMsgQueue {msgQueue = q, size} _logState =
     tryReadTQueue q >>= \case
       Just _ -> modifyTVar' size (subtract 1)
       _ -> pure ()
diff --git a/src/Simplex/Messaging/Server/MsgStore/Types.hs b/src/Simplex/Messaging/Server/MsgStore/Types.hs
index dbaefba6f..cd480b0ae 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Types.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Types.hs
@@ -26,14 +26,16 @@ class Monad (StoreMonad s) => MsgStoreClass s where
   activeMsgQueues :: s -> TMap RecipientId (MsgQueue s)
   withAllMsgQueues :: s -> (RecipientId -> MsgQueue s -> a -> IO a) -> a -> IO a
   logQueueStates :: s -> IO ()
+  logQueueState :: MsgQueue s -> IO ()
   getMsgQueue :: s -> RecipientId -> ExceptT ErrorType IO (MsgQueue s)
   delMsgQueue :: s -> RecipientId -> IO ()
   delMsgQueueSize :: s -> RecipientId -> IO Int
   getQueueMessages :: Bool -> MsgQueue s -> IO [Message]
   writeMsg :: s -> MsgQueue s -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  setOverQuota_ :: MsgQueue s -> IO () -- can ONLY be used while restoring messages, not while server running
   getQueueSize :: MsgQueue s -> IO Int
   tryPeekMsg_ :: MsgQueue s -> StoreMonad s (Maybe Message)
-  tryDeleteMsg_ :: MsgQueue s -> StoreMonad s ()
+  tryDeleteMsg_ :: MsgQueue s -> Bool -> StoreMonad s ()
   isolateQueue :: MsgQueue s -> String -> StoreMonad s a -> ExceptT ErrorType IO a
 
 data MSType = MSMemory | MSJournal
@@ -57,7 +59,7 @@ tryDelMsg mq msgId' =
     tryPeekMsg_ mq >>= \case
       msg_@(Just msg)
         | msgId msg == msgId' ->
-            tryDeleteMsg_ mq >> pure msg_
+            tryDeleteMsg_ mq True >> pure msg_
       _ -> pure Nothing
 
 -- atomic delete (== read) last and peek next message if available
@@ -66,16 +68,16 @@ tryDelPeekMsg mq msgId' =
   isolateQueue mq "tryDelPeekMsg" $
     tryPeekMsg_ mq >>= \case
       msg_@(Just msg)
-        | msgId msg == msgId' -> (msg_,) <$> (tryDeleteMsg_ mq >> tryPeekMsg_ mq)
+        | msgId msg == msgId' -> (msg_,) <$> (tryDeleteMsg_ mq True >> tryPeekMsg_ mq)
         | otherwise -> pure (Nothing, msg_)
       _ -> pure (Nothing, Nothing)
 
-deleteExpiredMsgs :: MsgStoreClass s => MsgQueue s -> Int64 -> ExceptT ErrorType IO Int
-deleteExpiredMsgs mq old = isolateQueue mq "deleteExpiredMsgs" $ loop 0
+deleteExpiredMsgs :: MsgStoreClass s => MsgQueue s -> Bool -> Int64 -> ExceptT ErrorType IO Int
+deleteExpiredMsgs mq logState old = isolateQueue mq "deleteExpiredMsgs" $ loop 0
   where
     loop dc =
       tryPeekMsg_ mq >>= \case
         Just Message {msgTs}
           | systemSeconds msgTs < old ->
-              tryDeleteMsg_ mq >> loop (dc + 1)
+              tryDeleteMsg_ mq logState >> loop (dc + 1)
         _ -> pure dc
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index c3344bfa6..eaa9cc25b 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -22,7 +22,7 @@ import Data.Time.Clock.System (getSystemTime)
 import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (EntityId (..), Message (..), noMsgFlags)
-import Simplex.Messaging.Server (MessageStats (..), exportMessages, importMessages)
+import Simplex.Messaging.Server (MessageStats (..), exportMessages, importMessages, printMessageStats)
 import Simplex.Messaging.Server.Env.STM (journalMsgStoreDepth)
 import Simplex.Messaging.Server.MsgStore.Journal
 import Simplex.Messaging.Server.MsgStore.STM
@@ -163,14 +163,15 @@ testExportImportStore ms = do
   exportMessages ms testStoreMsgsFile False
   let cfg = (testJournalStoreCfg :: JournalStoreConfig) {storePath = testStoreMsgsDir2}
   ms' <- newMsgStore cfg
-  MessageStats {storedMsgsCount = 6, expiredMsgsCount = 0, storedQueues = 2} <-
+  stats@MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
     importMessages ms' testStoreMsgsFile Nothing
+  printMessageStats "Messages" stats
   length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
   length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 3 -- state file is backed up
   exportMessages ms' testStoreMsgsFile2 False
   (B.readFile testStoreMsgsFile2 `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".bak")
   stmStore <- newMsgStore testSMTStoreConfig
-  MessageStats {storedMsgsCount = 6, expiredMsgsCount = 0, storedQueues = 2} <-
+  MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
     importMessages stmStore testStoreMsgsFile2 Nothing
   exportMessages stmStore testStoreMsgsFile False
   (B.sort <$> B.readFile testStoreMsgsFile `shouldReturn`) =<< (B.sort <$> B.readFile (testStoreMsgsFile2 <> ".bak"))
@@ -183,7 +184,7 @@ testQueueState ms = do
       statePath = dir </> (queueLogFileName <> logFileExt)
   createDirectoryIfMissing True dir
   state <- newMsgQueueState <$> newJournalId (random ms)
-  withFile statePath WriteMode (`logQueueState` state)
+  withFile statePath WriteMode (`appendState` state)
   length . lines <$> readFile statePath `shouldReturn` 1
   readQueueState statePath `shouldReturn` state
   length <$> listDirectory dir `shouldReturn` 1 -- no backup
@@ -194,7 +195,7 @@ testQueueState ms = do
             readState = (readState state) {msgCount = 1, byteCount = 100},
             writeState = (writeState state) {msgPos = 1, msgCount = 1, bytePos = 100, byteCount = 100}
           }
-  withFile statePath AppendMode (`logQueueState` state1)
+  withFile statePath AppendMode (`appendState` state1)
   length . lines <$> readFile statePath `shouldReturn` 2
   readQueueState statePath `shouldReturn` state1
   length <$> listDirectory dir `shouldReturn` 1 -- no backup
@@ -205,7 +206,7 @@ testQueueState ms = do
             readState = (readState state) {msgCount = 2, byteCount = 200},
             writeState = (writeState state) {msgPos = 2, msgCount = 2, bytePos = 200, byteCount = 200}
           }
-  withFile statePath AppendMode (`logQueueState` state2)
+  withFile statePath AppendMode (`appendState` state2)
   length . lines <$> readFile statePath `shouldReturn` 3
   copyFile statePath (statePath <> ".2")
   readQueueState statePath `shouldReturn` state2
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index b9560976d..aebbf0f72 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -105,7 +105,7 @@ testNotificationSubscription (ATransport t) =
     (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
     let tkn = DeviceToken PPApnsTest "abcd"
     withAPNSMockServer $ \apns ->
-      smpTest2 t $ \rh sh ->
+      smpTest2' t $ \rh sh ->
         ntfTest t $ \nh -> do
           -- create queue
           (sId, rId, rKey, rcvDhSecret) <- createAndSecureQueue rh sPub
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 0055e8503..0efb64c02 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
@@ -107,19 +108,24 @@ testSMPClient_ host port vr client = do
       | otherwise = Nothing
 
 cfg :: ServerConfig
-cfg =
+cfg = cfgMS (AMSType SMSJournal)
+
+cfgMS :: AMSType -> ServerConfig
+cfgMS msType =
   ServerConfig
     { transports = [],
       smpHandshakeTimeout = 60000000,
       tbqSize = 1,
-      msgStoreType = AMSType SMSJournal,
+      msgStoreType = msType,
       msgQueueQuota = 4,
       maxJournalMsgCount = 5,
       maxJournalStateLines = 2,
       queueIdBytes = 24,
       msgIdBytes = 24,
       storeLogFile = Just testStoreLogFile,
-      storeMsgsFile = Just testStoreMsgsDir,
+      storeMsgsFile = Just $ case msType of
+        AMSType SMSJournal -> testStoreMsgsDir
+        AMSType SMSMemory -> testStoreMsgsFile,
       storeNtfsFile = Nothing,
       allowNewQueues = True,
       newQueueBasicAuth = Nothing,
@@ -178,18 +184,17 @@ proxyVRangeV8 :: VersionRangeSMP
 proxyVRangeV8 = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion
 
 withSmpServerStoreMsgLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
-withSmpServerStoreMsgLogOn t =
-  withSmpServerConfigOn
-    t
-    cfg
-      { storeLogFile = Just testStoreLogFile,
-        storeMsgsFile = Just testStoreMsgsDir,
-        storeNtfsFile = Just testStoreNtfsFile,
-        serverStatsBackupFile = Just testServerStatsBackupFile
-      }
+withSmpServerStoreMsgLogOn = (`withSmpServerStoreMsgLogOnMS` AMSType SMSJournal)
+
+withSmpServerStoreMsgLogOnMS :: HasCallStack => ATransport -> AMSType -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
+withSmpServerStoreMsgLogOnMS t msType =
+  withSmpServerConfigOn t (cfgMS msType) {storeNtfsFile = Just testStoreNtfsFile, serverStatsBackupFile = Just testServerStatsBackupFile}
 
 withSmpServerStoreLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
-withSmpServerStoreLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, serverStatsBackupFile = Just testServerStatsBackupFile}
+withSmpServerStoreLogOn = (`withSmpServerStoreLogOnMS` AMSType SMSJournal)
+
+withSmpServerStoreLogOnMS :: HasCallStack => ATransport -> AMSType -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
+withSmpServerStoreLogOnMS t msType = withSmpServerConfigOn t (cfgMS msType) {serverStatsBackupFile = Just testServerStatsBackupFile}
 
 withSmpServerConfigOn :: HasCallStack => ATransport -> ServerConfig -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withSmpServerConfigOn t cfg' port' =
@@ -222,11 +227,11 @@ withSmpServer t = withSmpServerOn t testPort
 withSmpServerProxy :: HasCallStack => ATransport -> IO a -> IO a
 withSmpServerProxy t = withSmpServerConfigOn t proxyCfg testPort . const
 
-runSmpTest :: forall c a. (HasCallStack, Transport c) => (HasCallStack => THandleSMP c 'TClient -> IO a) -> IO a
-runSmpTest test = withSmpServer (transport @c) $ testSMPClient test
+runSmpTest :: forall c a. (HasCallStack, Transport c) => AMSType -> (HasCallStack => THandleSMP c 'TClient -> IO a) -> IO a
+runSmpTest msType test = withSmpServerConfigOn (transport @c) (cfgMS msType) testPort $ \_ -> testSMPClient test
 
-runSmpTestN :: forall c a. (HasCallStack, Transport c) => Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO a) -> IO a
-runSmpTestN = runSmpTestNCfg cfg supportedClientSMPRelayVRange
+runSmpTestN :: forall c a. (HasCallStack, Transport c) => AMSType -> Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO a) -> IO a
+runSmpTestN msType = runSmpTestNCfg (cfgMS msType) supportedClientSMPRelayVRange
 
 runSmpTestNCfg :: forall c a. (HasCallStack, Transport c) => ServerConfig -> VersionRangeSMP -> Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO a) -> IO a
 runSmpTestNCfg srvCfg clntVR nClients test = withSmpServerConfigOn (transport @c) srvCfg testPort $ \_ -> run nClients []
@@ -241,7 +246,7 @@ smpServerTest ::
   TProxy c ->
   (Maybe TransmissionAuth, ByteString, ByteString, smp) ->
   IO (Maybe TransmissionAuth, ByteString, ByteString, BrokerMsg)
-smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
+smpServerTest _ t = runSmpTest (AMSType SMSJournal) $ \h -> tPut' h t >> tGet' h
   where
     tPut' :: THandleSMP c 'TClient -> (Maybe TransmissionAuth, ByteString, ByteString, smp) -> IO ()
     tPut' h@THandle {params = THandleParams {sessionId, implySessId}} (sig, corrId, queueId, smp) = do
@@ -252,14 +257,17 @@ smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
       [(Nothing, _, (CorrId corrId, EntityId qId, Right cmd))] <- tGet h
       pure (Nothing, corrId, qId, cmd)
 
-smpTest :: (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c 'TClient -> IO ()) -> Expectation
-smpTest _ test' = runSmpTest test' `shouldReturn` ()
+smpTest :: (HasCallStack, Transport c) => TProxy c -> AMSType -> (HasCallStack => THandleSMP c 'TClient -> IO ()) -> Expectation
+smpTest _ msType test' = runSmpTest msType test' `shouldReturn` ()
 
-smpTestN :: (HasCallStack, Transport c) => Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO ()) -> Expectation
-smpTestN n test' = runSmpTestN n test' `shouldReturn` ()
+smpTestN :: (HasCallStack, Transport c) => AMSType -> Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO ()) -> Expectation
+smpTestN msType n test' = runSmpTestN msType n test' `shouldReturn` ()
 
-smpTest2 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
-smpTest2 = smpTest2Cfg cfg supportedClientSMPRelayVRange
+smpTest2' :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
+smpTest2' = (`smpTest2` AMSType SMSJournal)
+
+smpTest2 :: forall c. (HasCallStack, Transport c) => TProxy c -> AMSType -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
+smpTest2 t msType = smpTest2Cfg (cfgMS msType) supportedClientSMPRelayVRange t
 
 smpTest2Cfg :: forall c. (HasCallStack, Transport c) => ServerConfig -> VersionRangeSMP -> TProxy c -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
 smpTest2Cfg srvCfg clntVR _ test' = runSmpTestNCfg srvCfg clntVR 2 _test `shouldReturn` ()
@@ -268,15 +276,15 @@ smpTest2Cfg srvCfg clntVR _ test' = runSmpTestNCfg srvCfg clntVR 2 _test `should
     _test [h1, h2] = test' h1 h2
     _test _ = error "expected 2 handles"
 
-smpTest3 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
-smpTest3 _ test' = smpTestN 3 _test
+smpTest3 :: forall c. (HasCallStack, Transport c) => TProxy c -> AMSType -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
+smpTest3 _ msType test' = smpTestN msType 3 _test
   where
     _test :: HasCallStack => [THandleSMP c 'TClient] -> IO ()
     _test [h1, h2, h3] = test' h1 h2 h3
     _test _ = error "expected 3 handles"
 
-smpTest4 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
-smpTest4 _ test' = smpTestN 4 _test
+smpTest4 :: forall c. (HasCallStack, Transport c) => TProxy c -> AMSType -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
+smpTest4 _ msType test' = smpTestN msType 4 _test
   where
     _test :: HasCallStack => [THandleSMP c 'TClient] -> IO ()
     _test [h1, h2, h3, h4] = test' h1 h2 h3 h4
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 965967878..c133d94fc 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -51,32 +51,31 @@ import System.Timeout
 import Test.HUnit
 import Test.Hspec
 
-serverTests :: ATransport -> Spec
-serverTests t@(ATransport t') = do
-  describe "SMP syntax" $ syntaxTests t
+serverTests :: SpecWith (ATransport, AMSType)
+serverTests  = do
   describe "SMP queues" $ do
-    describe "NEW and KEY commands, SEND messages" $ testCreateSecure t
+    describe "NEW and KEY commands, SEND messages" testCreateSecure
     describe "NEW and SKEY commands" $ do
-      testCreateSndSecure t
-      testSndSecureProhibited t
-    describe "NEW, OFF and DEL commands, SEND messages" $ testCreateDelete t
-    describe "Stress test" $ stressTest t
-    describe "allowNewQueues setting" $ testAllowNewQueues t'
+      testCreateSndSecure
+      testSndSecureProhibited
+    describe "NEW, OFF and DEL commands, SEND messages" testCreateDelete
+    describe "Stress test" stressTest
+    describe "allowNewQueues setting" testAllowNewQueues
   describe "SMP messages" $ do
-    describe "duplex communication over 2 SMP connections" $ testDuplex t
-    describe "switch subscription to another TCP connection" $ testSwitchSub t
-    describe "GET command" $ testGetCommand t'
-    describe "GET & SUB commands" $ testGetSubCommands t'
-    describe "Exceeding queue quota" $ testExceedQueueQuota t'
-  describe "Store log" $ testWithStoreLog t
-  describe "Restore messages" $ testRestoreMessages t
-  describe "Restore messages (old / v2)" $ testRestoreExpireMessages t
-  describe "Timing of AUTH error" $ testTiming t
-  describe "Message notifications" $ testMessageNotifications t
+    describe "duplex communication over 2 SMP connections" testDuplex
+    describe "switch subscription to another TCP connection" testSwitchSub
+    describe "GET command" testGetCommand
+    describe "GET & SUB commands" testGetSubCommands
+    describe "Exceeding queue quota" testExceedQueueQuota
+  describe "Store log" testWithStoreLog
+  describe "Restore messages" testRestoreMessages
+  describe "Restore messages (old / v2)" testRestoreExpireMessages
+  describe "Timing of AUTH error" testTiming
+  describe "Message notifications" testMessageNotifications
   describe "Message expiration" $ do
-    testMsgExpireOnSend t'
-    testMsgExpireOnInterval t'
-    testMsgNOTExpireOnInterval t'
+    testMsgExpireOnSend
+    testMsgExpireOnInterval
+    testMsgNOTExpireOnInterval
 
 pattern Resp :: CorrId -> QueueId -> BrokerMsg -> SignedTransmission ErrorType BrokerMsg
 pattern Resp corrId queueId command <- (_, _, (corrId, queueId, Right command))
@@ -136,10 +135,10 @@ decryptMsgV3 dhShared nonce body =
     Right ClientRcvMsgQuota {} -> Left "ClientRcvMsgQuota"
     Left e -> Left e
 
-testCreateSecure :: ATransport -> Spec
-testCreateSecure (ATransport t) =
-  it "should create (NEW) and secure (KEY) queue" $
-    smpTest2 t $ \r s -> do
+testCreateSecure :: SpecWith (ATransport, AMSType)
+testCreateSecure =
+  it "should create (NEW) and secure (KEY) queue" $ \(ATransport t, msType) ->
+    smpTest2 t msType $ \r s -> do
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
@@ -201,10 +200,10 @@ testCreateSecure (ATransport t) =
       Resp "bcda" _ (ERR LARGE_MSG) <- signSendRecv s sKey ("bcda", sId, _SEND biggerMessage)
       pure ()
 
-testCreateSndSecure :: ATransport -> Spec
-testCreateSndSecure (ATransport t) =
-  it "should create (NEW) and secure (SKEY) queue by sender" $
-    smpTest2 t $ \r s -> do
+testCreateSndSecure :: SpecWith (ATransport, AMSType)
+testCreateSndSecure =
+  it "should create (NEW) and secure (SKEY) queue by sender" $ \(ATransport t, msType) ->
+    smpTest2 t msType $ \r s -> do
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
@@ -248,10 +247,10 @@ testCreateSndSecure (ATransport t) =
       Resp "bcda" _ (ERR LARGE_MSG) <- signSendRecv s sKey ("bcda", sId, _SEND biggerMessage)
       pure ()
 
-testSndSecureProhibited :: ATransport -> Spec
-testSndSecureProhibited (ATransport t) =
-  it "should create (NEW) without allowing sndSecure and fail to and secure queue by sender (SKEY)" $
-    smpTest2 t $ \r s -> do
+testSndSecureProhibited :: SpecWith (ATransport, AMSType)
+testSndSecureProhibited =
+  it "should create (NEW) without allowing sndSecure and fail to and secure queue by sender (SKEY)" $ \(ATransport t, msType) ->
+    smpTest2 t msType $ \r s -> do
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (dhPub, _dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
@@ -263,10 +262,10 @@ testSndSecureProhibited (ATransport t) =
       (sId2, sId) #== "secures queue, same queue ID in response"
       (err, ERR AUTH) #== "rejects SKEY when not allowed in NEW command"
 
-testCreateDelete :: ATransport -> Spec
-testCreateDelete (ATransport t) =
-  it "should create (NEW), suspend (OFF) and delete (DEL) queue" $
-    smpTest2 t $ \rh sh -> do
+testCreateDelete :: SpecWith (ATransport, AMSType)
+testCreateDelete =
+  it "should create (NEW), suspend (OFF) and delete (DEL) queue" $ \(ATransport t, msType) ->
+    smpTest2 t msType $ \rh sh -> do
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
@@ -334,10 +333,10 @@ testCreateDelete (ATransport t) =
       Resp "cdab" _ err10 <- signSendRecv rh rKey ("cdab", rId, SUB)
       (err10, ERR AUTH) #== "rejects SUB when deleted"
 
-stressTest :: ATransport -> Spec
-stressTest (ATransport t) =
-  it "should create many queues, disconnect and re-connect" $
-    smpTest3 t $ \h1 h2 h3 -> do
+stressTest :: SpecWith (ATransport, AMSType)
+stressTest =
+  it "should create many queues, disconnect and re-connect" $ \(ATransport t, msType) ->
+    smpTest3 t msType $ \h1 h2 h3 -> do
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
@@ -352,10 +351,10 @@ stressTest (ATransport t) =
       closeConnection $ connection h2
       subscribeQueues h3
 
-testAllowNewQueues :: forall c. Transport c => TProxy c -> Spec
-testAllowNewQueues t =
-  it "should prohibit creating new queues with allowNewQueues = False" $ do
-    withSmpServerConfigOn (ATransport t) cfg {allowNewQueues = False} testPort $ \_ ->
+testAllowNewQueues :: SpecWith (ATransport, AMSType)
+testAllowNewQueues =
+  it "should prohibit creating new queues with allowNewQueues = False" $ \(ATransport (t :: TProxy c), msType) ->
+    withSmpServerConfigOn (ATransport t) (cfgMS msType) {allowNewQueues = False} testPort $ \_ ->
       testSMPClient @c $ \h -> do
         g <- C.newRandom
         (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
@@ -363,10 +362,10 @@ testAllowNewQueues t =
         Resp "abcd" NoEntity (ERR AUTH) <- signSendRecv h rKey ("abcd", NoEntity, NEW rPub dhPub Nothing SMSubscribe False)
         pure ()
 
-testDuplex :: ATransport -> Spec
-testDuplex (ATransport t) =
-  it "should create 2 simplex connections and exchange messages" $
-    smpTest2 t $ \alice bob -> do
+testDuplex :: SpecWith (ATransport, AMSType)
+testDuplex =
+  it "should create 2 simplex connections and exchange messages" $ \(ATransport t, msType) ->
+    smpTest2 t msType $ \alice bob -> do
       g <- C.newRandom
       (arPub, arKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (aDhPub, aDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
@@ -418,10 +417,10 @@ testDuplex (ATransport t) =
       Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, ACK mId5)
       (bDec mId5 msg5, Right "how are you bob") #== "message received from alice"
 
-testSwitchSub :: ATransport -> Spec
-testSwitchSub (ATransport t) =
-  it "should create simplex connections and switch subscription to another TCP connection" $
-    smpTest3 t $ \rh1 rh2 sh -> do
+testSwitchSub :: SpecWith (ATransport, AMSType)
+testSwitchSub =
+  it "should create simplex connections and switch subscription to another TCP connection" $ \(ATransport t, msType) ->
+    smpTest3 t msType $ \rh1 rh2 sh -> do
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
@@ -463,12 +462,12 @@ testSwitchSub (ATransport t) =
         Nothing -> return ()
         Just _ -> error "nothing else is delivered to the 1st TCP connection"
 
-testGetCommand :: forall c. Transport c => TProxy c -> Spec
-testGetCommand t =
-  it "should retrieve messages from the queue using GET command" $ do
+testGetCommand :: SpecWith (ATransport, AMSType)
+testGetCommand =
+  it "should retrieve messages from the queue using GET command" $ \(ATransport (t :: TProxy c), msType) -> do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    smpTest t $ \sh -> do
+    smpTest t msType $ \sh -> do
       queue <- newEmptyTMVarIO
       testSMPClient @c $ \rh ->
         atomically . putTMVar queue =<< createAndSecureQueue rh sPub
@@ -482,12 +481,12 @@ testGetCommand t =
         Resp "4" _ OK <- signSendRecv rh rKey ("4", rId, GET)
         pure ()
 
-testGetSubCommands :: forall c. Transport c => TProxy c -> Spec
-testGetSubCommands t =
-  it "should retrieve messages with GET and receive with SUB, only one ACK would work" $ do
+testGetSubCommands :: SpecWith (ATransport, AMSType)
+testGetSubCommands =
+  it "should retrieve messages with GET and receive with SUB, only one ACK would work" $ \(ATransport t, msType) -> do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    smpTest3 t $ \rh1 rh2 sh -> do
+    smpTest3 t msType $ \rh1 rh2 sh -> do
       (sId, rId, rKey, dhShared) <- createAndSecureQueue rh1 sPub
       let dec = decryptMsgV3 dhShared
       Resp "1" _ OK <- signSendRecv sh sKey ("1", sId, _SEND "hello 1")
@@ -532,10 +531,10 @@ testGetSubCommands t =
       Resp "12" _ OK <- signSendRecv rh2 rKey ("12", rId, GET)
       pure ()
 
-testExceedQueueQuota :: forall c. Transport c => TProxy c -> Spec
-testExceedQueueQuota t =
-  it "should reply with ERR QUOTA to sender and send QUOTA message to the recipient" $ do
-    withSmpServerConfigOn (ATransport t) cfg {msgQueueQuota = 2} testPort $ \_ ->
+testExceedQueueQuota :: SpecWith (ATransport, AMSType)
+testExceedQueueQuota =
+  it "should reply with ERR QUOTA to sender and send QUOTA message to the recipient" $ \(ATransport (t :: TProxy c), msType) -> do
+    withSmpServerConfigOn (ATransport t) (cfgMS msType) {msgQueueQuota = 2} testPort $ \_ ->
       testSMPClient @c $ \sh -> testSMPClient @c $ \rh -> do
         g <- C.newRandom
         (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -559,9 +558,9 @@ testExceedQueueQuota t =
         Resp "10" _ OK <- signSendRecv rh rKey ("10", rId, ACK mId4)
         pure ()
 
-testWithStoreLog :: ATransport -> Spec
-testWithStoreLog at@(ATransport t) =
-  it "should store simplex queues to log and restore them after server restart" $ do
+testWithStoreLog :: SpecWith (ATransport, AMSType)
+testWithStoreLog =
+  it "should store simplex queues to log and restore them after server restart" $ \(at@(ATransport t), msType) -> do
     g <- C.newRandom
     (sPub1, sKey1) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (sPub2, sKey2) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -573,7 +572,7 @@ testWithStoreLog at@(ATransport t) =
     senderId2 <- newTVarIO NoEntity
     notifierId <- newTVarIO NoEntity
 
-    withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do
+    withSmpServerStoreLogOnMS at msType testPort . runTest t $ \h -> runClient t $ \h1 -> do
       (sId1, rId1, rKey1, dhShared) <- createAndSecureQueue h sPub1
       (rcvNtfPubDhKey, _) <- atomically $ C.generateKeyPair g
       Resp "abcd" _ (NID nId _) <- signSendRecv h rKey1 ("abcd", rId1, NKEY nPub rcvNtfPubDhKey)
@@ -606,14 +605,14 @@ testWithStoreLog at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 6
 
-    let cfg' = cfg {msgStoreType = AMSType SMSMemory, storeLogFile = Nothing, storeMsgsFile = Nothing}
+    let cfg' = (cfgMS msType) {msgStoreType = AMSType SMSMemory, storeLogFile = Nothing, storeMsgsFile = Nothing}
     withSmpServerConfigOn at cfg' testPort . runTest t $ \h -> do
       sId1 <- readTVarIO senderId1
       -- fails if store log is disabled
       Resp "bcda" _ (ERR AUTH) <- signSendRecv h sKey1 ("bcda", sId1, _SEND "hello")
       pure ()
 
-    withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do
+    withSmpServerStoreLogOnMS at msType testPort . runTest t $ \h -> runClient t $ \h1 -> do
       -- this queue is restored
       rId1 <- readTVarIO recipientId1
       Just rKey1 <- readTVarIO recipientKey1
@@ -647,9 +646,9 @@ logSize f =
     Right l -> pure l
     Left (_ :: SomeException) -> logSize f
 
-testRestoreMessages :: ATransport -> Spec
-testRestoreMessages at@(ATransport t) =
-  it "should store messages on exit and restore on start" $ do
+testRestoreMessages :: SpecWith (ATransport, AMSType)
+testRestoreMessages =
+  it "should store messages on exit and restore on start" $ \(at@(ATransport t), msType) -> do
     removeFileIfExists testStoreLogFile
     removeFileIfExists testStoreMsgsFile
     whenM (doesDirectoryExist testStoreMsgsDir) $ removeDirectoryRecursive testStoreMsgsDir
@@ -662,7 +661,7 @@ testRestoreMessages at@(ATransport t) =
     dhShared <- newTVarIO Nothing
     senderId <- newTVarIO NoEntity
 
-    withSmpServerStoreMsgLogOn at testPort . runTest t $ \h -> do
+    withSmpServerStoreMsgLogOnMS at msType testPort . runTest t $ \h -> do
       runClient t $ \h1 -> do
         (sId, rId, rKey, dh) <- createAndSecureQueue h1 sPub
         atomically $ do
@@ -691,7 +690,7 @@ testRestoreMessages at@(ATransport t) =
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
 
-    withSmpServerStoreMsgLogOn at testPort . runTest t $ \h -> do
+    withSmpServerStoreMsgLogOnMS at msType testPort . runTest t $ \h -> do
       Just rKey <- readTVarIO recipientKey
       Just dh <- readTVarIO dhShared
       let dec = decryptMsgV3 dh
@@ -709,7 +708,7 @@ testRestoreMessages at@(ATransport t) =
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
-    withSmpServerStoreMsgLogOn at testPort . runTest t $ \h -> do
+    withSmpServerStoreMsgLogOnMS at msType testPort . runTest t $ \h -> do
       Just rKey <- readTVarIO recipientKey
       Just dh <- readTVarIO dhShared
       let dec = decryptMsgV3 dh
@@ -756,9 +755,9 @@ checkStats s qs sent received = do
   IS.toList _week `shouldBe` map (hash . unEntityId) qs
   IS.toList _month `shouldBe` map (hash . unEntityId) qs
 
-testRestoreExpireMessages :: ATransport -> Spec
-testRestoreExpireMessages at@(ATransport t) =
-  it "should store messages on exit and restore on start" $ do
+testRestoreExpireMessages :: SpecWith (ATransport, AMSType)
+testRestoreExpireMessages =
+  it "should store messages on exit and restore on start" $ \(at@(ATransport t), msType) -> do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     recipientId <- newTVarIO NoEntity
@@ -766,7 +765,7 @@ testRestoreExpireMessages at@(ATransport t) =
     dhShared <- newTVarIO Nothing
     senderId <- newTVarIO NoEntity
 
-    withSmpServerStoreMsgLogOn at testPort . runTest t $ \h -> do
+    withSmpServerStoreMsgLogOnMS at msType testPort . runTest t $ \h -> do
       runClient t $ \h1 -> do
         (sId, rId, rKey, dh) <- createAndSecureQueue h1 sPub
         atomically $ do
@@ -783,36 +782,39 @@ testRestoreExpireMessages at@(ATransport t) =
       pure ()
 
     logSize testStoreLogFile `shouldReturn` 2
-    exportStoreMessages
+    exportStoreMessages msType
     msgs <- B.readFile testStoreMsgsFile
     length (B.lines msgs) `shouldBe` 4
 
     let expCfg1 = Just ExpirationConfig {ttl = 86400, checkInterval = 43200}
-        cfg1 = cfg {messageExpiration = expCfg1, serverStatsBackupFile = Just testServerStatsBackupFile}
+        cfg1 = (cfgMS msType) {messageExpiration = expCfg1, serverStatsBackupFile = Just testServerStatsBackupFile}
     withSmpServerConfigOn at cfg1 testPort . runTest t $ \_ -> pure ()
 
     logSize testStoreLogFile `shouldReturn` 1
-    exportStoreMessages
+    exportStoreMessages msType
     msgs' <- B.readFile testStoreMsgsFile
     msgs' `shouldBe` msgs
 
     let expCfg2 = Just ExpirationConfig {ttl = 2, checkInterval = 43200}
-        cfg2 = cfg {messageExpiration = expCfg2, serverStatsBackupFile = Just testServerStatsBackupFile}
+        cfg2 = (cfgMS msType) {messageExpiration = expCfg2, serverStatsBackupFile = Just testServerStatsBackupFile}
     withSmpServerConfigOn at cfg2 testPort . runTest t $ \_ -> pure ()
 
     logSize testStoreLogFile `shouldReturn` 1
     -- two messages expired
-    exportStoreMessages
+    exportStoreMessages msType
     msgs'' <- B.readFile testStoreMsgsFile
     length (B.lines msgs'') `shouldBe` 2
     B.lines msgs'' `shouldBe` drop 2 (B.lines msgs)
     Right ServerStatsData {_msgExpired} <- strDecode <$> B.readFile testServerStatsBackupFile
     _msgExpired `shouldBe` 2
   where
-    exportStoreMessages = do
-      ms <- newMsgStore testJournalStoreCfg {quota = 4}
-      removeFileIfExists testStoreMsgsFile
-      exportMessages ms testStoreMsgsFile False
+    exportStoreMessages :: AMSType -> IO ()
+    exportStoreMessages = \case
+      AMSType SMSJournal -> do
+        ms <- newMsgStore testJournalStoreCfg {quota = 4}
+        removeFileIfExists testStoreMsgsFile
+        exportMessages ms testStoreMsgsFile False
+      AMSType SMSMemory -> pure ()
     runTest :: Transport c => TProxy c -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
     runTest _ test' server = do
       testSMPClient test' `shouldReturn` ()
@@ -832,12 +834,12 @@ createAndSecureQueue h sPub = do
   (rId', rId) #== "same queue ID"
   pure (sId, rId, rKey, dhShared)
 
-testTiming :: ATransport -> Spec
-testTiming (ATransport t) =
+testTiming :: SpecWith (ATransport, AMSType)
+testTiming =
   describe "should have similar time for auth error, whether queue exists or not, for all key types" $
     forM_ timingTests $ \tst ->
-      it (testName tst) $
-        smpTest2Cfg cfg (mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion) t $ \rh sh ->
+      it (testName tst) $ \(ATransport t, msType) ->
+        smpTest2Cfg (cfgMS msType) (mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion) t $ \rh sh ->
           testSameTiming rh sh tst
   where
     testName :: (C.AuthAlg, C.AuthAlg, Int) -> String
@@ -902,13 +904,13 @@ testTiming (ATransport t) =
             ]
           ok `shouldBe` True
 
-testMessageNotifications :: ATransport -> Spec
-testMessageNotifications (ATransport t) =
-  it "should create simplex connection, subscribe notifier and deliver notifications" $ do
+testMessageNotifications :: SpecWith (ATransport, AMSType)
+testMessageNotifications =
+  it "should create simplex connection, subscribe notifier and deliver notifications" $ \(ATransport t, msType) -> do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    smpTest4 t $ \rh sh nh1 nh2 -> do
+    smpTest4 t msType $ \rh sh nh1 nh2 -> do
       (sId, rId, rKey, dhShared) <- createAndSecureQueue rh sPub
       let dec = decryptMsgV3 dhShared
       (rcvNtfPubDhKey, _) <- atomically $ C.generateKeyPair g
@@ -942,12 +944,12 @@ testMessageNotifications (ATransport t) =
         Nothing -> pure ()
         Just _ -> error "nothing else should be delivered to the 2nd notifier's TCP connection"
 
-testMsgExpireOnSend :: forall c. Transport c => TProxy c -> Spec
-testMsgExpireOnSend t =
-  it "should expire messages that are not received before messageTTL on SEND" $ do
+testMsgExpireOnSend :: SpecWith (ATransport, AMSType)
+testMsgExpireOnSend =
+  it "should expire messages that are not received before messageTTL on SEND" $ \(ATransport (t :: TProxy c), msType) -> do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    let cfg' = cfg {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 10000}}
+    let cfg' = (cfgMS msType) {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 10000}}
     withSmpServerConfigOn (ATransport t) cfg' testPort $ \_ ->
       testSMPClient @c $ \sh -> do
         (sId, rId, rKey, dhShared) <- testSMPClient @c $ \rh -> createAndSecureQueue rh sPub
@@ -962,13 +964,13 @@ testMsgExpireOnSend t =
             Nothing -> return ()
             Just _ -> error "nothing else should be delivered"
 
-testMsgExpireOnInterval :: forall c. Transport c => TProxy c -> Spec
-testMsgExpireOnInterval t =
+testMsgExpireOnInterval :: SpecWith (ATransport, AMSType)
+testMsgExpireOnInterval =
   -- fails on ubuntu
-  xit' "should expire messages that are not received before messageTTL after expiry interval" $ do
+  xit' "should expire messages that are not received before messageTTL after expiry interval" $ \(ATransport (t :: TProxy c), msType) -> do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    let cfg' = cfg {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
+    let cfg' = (cfgMS msType) {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
     withSmpServerConfigOn (ATransport t) cfg' testPort $ \_ ->
       testSMPClient @c $ \sh -> do
         (sId, rId, rKey, _) <- testSMPClient @c $ \rh -> createAndSecureQueue rh sPub
@@ -982,12 +984,12 @@ testMsgExpireOnInterval t =
             Nothing -> return ()
             Just _ -> error "nothing should be delivered"
 
-testMsgNOTExpireOnInterval :: forall c. Transport c => TProxy c -> Spec
-testMsgNOTExpireOnInterval t =
-  it "should NOT expire messages that are not received before messageTTL if expiry interval is large" $ do
+testMsgNOTExpireOnInterval :: SpecWith (ATransport, AMSType)
+testMsgNOTExpireOnInterval =
+  it "should NOT expire messages that are not received before messageTTL if expiry interval is large" $ \(ATransport (t :: TProxy c), msType) -> do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    let cfg' = cfg {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 10000}}
+    let cfg' = (cfgMS msType) {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 10000}}
     withSmpServerConfigOn (ATransport t) cfg' testPort $ \_ ->
       testSMPClient @c $ \sh -> do
         (sId, rId, rKey, dhShared) <- testSMPClient @c $ \rh -> createAndSecureQueue rh sPub
@@ -1020,8 +1022,8 @@ instance Eq C.ASignature where
     Just Refl -> s == s'
     _ -> False
 
-syntaxTests :: ATransport -> Spec
-syntaxTests (ATransport t) = do
+serverSyntaxTests :: ATransport -> Spec
+serverSyntaxTests (ATransport t) = do
   it "unknown command" $ ("", "abcd", "1234", ('H', 'E', 'L', 'L', 'O')) >#> ("", "abcd", "1234", ERR $ CMD UNKNOWN)
   describe "NEW" $ do
     it "no parameters" $ (sampleSig, "bcda", "", NEW_) >#> ("", "bcda", "", ERR $ CMD SYNTAX)
diff --git a/tests/Test.hs b/tests/Test.hs
index 6ae4edb41..f8505b133 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -25,8 +25,9 @@ import NtfServerTests (ntfServerTests)
 import RemoteControl (remoteControlTests)
 import SMPProxyTests (smpProxyTests)
 import ServerTests
+import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..))
 import Simplex.Messaging.Transport (TLS, Transport (..))
-import Simplex.Messaging.Transport.WebSockets (WS)
+-- import Simplex.Messaging.Transport.WebSockets (WS)
 import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
 import System.Environment (setEnv)
 import Test.Hspec
@@ -60,8 +61,14 @@ main = do
           describe "Store log tests" storeLogTests
           describe "TRcvQueues tests" tRcvQueuesTests
           describe "Util tests" utilTests
-        describe "SMP server via TLS" $ serverTests (transport @TLS)
-        xdescribe "SMP server via WebSockets" $ serverTests (transport @WS)
+        describe "SMP server via TLS, jornal message store" $ do
+          describe "SMP syntax" $ serverSyntaxTests (transport @TLS)
+          before (pure (transport @TLS, AMSType SMSJournal)) serverTests
+        describe "SMP server via TLS, memory message store" $
+          before (pure (transport @TLS, AMSType SMSMemory)) serverTests
+        -- xdescribe "SMP server via WebSockets" $ do
+        --   describe "SMP syntax" $ serverSyntaxTests (transport @WS)
+        --   before (pure (transport @WS, AMSType SMSJournal)) serverTests
         describe "Notifications server" $ ntfServerTests (transport @TLS)
         describe "SMP client agent" $ agentTests (transport @TLS)
         describe "SMP proxy" smpProxyTests

From 2322f5bf59c79053a4d9e0141db8f5654e6219ff Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 24 Oct 2024 19:44:47 +0100
Subject: [PATCH 170/195] smp server: logging format, mask/handle exceptions
 during journal store operations (#1381)

* smp server: fixed logging format for journal store errors

* version

* colon

* logs

* refactor

* space

* remove comment

* log file name in fixFileSize

* logError

* stricter

* process all queues more efficiently

* use monoid for queue processing

* expire messages concurrently

* concurrently 2

* Revert "concurrently 2"

This reverts commit c1aee1f22c9174b559a66d2c9568cbb8772b61e0.

* Revert "expire messages concurrently"

This reverts commit fc53137cdba58627f1b050271ad0c2dfba6d4460.

* show queue directory or ID in errors

* foldM

* mask_

* try

* mask more

* refactor

* command to delete journal

* uninterruptibleMask_ when writing to state file

* fix ghc8.10.7

* version

* revert version
---
 src/Simplex/Messaging/Server.hs               |  36 +++--
 src/Simplex/Messaging/Server/Main.hs          |  16 +-
 .../Messaging/Server/MsgStore/Journal.hs      | 150 ++++++++++--------
 src/Simplex/Messaging/Server/MsgStore/STM.hs  |   8 +-
 .../Messaging/Server/MsgStore/Types.hs        |  12 +-
 5 files changed, 130 insertions(+), 92 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 0574b9387..7b539ec69 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -68,6 +68,7 @@ import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
+import Data.Semigroup (Sum (..))
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
@@ -148,6 +149,14 @@ data MessageStats = MessageStats
     storedQueues :: Int
   }
 
+instance Monoid MessageStats where
+  mempty = MessageStats 0 0 0
+  {-# INLINE mempty #-}
+
+instance Semigroup MessageStats where
+  MessageStats a b c <> MessageStats x y z = MessageStats (a + x) (b + y) (c + z)
+  {-# INLINE (<>) #-}
+
 newMessageStats :: MessageStats
 newMessageStats = MessageStats 0 0 0
 
@@ -378,11 +387,12 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
       liftIO $ forever $ do
         threadDelay' interval
         old <- expireBeforeEpoch expCfg
-        void $ withActiveMsgQueues ms (\_ -> expireQueueMsgs stats old) 0
+        Sum deleted <- withActiveMsgQueues ms $ \_ -> expireQueueMsgs stats old
+        logInfo $ "STORE: expireMessagesThread, expired " <> tshow deleted <> " messages"
       where
-        expireQueueMsgs stats old q acc =
+        expireQueueMsgs stats old q =
           runExceptT (deleteExpiredMsgs q True old) >>= \case
-            Right deleted -> (acc + deleted) <$ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
+            Right deleted -> Sum deleted <$ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
             Left _ -> pure 0
 
     expireNtfsThread :: ServerConfig -> M ()
@@ -1738,10 +1748,10 @@ saveServerMessages drainMsgs =
 exportMessages :: MsgStoreClass s => s -> FilePath -> Bool -> IO ()
 exportMessages ms f drainMsgs = do
   logInfo $ "saving messages to file " <> T.pack f
-  total <- liftIO $ withFile f WriteMode $ \h -> withAllMsgQueues ms (saveQueueMsgs h) 0
+  Sum total <- liftIO $ withFile f WriteMode $ withAllMsgQueues ms . saveQueueMsgs
   logInfo $ "messages saved: " <> tshow total
   where
-    saveQueueMsgs h rId q acc = getQueueMessages drainMsgs q >>= \msgs -> (acc + length msgs) <$ BLD.hPutBuilder h (encodeMessages rId msgs)
+    saveQueueMsgs h rId q = getQueueMessages drainMsgs q >>= \msgs -> Sum (length msgs) <$ BLD.hPutBuilder h (encodeMessages rId msgs)
     encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
 
 processServerMessages :: M MessageStats
@@ -1757,18 +1767,17 @@ processServerMessages = do
         AMS SMSJournal ms -> case old_ of
           Just old -> do
             logInfo "expiring journal store messages..."
-            (storedMsgsCount, expiredMsgsCount, storedQueues) <- withAllMsgQueues ms (\_ -> processExpireQueue old) (0, 0, 0)
-            pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues}
+            withAllMsgQueues ms $ \_ -> processExpireQueue old
           Nothing -> do
             logInfo "validating journal store messages..."
-            (storedMsgsCount, storedQueues) <- withAllMsgQueues ms (\_ -> processValidateQueue) (0, 0)
-            pure MessageStats {storedMsgsCount, expiredMsgsCount = 0, storedQueues}
+            withAllMsgQueues ms $ \_ -> processValidateQueue
         where
-          processExpireQueue old q (!stored, !expired, !qCount) =
+          processExpireQueue old q =
             runExceptT expireQueue >>= \case
-              Right (stored', expired') -> pure (stored + stored', expired + expired', qCount + 1)
+              Right (storedMsgsCount, expiredMsgsCount) ->
+                pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = 1}
               Left e -> do
-                logInfo $ "failed expiring messages in queue " <> T.pack (queueDirectory $ queue q) <> ": " <> tshow e
+                logError $ "failed expiring messages in queue " <> T.pack (queueDirectory $ queue q) <> ": " <> tshow e
                 exitFailure
             where
               expireQueue = do
@@ -1777,7 +1786,8 @@ processServerMessages = do
                 liftIO $ logQueueState q
                 liftIO $ closeMsgQueue q
                 pure (stored'', expired'')
-          processValidateQueue q (!stored, !qCount) = getQueueSize q >>= \stored' -> pure (stored + stored', qCount + 1)
+          processValidateQueue q =
+            getQueueSize q >>= \storedMsgsCount -> pure mempty {storedMsgsCount, storedQueues = 1}
 
 importMessages :: forall s. MsgStoreClass s => s -> FilePath -> Maybe Int64 -> IO MessageStats
 importMessages ms f old_ = do
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 5abe0b331..f728e6be8 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -85,9 +85,9 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
     Journal cmd -> withIniFile $ \ini -> do
       msgsDirExists <- doesDirectoryExist storeMsgsJournalDir
       msgsFileExists <- doesFileExist storeMsgsFilePath
-      when (msgsFileExists && msgsDirExists) exitConfigureMsgStorage
       case cmd of
         JCImport
+          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
           | msgsDirExists -> do
               putStrLn $ storeMsgsJournalDir <> " directory already exists."
               exitFailure
@@ -107,6 +107,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 Right (AMSType SMSJournal) -> "store_messages set to `journal`"
                 Left e -> e <> ", update it to `journal` in INI file"
         JCExport
+          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
           | msgsFileExists -> do
               putStrLn $ storeMsgsFilePath <> " file already exists."
               exitFailure
@@ -121,6 +122,16 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 Right (AMSType SMSMemory) -> "store_messages set to `memory`"
                 Right (AMSType SMSJournal) -> "store_messages set to `journal`, update it to `memory` in INI file"
                 Left e -> e <> ", update it to `memory` in INI file"
+        JCDelete
+          | not msgsDirExists -> do
+              putStrLn $ storeMsgsJournalDir <> " directory does not exists."
+              exitFailure
+          | otherwise -> do
+              confirmOrExit
+                ("WARNING: journal directory " <> storeMsgsJournalDir <> " will be permanently deleted.\nTHIS CANNOT BE UNDONE!")
+                "Messages NOT deleted"
+              deleteDirIfExists storeMsgsJournalDir
+              putStrLn $ "Deleted all messages in journal " <> storeMsgsJournalDir
   where
     withIniFile a =
       doesFileExist iniFile >>= \case
@@ -609,7 +620,7 @@ data CliCommand
   | Delete
   | Journal JournalCmd
 
-data JournalCmd = JCImport | JCExport
+data JournalCmd = JCImport | JCExport | JCDelete
 
 data InitOptions = InitOptions
   { enableStoreLog :: Bool,
@@ -785,6 +796,7 @@ cliCommandP cfgPath logPath iniFile =
       hsubparser
         ( command "import" (info (pure JCImport) (progDesc "Import message log file into a new journal storage"))
             <> command "export" (info (pure JCExport) (progDesc "Export journal storage to message log file"))
+            <> command "delete" (info (pure JCDelete) (progDesc "Delete journal storage"))
         )
 
     parseBasicAuth :: ReadM ServerPassword
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index 564a9a804..b87b53dd7 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -40,11 +40,13 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Trans.Except
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Bitraversable (bimapM)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Functor (($>))
 import Data.Int (Int64)
+import Data.List (intercalate)
 import Data.Maybe (catMaybes, fromMaybe)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
@@ -190,7 +192,7 @@ msgLogFileName = "messages"
 logFileExt :: String
 logFileExt = ".log"
 
-newtype StoreIO a = StoreIO (IO a)
+newtype StoreIO a = StoreIO {unStoreIO :: IO a}
   deriving newtype (Functor, Applicative, Monad)
 
 instance MsgStoreClass JournalMsgStore where
@@ -214,48 +216,47 @@ instance MsgStoreClass JournalMsgStore where
   -- It is used to export storage to a single file and also to expire messages and validate all queues when server is started.
   -- TODO this function requires case-sensitive file system, because it uses queue directory as recipient ID.
   -- It can be made to support case-insensite FS by supporting more than one queue per directory, by getting recipient ID from state file name.
-  withAllMsgQueues :: JournalMsgStore -> (RecipientId -> JournalMsgQueue -> a -> IO a) -> a -> IO a
-  withAllMsgQueues ms@JournalMsgStore {config} action res = ifM (doesDirectoryExist storePath) processStore (pure res)
+  withAllMsgQueues :: forall a. Monoid a => JournalMsgStore -> (RecipientId -> JournalMsgQueue -> IO a) -> IO a
+  withAllMsgQueues ms@JournalMsgStore {config} action = ifM (doesDirectoryExist storePath) processStore (pure mempty)
     where
       processStore = do
         closeMsgStore ms
         lock <- createLockIO -- the same lock is used for all queues
-        dirs <- zip [0..] <$> listQueueDirs 0 ("", storePath)
-        let count = length dirs
-        res' <- foldM (processQueue lock count) res dirs
-        progress count count
+        (!count, !res) <- foldQueues 0 (processQueue lock) (0, mempty) ("", storePath)
+        progress count
         putStrLn ""
-        pure res'
+        pure res
       JournalStoreConfig {storePath, pathParts} = config
-      processQueue queueLock count acc (i :: Int, (queueId, dir)) = do
-        when (i `mod` 100 == 0) $ progress i count
-        let statePath = dir </> queueLogFileName <> "." <> queueId <> logFileExt
-            queue = JMQueue {queueDirectory = dir, queueLock, statePath}
-        q <- openMsgQueue ms queue
-        acc' <- case strDecode $ B.pack queueId of
-          Right rId -> action rId q acc
+      processQueue :: Lock -> (Int, a) -> (String, FilePath) -> IO (Int, a)
+      processQueue queueLock (!i, !r) (queueId, dir) = do
+        when (i `mod` 100 == 0) $ progress i
+        let statePath = msgQueueStatePath dir queueId
+        q <- openMsgQueue ms JMQueue {queueDirectory = dir, queueLock, statePath}
+        r' <- case strDecode $ B.pack queueId of
+          Right rId -> action rId q
           Left e -> do
             putStrLn ("Error: message queue directory " <> dir <> " is invalid: " <> e)
             exitFailure
         closeMsgQueue q
-        pure acc'
-      progress i count = do
-        putStr $ "Processed: " <> show i <> "/" <> show count <> " queues\r"
+        pure (i + 1, r <> r')
+      progress i = do
+        putStr $ "Processed: " <> show i <> " queues\r"
         IO.hFlush stdout
-      listQueueDirs depth (queueId, path)
-        | depth == pathParts - 1 = listDirs
-        | otherwise = fmap concat . mapM (listQueueDirs (depth + 1)) =<< listDirs
+      foldQueues depth f acc (queueId, path) = do
+        let f' = if depth == pathParts - 1 then f else foldQueues (depth + 1) f
+        listDirs >>= foldM f' acc
         where
           listDirs = fmap catMaybes . mapM queuePath =<< listDirectory path
           queuePath dir = do
-            let path' = path </> dir
+            let !path' = path </> dir
+                !queueId' = queueId <> dir
             ifM
               (doesDirectoryExist path')
-              (pure $ Just (queueId <> dir, path'))
+              (pure $ Just (queueId', path'))
               (Nothing <$ putStrLn ("Error: path " <> path' <> " is not a directory, skipping"))
 
   logQueueStates :: JournalMsgStore -> IO ()
-  logQueueStates ms = withActiveMsgQueues ms (\_ q _ -> logQueueState q) ()
+  logQueueStates ms = withActiveMsgQueues ms $ \_ -> logQueueState
 
   logQueueState :: JournalMsgQueue -> IO ()
   logQueueState q = 
@@ -264,13 +265,13 @@ instance MsgStoreClass JournalMsgStore where
 
   getMsgQueue :: JournalMsgStore -> RecipientId -> ExceptT ErrorType IO JournalMsgQueue
   getMsgQueue ms@JournalMsgStore {queueLocks, msgQueues, random} rId =
-    tryStore "getMsgQueue" $ withLockMap queueLocks rId "getMsgQueue" $
+    tryStore "getMsgQueue" (B.unpack $ strEncode rId) $ withLockMap queueLocks rId "getMsgQueue" $
       TM.lookupIO rId msgQueues >>= maybe newQ pure
     where
       newQ = do
         queueLock <- atomically $ getMapLock queueLocks rId
         let dir = msgQueueDirectory ms rId
-            statePath = dir </> (queueLogFileName <> "." <> B.unpack (strEncode rId) <> logFileExt)
+            statePath = msgQueueStatePath dir $ B.unpack (strEncode rId)
             queue = JMQueue {queueDirectory = dir, queueLock, statePath}
         q <- ifM (doesDirectoryExist dir) (openMsgQueue ms queue) (createQ queue)
         atomically $ TM.insert rId q msgQueues
@@ -306,8 +307,8 @@ instance MsgStoreClass JournalMsgStore where
             (msg :) <$> getMsg msgs hs
 
   writeMsg :: JournalMsgStore -> JournalMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  writeMsg ms q@JournalMsgQueue {queue = JMQueue {queueDirectory, queueLock, statePath}, handles} logState !msg =
-    tryStore "writeMsg" $ withLock' queueLock "writeMsg" $ do
+  writeMsg ms q@JournalMsgQueue {queue = JMQueue {queueDirectory, statePath}, handles} logState msg =
+    isolateQueue q "writeMsg" $ StoreIO $ do
       st@MsgQueueState {canWrite, size} <- readTVarIO (state q)
       let empty = size == 0
       if canWrite || empty
@@ -319,8 +320,8 @@ instance MsgStoreClass JournalMsgStore where
         else pure Nothing
     where
       JournalStoreConfig {quota, maxMsgCount} = config ms
-      !msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
-      writeToJournal st@MsgQueueState {writeState, readState = rs, size} canWrt' msg' = do
+      msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
+      writeToJournal st@MsgQueueState {writeState, readState = rs, size} canWrt' !msg' = do
         let msgStr = strEncode msg' `B.snoc` '\n'
             msgLen = fromIntegral $ B.length msgStr
         hs <- maybe createQueueDir pure =<< readTVarIO handles
@@ -332,9 +333,9 @@ instance MsgStoreClass JournalMsgStore where
             ws' = ws {msgPos = msgPos', msgCount = msgPos', bytePos = bytePos', byteCount = bytePos'}
             rs' = if journalId ws == journalId rs then rs {msgCount = msgPos', byteCount = bytePos'} else rs
             !st' = st {writeState = ws', readState = rs', canWrite = canWrt', size = size + 1}
-        when (size == 0) $ atomically $ writeTVar (tipMsg q) $ Just (Just (msg, msgLen))
         hAppend wh (bytePos ws) msgStr
-        updateQueueState q logState hs st'
+        updateQueueState q logState hs st' $
+          when (size == 0) $ writeTVar (tipMsg q) $ Just (Just (msg, msgLen))
         where
           createQueueDir = do
             createDirectoryIfMissing True queueDirectory
@@ -377,19 +378,21 @@ instance MsgStoreClass JournalMsgStore where
         $>>= \hs -> updateReadPos q logState len hs $> Just ()
 
   isolateQueue :: JournalMsgQueue -> String -> StoreIO a -> ExceptT ErrorType IO a
-  isolateQueue q op (StoreIO a) = tryStore op $ withLock' (queueLock $ queue q) op $ a
+  isolateQueue JournalMsgQueue {queue = q} op =
+    tryStore op (queueDirectory q) . withLock' (queueLock q) op . unStoreIO
 
-tryStore :: String -> IO a -> ExceptT ErrorType IO a
-tryStore op a =
-  ExceptT $
-    (Right <$> a) `catchAny` \e ->
-      let e' = op <> " " <> show e
-       in logError ("STORE ERROR " <> T.pack e') $> Left (STORE e')
+tryStore :: String -> String -> IO a -> ExceptT ErrorType IO a
+tryStore op qId a = ExceptT $ E.mask_ $ E.try a >>= bimapM storeErr pure
+  where
+    storeErr :: E.SomeException -> IO ErrorType
+    storeErr e =
+      let e' = intercalate ", " [op, qId, show e]
+       in logError ("STORE: " <> T.pack e') $> STORE e'
 
 openMsgQueue :: JournalMsgStore -> JMQueue -> IO JournalMsgQueue
 openMsgQueue ms q@JMQueue {queueDirectory = dir, statePath} = do
   (st, sh) <- readWriteQueueState ms statePath
-  (st', rh, wh_) <- openJournals dir st
+  (st', rh, wh_) <- closeOnException sh $ openJournals dir st sh
   let hs = MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = wh_}
   mkJournalQueue q (st', Just hs)
 
@@ -413,19 +416,19 @@ chooseReadJournal q log' hs = do
       removeJournal (queueDirectory $ queue q) rs
       let !rs' = (newJournalState $ journalId ws) {msgCount = msgCount ws, byteCount = byteCount ws}
           !st' = st {readState = rs'}
-      updateQueueState q log' hs st'
+      updateQueueState q log' hs st' $ pure ()
       pure $ Just (rs', wh)
     _ | msgPos rs >= msgCount rs && journalId rs == journalId ws -> pure Nothing
     _ -> pure $ Just (rs, readHandle hs)
 
-updateQueueState :: JournalMsgQueue -> Bool -> MsgQueueHandles -> MsgQueueState -> IO ()
-updateQueueState q log' hs st = do
-  unless (validQueueState st) $ E.throwIO $ userError $ "updating to invalid state: " <> show st
+updateQueueState :: JournalMsgQueue -> Bool -> MsgQueueHandles -> MsgQueueState -> STM () -> IO ()
+updateQueueState q log' hs st a = do
+  unless (validQueueState st) $ E.throwIO $ userError $ "updateQueueState invalid state: " <> show st
   when log' $ appendState (stateHandle hs) st
-  atomically $ writeTVar (state q) st
+  atomically $ writeTVar (state q) st >> a
 
 appendState :: Handle -> MsgQueueState -> IO ()
-appendState h st = B.hPutStr h $ strEncode st `B.snoc` '\n'
+appendState h st = E.uninterruptibleMask_ $ B.hPutStr h $ strEncode st `B.snoc` '\n'
 
 updateReadPos :: JournalMsgQueue -> Bool -> Int64 -> MsgQueueHandles -> IO ()
 updateReadPos q log' len hs = do
@@ -434,8 +437,7 @@ updateReadPos q log' len hs = do
   let msgPos' = msgPos + 1
       rs' = rs {msgPos = msgPos', bytePos = bytePos + len}
       st' = st {readState = rs', size = size - 1}
-  updateQueueState q log' hs st'              
-  atomically $ writeTVar (tipMsg q) Nothing
+  updateQueueState q log' hs st' $ writeTVar (tipMsg q) Nothing
 
 msgQueueDirectory :: JournalMsgStore -> RecipientId -> FilePath
 msgQueueDirectory JournalMsgStore {config = JournalStoreConfig {storePath, pathParts}} rId =
@@ -447,6 +449,9 @@ msgQueueDirectory JournalMsgStore {config = JournalStoreConfig {storePath, pathP
       let (seg, s') = B.splitAt 2 s
        in seg : splitSegments (n - 1) s'
 
+msgQueueStatePath :: FilePath -> String -> FilePath
+msgQueueStatePath dir queueId = dir </> (queueLogFileName <> "." <> queueId <> logFileExt)
+
 createNewJournal :: FilePath -> ByteString -> IO Handle
 createNewJournal dir journalId = do
   let path = journalFilePath dir journalId -- TODO retry if file exists
@@ -457,33 +462,33 @@ createNewJournal dir journalId = do
 newJournalId :: TVar StdGen -> IO ByteString
 newJournalId g = strEncode <$> atomically (stateTVar g $ genByteString 12)
 
-openJournals :: FilePath -> MsgQueueState -> IO (MsgQueueState, Handle, Maybe Handle)
-openJournals dir st@MsgQueueState {readState = rs, writeState = ws} = do
-  -- TODO verify that file exists, what to do if it's not, or if its state diverges
-  -- TODO check current position matches state, fix if not
+openJournals :: FilePath -> MsgQueueState -> Handle -> IO (MsgQueueState, Handle, Maybe Handle)
+openJournals dir st@MsgQueueState {readState = rs, writeState = ws} sh = do
   let rjId = journalId rs
       wjId = journalId ws
   openJournal rs >>= \case
     Left path -> do
-      logError $ "STORE ERROR no read file " <> T.pack path <> ", creating new file"
+      logError $ "STORE: openJournals, no read file - creating new file, " <> T.pack path
       rh <- createNewJournal dir rjId
       let st' = newMsgQueueState rjId
+      closeOnException rh $ appendState sh st'
       pure (st', rh, Nothing)
     Right rh
       | rjId == wjId -> do
-          fixFileSize rh $ bytePos ws
+          closeOnException rh $ fixFileSize rh $ bytePos ws
           pure (st, rh, Nothing)
-      | otherwise -> do
+      | otherwise -> closeOnException rh $ do
           fixFileSize rh $ byteCount rs
           openJournal ws >>= \case
             Left path -> do
-              logError $ "STORE ERROR no write file " <> T.pack path <> ", creating new file"
+              logError $ "STORE: openJournals, no write file - creating new file, " <> T.pack path
               wh <- createNewJournal dir wjId
               let size' = msgCount rs - msgPos rs
                   st' = st {writeState = newJournalState wjId, size = size'} -- we don't amend canWrite to trigger QCONT
+              closeOnException wh $ appendState sh st'
               pure (st', rh, Just wh)
             Right wh -> do
-              fixFileSize wh $ bytePos ws
+              closeOnException wh $ fixFileSize wh $ bytePos ws
               pure (st, rh, Just wh)
   where
     openJournal :: JournalState t -> IO (Either FilePath Handle)
@@ -498,17 +503,19 @@ fixFileSize h pos = do
   size <- IO.hFileSize h
   if
     | size > pos' -> do
-        logWarn $ "STORE WARNING truncating file size from " <> tshow size <> " to " <> tshow pos
+        name <- IO.hShow h
+        logWarn $ "STORE: fixFileSize, size " <> tshow size <> " > pos " <> tshow pos <> " - truncating, " <> T.pack name
         IO.hSetFileSize h pos'
-    | size < pos' ->
+    | size < pos' -> do
         -- From code logic this can't happen.
-        E.throwIO $ userError $ "file size " <> show size <> " is smaller than position " <> show pos
+        name <- IO.hShow h
+        E.throwIO $ userError $ "fixFileSize size " <> show size <> " < pos " <> show pos <> " - aborting: " <> name
     | otherwise -> pure ()
 
 removeJournal :: FilePath -> JournalState t -> IO ()
 removeJournal dir JournalState {journalId} = do
   let path = journalFilePath dir journalId
-  removeFile path `catchAny` (\e -> logError $ "STORE ERROR removing file " <> T.pack path <> ": " <> tshow e)
+  removeFile path `catchAny` (\e -> logError $ "STORE: removeJournal, " <> T.pack path <> ", " <> tshow e)
 
 -- This function is supposed to be resilient to crashes while updating state files,
 -- and also resilient to crashes during its execution.
@@ -526,10 +533,10 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
         [] -> writeNewQueueState
         _ -> do
           r@(st, _) <- useLastLine (length ls) True ls
-          unless (validQueueState st) $ E.throwIO $ userError $ "read invalid invalid: " <> show st
+          unless (validQueueState st) $ E.throwIO $ userError $ "readWriteQueueState inconsistent state: " <> show st
           pure r
     writeNewQueueState = do
-      logWarn $ "STORE WARNING: empty queue state in " <> T.pack statePath <> ", initialized"
+      logWarn $ "STORE: readWriteQueueState, empty queue state - initialized, " <> T.pack statePath
       st <- newMsgQueueState <$> newJournalId random
       writeQueueState st
     useLastLine len isLastLine ls = case strDecode $ LB.toStrict $ last ls of
@@ -543,13 +550,13 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
       Left e -- if the last line failed to parse
         | isLastLine -> case init ls of -- or use the previous line
             [] -> do
-              logWarn $ "STORE WARNING: invalid 1-line queue state " <> T.pack statePath <> ", initialized"
+              logWarn $ "STORE: readWriteQueueState, invalid 1-line queue state - initialized, " <> T.pack statePath
               st <- newMsgQueueState <$> newJournalId random
               backupWriteQueueState st
             ls' -> do
-              logWarn $ "STORE WARNING: invalid last line in queue state " <> T.pack statePath <> ", using the previous line"
+              logWarn $ "STORE: readWriteQueueState, invalid last line in queue state - using the previous line, " <> T.pack statePath
               useLastLine len False ls'
-        | otherwise -> E.throwIO $ userError $ "reading queue state " <> statePath <> ": " <> show e
+        | otherwise -> E.throwIO $ userError $ "readWriteQueueState invalid state " <> statePath <> ": " <> show e
     backupWriteQueueState st = do
       -- State backup is made in two steps to mitigate the crash during the backup.
       -- Temporary backup file will be used when it is present.
@@ -560,7 +567,7 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
       pure r
     writeQueueState st = do
       sh <- openFile statePath AppendMode
-      appendState sh st
+      closeOnException sh $ appendState sh st
       pure (st, sh)
 
 validQueueState :: MsgQueueState -> Bool
@@ -598,7 +605,7 @@ closeMsgQueue q = readTVarIO (handles q) >>= mapM_ closeHandles
 removeQueueDirectory :: JournalMsgStore -> RecipientId -> IO ()
 removeQueueDirectory st rId =
   let dir = msgQueueDirectory st rId
-   in removePathForcibly dir `catchAny` (\e -> logError $ "STORE ERROR removeQueueDirectory " <> T.pack dir <> ": " <> tshow e)
+   in removePathForcibly dir `catchAny` (\e -> logError $ "STORE: removeQueueDirectory, " <> T.pack dir <> ", " <> tshow e)
 
 hAppend :: Handle -> Int64 -> ByteString -> IO ()
 hAppend h pos s = do
@@ -614,7 +621,7 @@ hGetMsgAt h pos = do
     Right !msg ->
       let !len = fromIntegral (B.length s) + 1
        in pure (msg, len)
-    Left e -> E.throwIO $ userError $ "Error parsing message: " <> e
+    Left e -> E.throwIO $ userError $ "hGetMsgAt invalid message: " <> e
 
 openFile :: FilePath -> IOMode -> IO Handle
 openFile f mode = do
@@ -623,4 +630,7 @@ openFile f mode = do
   pure h
 
 hClose :: Handle -> IO ()
-hClose h = IO.hClose h `catchAny` (\e -> logError $ "Error closing file" <> tshow e)
+hClose h = IO.hClose h `catchAny` (\e -> logError $ "STORE: hClose, error closing file, " <> tshow e)
+
+closeOnException :: Handle -> IO a -> IO a
+closeOnException h a = a `E.onException` hClose h
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index b08e99abe..f70a1e71d 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -96,7 +96,7 @@ instance MsgStoreClass STMMsgStore where
         pure msgs
 
   writeMsg :: STMMsgStore -> STMMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  writeMsg _ STMMsgQueue {msgQueue = q, quota, canWrite, size} _logState !msg = liftIO $ atomically $ do
+  writeMsg _ STMMsgQueue {msgQueue = q, quota, canWrite, size} _logState msg = liftIO $ atomically $ do
     canWrt <- readTVar canWrite
     empty <- isEmptyTQueue q
     if canWrt || empty
@@ -105,11 +105,11 @@ instance MsgStoreClass STMMsgStore where
         writeTVar canWrite $! canWrt'
         modifyTVar' size (+ 1)
         if canWrt'
-          then writeTQueue q msg $> Just (msg, empty)
-          else writeTQueue q msgQuota $> Nothing
+          then (writeTQueue q $! msg) $> Just (msg, empty)
+          else (writeTQueue q $! msgQuota) $> Nothing
       else pure Nothing
     where
-      !msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
+      msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
 
   setOverQuota_ :: STMMsgQueue -> IO ()
   setOverQuota_ q = atomically $ writeTVar (canWrite q) False
diff --git a/src/Simplex/Messaging/Server/MsgStore/Types.hs b/src/Simplex/Messaging/Server/MsgStore/Types.hs
index cd480b0ae..718aa95ca 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Types.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -9,6 +10,7 @@
 module Simplex.Messaging.Server.MsgStore.Types where
 
 import Control.Concurrent.STM
+import Control.Monad (foldM)
 import Control.Monad.Trans.Except
 import Data.Int (Int64)
 import Data.Kind
@@ -24,7 +26,7 @@ class Monad (StoreMonad s) => MsgStoreClass s where
   newMsgStore :: MsgStoreConfig s -> IO s
   closeMsgStore :: s -> IO ()
   activeMsgQueues :: s -> TMap RecipientId (MsgQueue s)
-  withAllMsgQueues :: s -> (RecipientId -> MsgQueue s -> a -> IO a) -> a -> IO a
+  withAllMsgQueues :: Monoid a => s -> (RecipientId -> MsgQueue s -> IO a) -> IO a
   logQueueStates :: s -> IO ()
   logQueueState :: MsgQueue s -> IO ()
   getMsgQueue :: s -> RecipientId -> ExceptT ErrorType IO (MsgQueue s)
@@ -46,8 +48,12 @@ data SMSType :: MSType -> Type where
 
 data AMSType = forall s. AMSType (SMSType s)
 
-withActiveMsgQueues :: MsgStoreClass s => s -> (RecipientId -> MsgQueue s -> a -> IO a) -> a -> IO a
-withActiveMsgQueues st f a = readTVarIO (activeMsgQueues st) >>= M.foldrWithKey (\k v -> (>>= f k v)) (pure a)
+withActiveMsgQueues :: (MsgStoreClass s, Monoid a) => s -> (RecipientId -> MsgQueue s -> IO a) -> IO a
+withActiveMsgQueues st f = readTVarIO (activeMsgQueues st) >>= foldM run mempty . M.assocs
+  where
+    run !acc (k, v) = do
+      r <- f k v
+      pure $! acc <> r
 
 tryPeekMsg :: MsgStoreClass s => MsgQueue s -> ExceptT ErrorType IO (Maybe Message)
 tryPeekMsg mq = isolateQueue mq "tryPeekMsg" $ tryPeekMsg_ mq

From a3351ad0600651422926c918bbdb8581880ae94c Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 25 Oct 2024 09:11:47 +0100
Subject: [PATCH 171/195] smp server: fix export of journal storage (#1384)

* smp: fix export of journal storage

* catch errors when exporting messages
---
 src/Simplex/Messaging/Server.hs               |  8 ++++++--
 .../Messaging/Server/MsgStore/Journal.hs      |  7 ++++---
 tests/CoreTests/MsgStoreTests.hs              | 20 +++++++++++++------
 3 files changed, 24 insertions(+), 11 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 7b539ec69..81c995bb2 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -1748,8 +1748,12 @@ saveServerMessages drainMsgs =
 exportMessages :: MsgStoreClass s => s -> FilePath -> Bool -> IO ()
 exportMessages ms f drainMsgs = do
   logInfo $ "saving messages to file " <> T.pack f
-  Sum total <- liftIO $ withFile f WriteMode $ withAllMsgQueues ms . saveQueueMsgs
-  logInfo $ "messages saved: " <> tshow total
+  liftIO $ withFile f WriteMode $ \h ->
+    tryAny (withAllMsgQueues ms $ saveQueueMsgs h) >>= \case
+      Right (Sum total) -> logInfo $ "messages saved: " <> tshow total
+      Left e -> do
+        logError $ "error exporting messages: " <> tshow e
+        exitFailure
   where
     saveQueueMsgs h rId q = getQueueMessages drainMsgs q >>= \msgs -> Sum (length msgs) <$ BLD.hPutBuilder h (encodeMessages rId msgs)
     encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index b87b53dd7..f98b5222a 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -297,14 +297,15 @@ instance MsgStoreClass JournalMsgStore where
     pure sz
 
   getQueueMessages :: Bool -> JournalMsgQueue -> IO [Message]
-  getQueueMessages drainMsgs q = readTVarIO (handles q) >>= maybe (pure []) (getMsg [])
+  getQueueMessages drainMsgs q = run []
     where
+      run msgs = readTVarIO (handles q) >>= maybe (pure []) (getMsg msgs)
       getMsg msgs hs = chooseReadJournal q drainMsgs hs >>= maybe (pure msgs) readMsg
         where
           readMsg (rs, h) = do
             (msg, len) <- hGetMsgAt h $ bytePos rs
             updateReadPos q drainMsgs len hs
-            (msg :) <$> getMsg msgs hs
+            (msg :) <$> run msgs
 
   writeMsg :: JournalMsgStore -> JournalMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
   writeMsg ms q@JournalMsgQueue {queue = JMQueue {queueDirectory, statePath}, handles} logState msg =
@@ -413,7 +414,7 @@ chooseReadJournal q log' hs = do
       -- switching to write journal
       atomically $ writeTVar (handles q) $ Just hs {readHandle = wh, writeHandle = Nothing}
       hClose $ readHandle hs
-      removeJournal (queueDirectory $ queue q) rs
+      when log' $ removeJournal (queueDirectory $ queue q) rs
       let !rs' = (newJournalState $ journalId ws) {msgCount = msgCount ws, byteCount = byteCount ws}
           !st' = st {readState = rs'}
       updateQueueState q log' hs st' $ pure ()
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index eaa9cc25b..fc00317a0 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -153,21 +153,29 @@ testExportImportStore ms = do
     Just (Message {}, True) <- write q1 "message 1"
     Just (Message {}, False) <- write q1 "message 2"
     q2 <- getMsgQueue ms rId2
-    Just (Message {}, True) <- write q2 "message 3"
-    Just (Message {}, False) <- write q2 "message 4"
-    Just (Message {}, False) <- write q2 "message 5"
-    Nothing <- write q2 "message 6"
+    Just (Message {msgId = mId3}, True) <- write q2 "message 3"
+    Just (Message {msgId = mId4}, False) <- write q2 "message 4"
+    (Msg "message 3", Msg "message 4") <- tryDelPeekMsg q2 mId3
+    (Msg "message 4", Nothing) <- tryDelPeekMsg q2 mId4
+    Just (Message {}, True) <- write q2 "message 5"
+    Just (Message {}, False) <- write q2 "message 6"
+    Just (Message {}, False) <- write q2 "message 7"
+    Nothing <- write q2 "message 8"
     pure ()
   length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
-  length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 2
+  length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 3
   exportMessages ms testStoreMsgsFile False
+  renameFile testStoreMsgsFile (testStoreMsgsFile <> ".copy")
+  closeMsgStore ms
+  exportMessages ms testStoreMsgsFile False
+  (B.readFile testStoreMsgsFile `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".copy")
   let cfg = (testJournalStoreCfg :: JournalStoreConfig) {storePath = testStoreMsgsDir2}
   ms' <- newMsgStore cfg
   stats@MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
     importMessages ms' testStoreMsgsFile Nothing
   printMessageStats "Messages" stats
   length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
-  length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 3 -- state file is backed up
+  length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 4 -- state file is backed up, 2 message files
   exportMessages ms' testStoreMsgsFile2 False
   (B.readFile testStoreMsgsFile2 `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".bak")
   stmStore <- newMsgStore testSMTStoreConfig

From a8471eed5be93e7c3741aa4742b24193c9a2d6f5 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Fri, 25 Oct 2024 15:39:41 +0400
Subject: [PATCH 172/195] ntf: get messages for multiple last notifications
 (#1378)

* ntf: get messages for multiple last notifications (#1352)

* ntf: separate get ntf conns api (#1379)

* ntf: separate get ntf conns api

* nonempty

* update

* update

* remove single get api

* fix test

* refactor

* refactor

* ntf: batch get connections (#1387)

* ntf: batch get apis

* works

* fix

* fix

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
---
 simplexmq.cabal                               |  1 +
 src/Simplex/Messaging/Agent.hs                | 93 ++++++++++++-------
 src/Simplex/Messaging/Agent/Client.hs         |  6 +-
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  9 +-
 .../Agent/Store/SQLite/Migrations.hs          |  4 +-
 .../M20241007_rcv_queues_last_broker_ts.hs    | 18 ++++
 .../Store/SQLite/Migrations/agent_schema.sql  |  1 +
 .../Messaging/Notifications/Protocol.hs       | 27 ++++++
 src/Simplex/Messaging/Notifications/Server.hs | 57 +++++++++++-
 .../Messaging/Notifications/Server/Env.hs     |  1 +
 .../Messaging/Notifications/Server/Main.hs    |  9 ++
 .../Notifications/Server/Push/APNS.hs         | 31 +------
 .../Messaging/Notifications/Server/Store.hs   | 52 ++++++++++-
 tests/AgentTests/FunctionalAPITests.hs        |  2 +-
 tests/AgentTests/NotificationTests.hs         | 13 ++-
 tests/NtfClient.hs                            |  6 +-
 tests/NtfServerTests.hs                       |  5 +-
 17 files changed, 248 insertions(+), 87 deletions(-)
 create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20241007_rcv_queues_last_broker_ts.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 95261aac4..78555eabc 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -136,6 +136,7 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
       Simplex.Messaging.Agent.TRcvQueues
       Simplex.Messaging.Client
       Simplex.Messaging.Client.Agent
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 961ccb2cf..dc6f4ad17 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -63,8 +63,8 @@ module Simplex.Messaging.Agent
     rejectContact,
     subscribeConnection,
     subscribeConnections,
-    getConnectionMessage,
-    getNotificationMessage,
+    getConnectionMessages,
+    getNotificationConns,
     resubscribeConnection,
     resubscribeConnections,
     sendMessage,
@@ -134,7 +134,7 @@ import Data.Bifunctor (bimap, first, second)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Composition ((.:), (.:.), (.::), (.::.))
-import Data.Either (isRight, rights)
+import Data.Either (isRight, partitionEithers, rights)
 import Data.Foldable (foldl', toList)
 import Data.Functor (($>))
 import Data.Functor.Identity
@@ -175,8 +175,7 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern P
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId)
-import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..), pnMessagesP)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId, PNMessageData (..), pnMessagesP)
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
 import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, sndAuthKeySMPClientVersion)
@@ -383,15 +382,15 @@ subscribeConnections :: AgentClient -> [ConnId] -> AE (Map ConnId (Either AgentE
 subscribeConnections c = withAgentEnv c . subscribeConnections' c
 {-# INLINE subscribeConnections #-}
 
--- | Get connection message (GET command)
-getConnectionMessage :: AgentClient -> ConnId -> AE (Maybe SMPMsgMeta)
-getConnectionMessage c = withAgentEnv c . getConnectionMessage' c
-{-# INLINE getConnectionMessage #-}
+-- | Get messages for connections (GET commands)
+getConnectionMessages :: AgentClient -> NonEmpty ConnId -> IO (NonEmpty (Maybe SMPMsgMeta))
+getConnectionMessages c = withAgentEnv' c . getConnectionMessages' c
+{-# INLINE getConnectionMessages #-}
 
--- | Get connection message for received notification
-getNotificationMessage :: AgentClient -> C.CbNonce -> ByteString -> AE (NotificationInfo, Maybe SMPMsgMeta)
-getNotificationMessage c = withAgentEnv c .: getNotificationMessage' c
-{-# INLINE getNotificationMessage #-}
+-- | Get connections for received notification
+getNotificationConns :: AgentClient -> C.CbNonce -> ByteString -> AE (NonEmpty NotificationInfo)
+getNotificationConns c = withAgentEnv c .: getNotificationConns' c
+{-# INLINE getNotificationConns #-}
 
 resubscribeConnection :: AgentClient -> ConnId -> AE ()
 resubscribeConnection c = withAgentEnv c . resubscribeConnection' c
@@ -1047,29 +1046,57 @@ resubscribeConnections' c connIds = do
   -- union is left-biased, so results returned by subscribeConnections' take precedence
   (`M.union` r) <$> subscribeConnections' c connIds'
 
-getConnectionMessage' :: AgentClient -> ConnId -> AM (Maybe SMPMsgMeta)
-getConnectionMessage' c connId = do
-  whenM (atomically $ hasActiveSubscription c connId) . throwE $ CMD PROHIBITED "getConnectionMessage: subscribed"
-  SomeConn _ conn <- withStore c (`getConn` connId)
-  case conn of
-    DuplexConnection _ (rq :| _) _ -> getQueueMessage c rq
-    RcvConnection _ rq -> getQueueMessage c rq
-    ContactConnection _ rq -> getQueueMessage c rq
-    SndConnection _ _ -> throwE $ CONN SIMPLEX
-    NewConnection _ -> throwE $ CMD PROHIBITED "getConnectionMessage: NewConnection"
+getConnectionMessages' :: AgentClient -> NonEmpty ConnId -> AM' (NonEmpty (Maybe SMPMsgMeta))
+getConnectionMessages' c = mapM getMsg
+  where
+    getMsg :: ConnId -> AM' (Maybe SMPMsgMeta)
+    getMsg connId =
+      getConnectionMessage connId `catchAgentError'` \e -> do
+        logError $ "Error loading message: " <> tshow e
+        pure Nothing
+    getConnectionMessage :: ConnId -> AM (Maybe SMPMsgMeta)
+    getConnectionMessage connId = do
+      whenM (atomically $ hasActiveSubscription c connId) . throwE $ CMD PROHIBITED "getConnectionMessage: subscribed"
+      SomeConn _ conn <- withStore c (`getConn` connId)
+      case conn of
+        DuplexConnection _ (rq :| _) _ -> getQueueMessage c rq
+        RcvConnection _ rq -> getQueueMessage c rq
+        ContactConnection _ rq -> getQueueMessage c rq
+        SndConnection _ _ -> throwE $ CONN SIMPLEX
+        NewConnection _ -> throwE $ CMD PROHIBITED "getConnectionMessage: NewConnection"
 
-getNotificationMessage' :: AgentClient -> C.CbNonce -> ByteString -> AM (NotificationInfo, Maybe SMPMsgMeta)
-getNotificationMessage' c nonce encNtfInfo = do
+getNotificationConns' :: AgentClient -> C.CbNonce -> ByteString -> AM (NonEmpty NotificationInfo)
+getNotificationConns' c nonce encNtfInfo =
   withStore' c getActiveNtfToken >>= \case
     Just NtfToken {ntfDhSecret = Just dhSecret} -> do
-      ntfData <- agentCbDecrypt dhSecret nonce encNtfInfo
+      ntfData <- liftEither $ agentCbDecrypt dhSecret nonce encNtfInfo
       pnMsgs <- liftEither (parse pnMessagesP (INTERNAL "error parsing PNMessageData") ntfData)
-      let PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} = L.last pnMsgs
-      (ntfConnId, rcvNtfDhSecret) <- withStore c (`getNtfRcvQueue` smpQueue)
-      ntfMsgMeta <- (eitherToMaybe . smpDecode <$> agentCbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta) `catchAgentError` \_ -> pure Nothing
-      msgMeta <- getConnectionMessage' c ntfConnId
-      pure (NotificationInfo {ntfConnId, ntfTs, ntfMsgMeta}, msgMeta)
-    _ -> throwE $ CMD PROHIBITED "getNotificationMessage"
+      let (initNtfs, lastNtf) = (L.init pnMsgs, L.last pnMsgs)
+      rs <-
+        lift $ withStoreBatch c $ \db ->
+          let initNtfInfos = map (getInitNtfInfo db) initNtfs
+              lastNtfInfo = Just . fst <$$> getNtfInfo db lastNtf
+           in initNtfInfos <> [lastNtfInfo]
+      let (errs, ntfInfos_) = partitionEithers rs
+      logError $ "Error(s) loading notifications: " <> tshow errs
+      case L.nonEmpty $ catMaybes ntfInfos_ of
+        Just r -> pure r
+        Nothing -> throwE $ INTERNAL "getNotificationConns: couldn't get conn info"
+    _ -> throwE $ CMD PROHIBITED "getNotificationConns"
+  where
+    getNtfInfo :: DB.Connection -> PNMessageData -> IO (Either AgentErrorType (NotificationInfo, Maybe UTCTime))
+    getNtfInfo db PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} = runExceptT $ do
+      (ntfConnId, rcvNtfDhSecret, lastBrokerTs_) <- liftError' storeError $ getNtfRcvQueue db smpQueue
+      let ntfMsgMeta = eitherToMaybe $ smpDecode =<< first show (C.cbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta)
+          ntfInfo = NotificationInfo {ntfConnId, ntfTs, ntfMsgMeta}
+      pure (ntfInfo, lastBrokerTs_)
+    getInitNtfInfo :: DB.Connection -> PNMessageData -> IO (Either AgentErrorType (Maybe NotificationInfo))
+    getInitNtfInfo db msgData = runExceptT $ do
+      (nftInfo, lastBrokerTs_) <- ExceptT $ getNtfInfo db msgData
+      pure $ case (ntfMsgMeta nftInfo, lastBrokerTs_) of
+        (Just SMP.NMsgMeta {msgTs}, Just lastBrokerTs)
+          | systemToUTCTime msgTs > lastBrokerTs -> Just nftInfo
+        _ -> Nothing
 
 -- | Send message to the connection (SEND command) in Reader monad
 sendMessage' :: AgentClient -> ConnId -> PQEncryption -> MsgFlags -> MsgBody -> AM (AgentMsgId, PQEncryption)
@@ -2479,7 +2506,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
 
           decryptClientMessage :: C.DhSecretX25519 -> SMP.ClientMsgEnvelope -> AM (SMP.PrivHeader, AgentMsgEnvelope)
           decryptClientMessage e2eDh SMP.ClientMsgEnvelope {cmNonce, cmEncBody} = do
-            clientMsg <- agentCbDecrypt e2eDh cmNonce cmEncBody
+            clientMsg <- liftEither $ agentCbDecrypt e2eDh cmNonce cmEncBody
             SMP.ClientMessage privHeader clientBody <- parseMessage clientMsg
             agentEnvelope <- parseMessage clientBody
             -- Version check is removed here, because when connecting via v1 contact address the agent still sends v2 message,
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 13d554f3c..212f0b13a 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1590,7 +1590,7 @@ getQueueMessage c rq@RcvQueue {server, rcvId, rcvPrivateKey} = do
 
 decryptSMPMessage :: RcvQueue -> SMP.RcvMessage -> AM SMP.ClientRcvMsgBody
 decryptSMPMessage rq SMP.RcvMessage {msgId, msgBody = SMP.EncRcvMsgBody body} =
-  liftEither . parse SMP.clientRcvMsgBodyP (AGENT A_MESSAGE) =<< decrypt body
+  liftEither $ parse SMP.clientRcvMsgBodyP (AGENT A_MESSAGE) =<< decrypt body
   where
     decrypt = agentCbDecrypt (rcvDhSecret rq) (C.cbNonce msgId)
 
@@ -1830,9 +1830,9 @@ agentCbEncryptOnce clientVersion dhRcvPubKey msg = do
 
 -- | NaCl crypto-box decrypt - both for messages received from the server
 -- and per-queue E2E encrypted messages from the sender that were inside.
-agentCbDecrypt :: C.DhSecretX25519 -> C.CbNonce -> ByteString -> AM ByteString
+agentCbDecrypt :: C.DhSecretX25519 -> C.CbNonce -> ByteString -> Either AgentErrorType ByteString
 agentCbDecrypt dhSecret nonce msg =
-  liftEither . first cryptoError $
+  first cryptoError $
     C.cbDecrypt dhSecret nonce msg
 
 cryptoError :: C.CryptoError -> AgentErrorType
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 924ba6712..259678f8f 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -976,10 +976,11 @@ updateRcvIds db connId = do
   pure (internalId, internalRcvId, lastExternalSndId, lastRcvHash)
 
 createRcvMsg :: DB.Connection -> ConnId -> RcvQueue -> RcvMsgData -> IO ()
-createRcvMsg db connId rq rcvMsgData@RcvMsgData {msgMeta = MsgMeta {sndMsgId}, internalRcvId, internalHash} = do
+createRcvMsg db connId rq@RcvQueue {dbQueueId} rcvMsgData@RcvMsgData {msgMeta = MsgMeta {sndMsgId, broker = (_, brokerTs)}, internalRcvId, internalHash} = do
   insertRcvMsgBase_ db connId rcvMsgData
   insertRcvMsgDetails_ db connId rq rcvMsgData
   updateRcvMsgHash db connId sndMsgId internalRcvId internalHash
+  DB.execute db "UPDATE rcv_queues SET last_broker_ts = ? WHERE conn_id = ? AND rcv_queue_id = ?" (brokerTs, connId, dbQueueId)
 
 updateSndIds :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
 updateSndIds db connId = runExceptT $ do
@@ -1817,19 +1818,19 @@ getActiveNtfToken db =
           ntfMode = fromMaybe NMPeriodic ntfMode_
        in NtfToken {deviceToken = DeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}
 
-getNtfRcvQueue :: DB.Connection -> SMPQueueNtf -> IO (Either StoreError (ConnId, RcvNtfDhSecret))
+getNtfRcvQueue :: DB.Connection -> SMPQueueNtf -> IO (Either StoreError (ConnId, RcvNtfDhSecret, Maybe UTCTime))
 getNtfRcvQueue db SMPQueueNtf {smpServer = (SMPServer host port _), notifierId} =
   firstRow' res SEConnNotFound $
     DB.query
       db
       [sql|
-        SELECT conn_id, rcv_ntf_dh_secret
+        SELECT conn_id, rcv_ntf_dh_secret, last_broker_ts
         FROM rcv_queues
         WHERE host = ? AND port = ? AND ntf_id = ? AND deleted = 0
       |]
       (host, port, notifierId)
   where
-    res (connId, Just rcvNtfDhSecret) = Right (connId, rcvNtfDhSecret)
+    res (connId, Just rcvNtfDhSecret, lastBrokerTs_) = Right (connId, rcvNtfDhSecret, lastBrokerTs_)
     res _ = Left SEConnNotFound
 
 setConnectionNtfs :: DB.Connection -> ConnId -> Bool -> IO ()
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
index 97cc08b68..7e58ceec5 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
@@ -75,6 +75,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_appro
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -118,7 +119,8 @@ schemaMigrations =
     ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
     ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
     ("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats),
-    ("m20240930_ntf_tokens_to_delete", m20240930_ntf_tokens_to_delete, Just down_m20240930_ntf_tokens_to_delete)
+    ("m20240930_ntf_tokens_to_delete", m20240930_ntf_tokens_to_delete, Just down_m20240930_ntf_tokens_to_delete),
+    ("m20241007_rcv_queues_last_broker_ts", m20241007_rcv_queues_last_broker_ts, Just down_m20241007_rcv_queues_last_broker_ts)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20241007_rcv_queues_last_broker_ts.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20241007_rcv_queues_last_broker_ts.hs
new file mode 100644
index 000000000..418449fe7
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20241007_rcv_queues_last_broker_ts.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20241007_rcv_queues_last_broker_ts :: Query
+m20241007_rcv_queues_last_broker_ts =
+    [sql|
+ALTER TABLE rcv_queues ADD COLUMN last_broker_ts TEXT;
+|]
+
+down_m20241007_rcv_queues_last_broker_ts :: Query
+down_m20241007_rcv_queues_last_broker_ts =
+    [sql|
+ALTER TABLE rcv_queues DROP COLUMN last_broker_ts;
+|]
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
index c7e458862..11e944e6b 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
@@ -56,6 +56,7 @@ CREATE TABLE rcv_queues(
   switch_status TEXT,
   deleted INTEGER NOT NULL DEFAULT 0,
   snd_secure INTEGER NOT NULL DEFAULT 0,
+  last_broker_ts TEXT,
   PRIMARY KEY(host, port, rcv_id),
   FOREIGN KEY(host, port) REFERENCES servers
   ON DELETE RESTRICT ON UPDATE CASCADE,
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 556d4a930..af8987dcc 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -20,8 +20,11 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Kind
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import Data.Maybe (isNothing)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
+import Data.Time.Clock.System
 import Data.Type.Equality
 import Data.Word (Word16)
 import Database.SQLite.Simple.FromField (FromField (..))
@@ -426,6 +429,30 @@ instance FromJSON DeviceToken where
     t <- encodeUtf8 <$> o .: "token"
     pure $ DeviceToken pp t
 
+-- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
+-- because strEncode of NonEmpty list uses comma for separator,
+-- and encoding of PNMessageData's smpQueue has comma in list of hosts
+encodePNMessages :: NonEmpty PNMessageData -> ByteString
+encodePNMessages = B.intercalate ";" . map strEncode . L.toList
+
+pnMessagesP :: A.Parser (NonEmpty PNMessageData)
+pnMessagesP = L.fromList <$> strP `A.sepBy1` A.char ';'
+
+data PNMessageData = PNMessageData
+  { smpQueue :: SMPQueueNtf,
+    ntfTs :: SystemTime,
+    nmsgNonce :: C.CbNonce,
+    encNMsgMeta :: EncNMsgMeta
+  }
+  deriving (Show)
+
+instance StrEncoding PNMessageData where
+  strEncode PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} =
+    strEncode (smpQueue, ntfTs, nmsgNonce, encNMsgMeta)
+  strP = do
+    (smpQueue, ntfTs, nmsgNonce, encNMsgMeta) <- strP
+    pure PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}
+
 type NtfEntityId = EntityId
 
 type NtfSubscriptionId = NtfEntityId
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 4e9f75f9e..81094e1a7 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -19,8 +19,11 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
+import Data.Bifunctor (first)
+import qualified Data.ByteString.Builder as BLD
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Either (partitionEithers)
 import Data.Functor (($>))
 import Data.IORef
@@ -46,7 +49,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Control
 import Simplex.Messaging.Notifications.Server.Env
-import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..), PushNotification (..), PushProviderError (..))
+import Simplex.Messaging.Notifications.Server.Push.APNS (PushNotification (..), PushProviderError (..))
 import Simplex.Messaging.Notifications.Server.Stats
 import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Notifications.Server.StoreLog
@@ -86,6 +89,7 @@ type M a = ReaderT NtfEnv IO a
 
 ntfServer :: NtfServerConfig -> TMVar Bool -> M ()
 ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
+  restoreServerLastNtfs
   restoreServerStats
   s <- asks subscriber
   ps <- asks pushServer
@@ -111,12 +115,14 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
 
     stopServer :: M ()
     stopServer = do
-      withNtfLog closeStoreLog
-      saveServerStats
+      saveServer
       NtfSubscriber {smpSubscribers, smpAgent} <- asks subscriber
       liftIO $ readTVarIO smpSubscribers >>= mapM_ (\SMPSubscriber {subThreadId} -> readTVarIO subThreadId >>= mapM_ (deRefWeak >=> mapM_ killThread))
       liftIO $ closeSMPClientAgent smpAgent
 
+    saveServer :: M ()
+    saveServer = withNtfLog closeStoreLog >> saveServerLastNtfs >> saveServerStats
+
     serverStatsThread_ :: NtfServerConfig -> [M ()]
     serverStatsThread_ NtfServerConfig {logStatsInterval = Just interval, logStatsStartTime, serverStatsLogFile} =
       [logServerStats logStatsStartTime interval serverStatsLogFile]
@@ -356,8 +362,11 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
               NtfPushServer {pushQ} <- asks pushServer
               stats <- asks serverStats
               liftIO $ updatePeriodStats (activeSubs stats) ntfId
-              atomically (findNtfSubscriptionToken st smpQueue)
-                >>= mapM_ (\tkn -> atomically (writeTBQueue pushQ (tkn, PNMessage (PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| []))))
+              tkn_ <- atomically (findNtfSubscriptionToken st smpQueue)
+              forM_ tkn_ $ \tkn -> do
+                let newNtf = PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}
+                lastNtfs <- liftIO $ addTokenLastNtf st (ntfTknId tkn) newNtf
+                atomically (writeTBQueue pushQ (tkn, PNMessage lastNtfs))
               incNtfStat ntfReceived
             Right SMP.END ->
               whenM (atomically $ activeClientSession' ca sessionId srv) $
@@ -725,6 +734,44 @@ incNtfStat statSel = do
   stats <- asks serverStats
   liftIO $ atomicModifyIORef'_ (statSel stats) (+ 1)
 
+saveServerLastNtfs :: M ()
+saveServerLastNtfs = asks (storeLastNtfsFile . config) >>= mapM_ saveLastNtfs
+  where
+    saveLastNtfs f = do
+      logInfo $ "saving last notifications to file " <> T.pack f
+      NtfStore {tokenLastNtfs} <- asks store
+      liftIO . withFile f WriteMode $ \h ->
+        readTVarIO tokenLastNtfs >>= mapM_ (saveTokenLastNtfs h) . M.assocs
+      logInfo "notifications saved"
+      where
+        -- reverse on save, to save notifications in order, will become reversed again when restoring.
+        saveTokenLastNtfs h (tknId, v) = BLD.hPutBuilder h . encodeLastNtfs tknId . L.reverse =<< readTVarIO v
+        encodeLastNtfs tknId = mconcat . L.toList . L.map (\ntf -> BLD.byteString (strEncode $ TNMRv1 tknId ntf) <> BLD.char8 '\n')
+
+restoreServerLastNtfs :: M ()
+restoreServerLastNtfs =
+  asks (storeLastNtfsFile . config) >>= mapM_ restoreLastNtfs
+  where
+    restoreLastNtfs f =
+      whenM (doesFileExist f) $ do
+        logInfo $ "restoring last notifications from file " <> T.pack f
+        st <- asks store
+        runExceptT (liftIO (LB.readFile f) >>= mapM (restoreNtf st) . LB.lines) >>= \case
+          Left e -> do
+            logError . T.pack $ "error restoring last notifications: " <> e
+            liftIO exitFailure
+          Right _ -> do
+            renameFile f $ f <> ".bak"
+            logInfo "last notifications restored"
+      where
+        restoreNtf st s' = do
+          TNMRv1 tknId ntf <- liftEither . first (ntfErr "parsing") $ strDecode s
+          liftIO $ storeTokenLastNtf st tknId ntf
+          where
+            s = LB.toStrict s'
+            ntfErr :: Show e => String -> e -> String
+            ntfErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
+
 saveServerStats :: M ()
 saveServerStats =
   asks (serverStatsBackupFile . config)
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 6ac250258..bc89c2e34 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -53,6 +53,7 @@ data NtfServerConfig = NtfServerConfig
     subsBatchSize :: Int,
     inactiveClientExpiration :: Maybe ExpirationConfig,
     storeLogFile :: Maybe FilePath,
+    storeLastNtfsFile :: Maybe FilePath,
     ntfCredentials :: ServerCredentials,
     -- stats config - see SMP server config
     logStatsInterval :: Maybe Int64,
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index 0c5d5e54b..ff2479698 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -85,6 +85,9 @@ ntfServerCLI cfgPath logPath =
           \# and restoring it when the server is started.\n\
           \# Log is compacted on start (deleted objects are removed).\n"
             <> ("enable: " <> onOff enableStoreLog <> "\n\n")
+            <> "# Last notifications are optionally saved and restored when the server restarts,\n\
+               \# they are preserved in the .bak file until the next restart.\n"
+            <> ("restore_last_notifications: " <> onOff enableStoreLog <> "\n\n")
             <> "log_stats: off\n\n\
                \[AUTH]\n\
                \# control_port_admin_password:\n\
@@ -134,6 +137,11 @@ ntfServerCLI cfgPath logPath =
         enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
         logStats = settingIsOn "STORE_LOG" "log_stats" ini
         c = combine cfgPath . ($ defaultX509Config)
+        restoreLastNtfsFile path = case iniOnOff "STORE_LOG" "restore_last_notifications" ini of
+          Just True -> Just path
+          Just False -> Nothing
+          -- if the setting is not set, it is enabled when store log is enabled
+          _ -> enableStoreLog $> path
         serverConfig =
           NtfServerConfig
             { transports = iniTransports ini,
@@ -170,6 +178,7 @@ ntfServerCLI cfgPath logPath =
                       checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
                     },
               storeLogFile = enableStoreLog $> storeLogFilePath,
+              storeLastNtfsFile = restoreLastNtfsFile $ combine logPath "ntf-server-last-notifications.log",
               ntfCredentials =
                 ServerCredentials
                   { caCertificateFile = Just $ c caCrtFile,
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index 00d3c6a81..3b8ae1af1 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -28,16 +28,13 @@ import Data.Aeson (ToJSON, (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.TH as JQ
-import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import Data.Maybe (isNothing)
 import Data.Text (Text)
@@ -51,12 +48,10 @@ import Network.HTTP2.Client (Request)
 import qualified Network.HTTP2.Client as H
 import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
 import Simplex.Messaging.Notifications.Server.Store (NtfTknData (..))
 import Simplex.Messaging.Parsers (defaultJSON)
-import Simplex.Messaging.Protocol (EncNMsgMeta)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import Simplex.Messaging.Transport.HTTP2.Client
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
@@ -112,30 +107,6 @@ data PushNotification
     PNCheckMessages
   deriving (Show)
 
--- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
--- because strEncode of NonEmpty list uses comma for separator,
--- and encoding of PNMessageData's smpQueue has comma in list of hosts
-encodePNMessages :: NonEmpty PNMessageData -> ByteString
-encodePNMessages = B.intercalate ";" . map strEncode . L.toList
-
-pnMessagesP :: A.Parser (NonEmpty PNMessageData)
-pnMessagesP = L.fromList <$> strP `A.sepBy1` A.char ';'
-
-data PNMessageData = PNMessageData
-  { smpQueue :: SMPQueueNtf,
-    ntfTs :: SystemTime,
-    nmsgNonce :: C.CbNonce,
-    encNMsgMeta :: EncNMsgMeta
-  }
-  deriving (Show)
-
-instance StrEncoding PNMessageData where
-  strEncode PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} =
-    strEncode (smpQueue, ntfTs, nmsgNonce, encNMsgMeta)
-  strP = do
-    (smpQueue, ntfTs, nmsgNonce, encNMsgMeta) <- strP
-    pure PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}
-
 data APNSNotification = APNSNotification {aps :: APNSNotificationBody, notificationData :: Maybe J.Value}
   deriving (Show)
 
@@ -221,7 +192,7 @@ defaultAPNSPushClientConfig =
       authKeyFileEnv = "APNS_KEY_FILE", -- the environment variables APNS_KEY_FILE and APNS_KEY_ID must be set, or the server would fail to start
       authKeyAlg = "ES256",
       authKeyIdEnv = "APNS_KEY_ID",
-      paddedNtfLength = 512,
+      paddedNtfLength = 3072,
       appName = "chat.simplex.app",
       appTeamId = "5NN7GUYB6T",
       apnsPort = "443",
diff --git a/src/Simplex/Messaging/Notifications/Server/Store.hs b/src/Simplex/Messaging/Notifications/Server/Store.hs
index b4d91dc88..41f181df6 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Store.hs
@@ -1,9 +1,12 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Messaging.Notifications.Server.Store where
@@ -12,12 +15,14 @@ import Control.Concurrent.STM
 import Control.Monad
 import Data.ByteString.Char8 (ByteString)
 import Data.Functor (($>))
+import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes)
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Word (Word16)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Protocol (NtfPrivateAuthKey, NtfPublicAuthKey, SMPServer)
 import Simplex.Messaging.TMap (TMap)
@@ -30,7 +35,8 @@ data NtfStore = NtfStore
     tokenRegistrations :: TMap DeviceToken (TMap ByteString NtfTokenId),
     subscriptions :: TMap NtfSubscriptionId NtfSubData,
     tokenSubscriptions :: TMap NtfTokenId (TVar (Set NtfSubscriptionId)),
-    subscriptionLookup :: TMap SMPQueueNtf NtfSubscriptionId
+    subscriptionLookup :: TMap SMPQueueNtf NtfSubscriptionId,
+    tokenLastNtfs :: TMap NtfTokenId (TVar (NonEmpty PNMessageData))
   }
 
 newNtfStore :: IO NtfStore
@@ -40,7 +46,8 @@ newNtfStore = do
   subscriptions <- TM.emptyIO
   tokenSubscriptions <- TM.emptyIO
   subscriptionLookup <- TM.emptyIO
-  pure NtfStore {tokens, tokenRegistrations, subscriptions, tokenSubscriptions, subscriptionLookup}
+  tokenLastNtfs <- TM.emptyIO
+  pure NtfStore {tokens, tokenRegistrations, subscriptions, tokenSubscriptions, subscriptionLookup, tokenLastNtfs}
 
 data NtfTknData = NtfTknData
   { ntfTknId :: NtfTokenId,
@@ -111,6 +118,7 @@ removeInactiveTokenRegistrations st NtfTknData {ntfTknId = tId, token} =
       forM_ tIds $ \(regKey, tId') -> do
         TM.delete regKey tknRegs
         TM.delete tId' $ tokens st
+        TM.delete tId' $ tokenLastNtfs st
         void $ deleteTokenSubs st tId'
       pure $ map snd tIds
 
@@ -130,6 +138,7 @@ deleteNtfToken st tknId = do
       TM.lookup token regs $>>= \tIds ->
         TM.delete (regKey tknVerifyKey) tIds
           >> whenM (TM.null tIds) (TM.delete token regs) $> Just ()
+  TM.delete tknId $ tokenLastNtfs st
   deleteTokenSubs st tknId
   where
     regs = tokenRegistrations st
@@ -196,3 +205,42 @@ deleteNtfSubscription st subId = do
           ts_ <- TM.lookup tokenId (tokenSubscriptions st)
           forM_ ts_ $ \ts -> modifyTVar' ts $ S.delete subId
       )
+
+addTokenLastNtf :: NtfStore -> NtfTokenId -> PNMessageData -> IO (NonEmpty PNMessageData)
+addTokenLastNtf st tknId newNtf =
+  TM.lookupIO tknId (tokenLastNtfs st) >>= maybe (atomically maybeNewTokenLastNtfs) (atomically . addNtf)
+  where
+    maybeNewTokenLastNtfs =
+      TM.lookup tknId (tokenLastNtfs st) >>= maybe newTokenLastNtfs addNtf
+    newTokenLastNtfs = do
+      v <- newTVar [newNtf]
+      TM.insert tknId v $ tokenLastNtfs st
+      pure [newNtf]
+    addNtf v =
+      stateTVar v $ \ntfs -> let !ntfs' = rebuildList ntfs in (ntfs', ntfs')
+      where
+        rebuildList :: NonEmpty PNMessageData -> NonEmpty PNMessageData
+        rebuildList = foldr keepPrevNtf [newNtf]
+          where
+            PNMessageData {smpQueue = newNtfQ} = newNtf
+            keepPrevNtf ntf@PNMessageData {smpQueue} ntfs
+              | smpQueue /= newNtfQ && length ntfs < maxNtfs = ntf <| ntfs
+              | otherwise = ntfs
+        maxNtfs = 6
+
+-- This function is expected to be called after store log is read,
+-- as it checks for token existence when adding last notification.
+storeTokenLastNtf :: NtfStore -> NtfTokenId -> PNMessageData -> IO ()
+storeTokenLastNtf (NtfStore {tokens, tokenLastNtfs}) tknId ntf = do
+  TM.lookupIO tknId tokenLastNtfs >>= atomically . maybe newTokenLastNtfs (`modifyTVar'` (ntf <|))
+  where
+    newTokenLastNtfs = TM.lookup tknId tokenLastNtfs >>= maybe insertForExistingToken (`modifyTVar'` (ntf <|))
+    insertForExistingToken =
+      whenM (TM.member tknId tokens) $
+        TM.insertM tknId (newTVar [ntf]) tokenLastNtfs
+
+data TokenNtfMessageRecord = TNMRv1 NtfTokenId PNMessageData
+
+instance StrEncoding TokenNtfMessageRecord where
+  strEncode (TNMRv1 tknId ntf) = strEncode (Str "v1", tknId, ntf)
+  strP = "v1 " *> (TNMRv1 <$> strP_ <*> strP)
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 86a6651f4..d09dabe40 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -1712,7 +1712,7 @@ testOnlyCreatePullSlowHandshake = withAgentClientsCfg2 agentProxyCfgV8 agentProx
 getMsg :: AgentClient -> ConnId -> ExceptT AgentErrorType IO a -> ExceptT AgentErrorType IO a
 getMsg c cId action = do
   liftIO $ noMessages c "nothing should be delivered before GET"
-  Just _ <- getConnectionMessage c cId
+  [Just _] <- lift $ getConnectionMessages c [cId]
   action
 
 getMSGNTF :: AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 272c6d6d6..f5458eba9 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -49,6 +50,7 @@ import Data.Bifunctor (bimap, first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Text.Encoding (encodeUtf8)
 import Database.SQLite.Simple.QQ (sql)
@@ -490,8 +492,11 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
     (nonce, message) <- messageNotification apns tkn
     pure (bobId, aliceId, nonce, message)
 
-  -- alice client already has subscription for the connection
-  Left (CMD PROHIBITED _) <- runExceptT $ getNotificationMessage alice nonce message
+  Right [NotificationInfo {ntfConnId = cId}] <- runExceptT $ getNotificationConns alice nonce message
+  cId `shouldBe` bobId
+  -- alice client already has subscription for the connection,
+  -- so get fails with CMD PROHIBITED (transformed into Nothing in catch)
+  [Nothing] <- getConnectionMessages alice [cId]
 
   threadDelay 500000
   suspendAgent alice 0
@@ -500,8 +505,8 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
   putStrLn "before opening the database from another agent"
 
   -- aliceNtf client doesn't have subscription and is allowed to get notification message
-  withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do
-    (_, Just SMPMsgMeta {msgFlags = MsgFlags True}) <- getNotificationMessage aliceNtf nonce message
+  withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> do
+    (Just SMPMsgMeta {msgFlags = MsgFlags True}) :| _ <- getConnectionMessages aliceNtf [cId]
     pure ()
 
   threadDelay 1000000
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index 05055fe45..e8c263e89 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -75,6 +75,9 @@ testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
 ntfTestStoreLogFile :: FilePath
 ntfTestStoreLogFile = "tests/tmp/ntf-server-store.log"
 
+ntfTestStoreLastNtfsFile :: FilePath
+ntfTestStoreLastNtfsFile = "tests/tmp/ntf-server-last-notifications.log"
+
 testNtfClient :: Transport c => (THandleNTF c 'TClient -> IO a) -> IO a
 testNtfClient client = do
   Right host <- pure $ chooseTransportHost defaultNetworkConfig testHost
@@ -104,6 +107,7 @@ ntfServerCfg =
       subsBatchSize = 900,
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
       storeLogFile = Nothing,
+      storeLastNtfsFile = Nothing,
       ntfCredentials =
         ServerCredentials
           { caCertificateFile = Just "tests/fixtures/ca.crt",
@@ -131,7 +135,7 @@ ntfServerCfgVPrev =
     serverVRange' = serverVRange smpCfg'
 
 withNtfServerStoreLog :: ATransport -> (ThreadId -> IO a) -> IO a
-withNtfServerStoreLog t = withNtfServerCfg ntfServerCfg {storeLogFile = Just ntfTestStoreLogFile, transports = [(ntfTestPort, t, False)]}
+withNtfServerStoreLog t = withNtfServerCfg ntfServerCfg {storeLogFile = Just ntfTestStoreLogFile, storeLastNtfsFile = Just ntfTestStoreLastNtfsFile, transports = [(ntfTestPort, t, False)]}
 
 withNtfServerThreadOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withNtfServerThreadOn t port' = withNtfServerCfg ntfServerCfg {transports = [(port', t, False)]}
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index b9560976d..628df0ecc 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -38,7 +38,6 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push.APNS
-import qualified Simplex.Messaging.Notifications.Server.Push.APNS as APNS
 import Simplex.Messaging.Notifications.Transport (THandleNTF)
 import Simplex.Messaging.Parsers (parse, parseAll)
 import Simplex.Messaging.Protocol hiding (notification)
@@ -136,7 +135,7 @@ testNotificationSubscription (ATransport t) =
               Right message = ntfData' .-> "message"
               Right ntfDataDecrypted = C.cbDecrypt dhSecret nonce' message
               Right pnMsgs1 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted
-              APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer, notifierId}, nmsgNonce, encNMsgMeta} = L.last pnMsgs1
+              PNMessageData {smpQueue = SMPQueueNtf {smpServer, notifierId}, nmsgNonce, encNMsgMeta} = L.last pnMsgs1
               Right nMsgMeta = C.cbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta
               Right NMsgMeta {msgId, msgTs} = parse smpP (AP.INTERNAL "error parsing NMsgMeta") nMsgMeta
           smpServer `shouldBe` srv
@@ -167,6 +166,6 @@ testNotificationSubscription (ATransport t) =
               Right message3 = ntfData3 .-> "message"
               Right ntfDataDecrypted3 = C.cbDecrypt dhSecret nonce3 message3
               Right pnMsgs2 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted3
-              APNS.PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} = L.last pnMsgs2
+              PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} = L.last pnMsgs2
           smpServer3 `shouldBe` srv
           notifierId3 `shouldBe` nId

From 870a60fc5dc0826784038fc1c23683aac24484a3 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 25 Oct 2024 15:39:59 +0100
Subject: [PATCH 173/195] smp server: reduce memory usage when starting, all
 servers: prevent losing state on termination while compacting state (#1385)

* smp server: reduce memory usage when starting

* servers: prevent losing state when compacting is incomplete (terminated abnormally)

* fix test

* fix/refactor

* message

* remove .bak

* simpler
---
 src/Simplex/FileTransfer/Server/StoreLog.hs   | 11 +--
 .../Notifications/Server/StoreLog.hs          | 11 +--
 src/Simplex/Messaging/Server/Env/STM.hs       | 19 +---
 .../Messaging/Server/QueueStore/STM.hs        |  3 +-
 src/Simplex/Messaging/Server/StoreLog.hs      | 99 +++++++++++++------
 tests/CoreTests/StoreLogTests.hs              |  8 +-
 6 files changed, 81 insertions(+), 70 deletions(-)

diff --git a/src/Simplex/FileTransfer/Server/StoreLog.hs b/src/Simplex/FileTransfer/Server/StoreLog.hs
index 675e4efdb..4c485c170 100644
--- a/src/Simplex/FileTransfer/Server/StoreLog.hs
+++ b/src/Simplex/FileTransfer/Server/StoreLog.hs
@@ -34,8 +34,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId)
 import Simplex.Messaging.Server.QueueStore (RoundedSystemTime)
 import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.Util (bshow, whenM)
-import System.Directory (doesFileExist, renameFile)
+import Simplex.Messaging.Util (bshow)
 import System.IO
 
 data FileStoreLogRecord
@@ -81,13 +80,7 @@ logAckFile :: StoreLog 'WriteMode -> RecipientId -> IO ()
 logAckFile s = logFileStoreRecord s . AckFile
 
 readWriteFileStore :: FilePath -> FileStore -> IO (StoreLog 'WriteMode)
-readWriteFileStore f st = do
-  whenM (doesFileExist f) $ do
-    readFileStore f st
-    renameFile f $ f <> ".bak"
-  s <- openWriteStoreLog f
-  writeFileStore s st
-  pure s
+readWriteFileStore = readWriteStoreLog readFileStore writeFileStore
 
 readFileStore :: FilePath -> FileStore -> IO ()
 readFileStore f st = mapM_ (addFileLogRecord . LB.toStrict) . LB.lines =<< LB.readFile f
diff --git a/src/Simplex/Messaging/Notifications/Server/StoreLog.hs b/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
index d11c01f76..a0dbb1fee 100644
--- a/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
@@ -37,8 +37,7 @@ import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Protocol (NtfPrivateAuthKey)
 import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.Util (safeDecodeUtf8, whenM)
-import System.Directory (doesFileExist, renameFile)
+import Simplex.Messaging.Util (safeDecodeUtf8)
 import System.IO
 
 data NtfStoreLogRecord
@@ -186,13 +185,7 @@ logDeleteSubscription :: StoreLog 'WriteMode -> NtfSubscriptionId -> IO ()
 logDeleteSubscription s subId = logNtfStoreRecord s $ DeleteSubscription subId
 
 readWriteNtfStore :: FilePath -> NtfStore -> IO (StoreLog 'WriteMode)
-readWriteNtfStore f st = do
-  whenM (doesFileExist f) $ do
-    readNtfStore f st
-    renameFile f $ f <> ".bak"
-  s <- openWriteStoreLog f
-  writeNtfStore s st
-  pure s
+readWriteNtfStore = readWriteStoreLog readNtfStore writeNtfStore
 
 readNtfStore :: FilePath -> NtfStore -> IO ()
 readNtfStore f st = mapM_ (addNtfLogRecord . LB.toStrict) . LB.lines =<< LB.readFile f
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index debd36c12..4bd6f6e6c 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -19,8 +19,6 @@ import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IM
 import Data.List (intercalate)
 import Data.List.NonEmpty (NonEmpty)
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
 import Data.Maybe (isJust, isNothing)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
@@ -39,7 +37,7 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.NtfStore
-import Simplex.Messaging.Server.QueueStore (NtfCreds (..), QueueRec (..))
+import Simplex.Messaging.Server.QueueStore (QueueRec (..))
 import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.Server.StoreLog
@@ -253,7 +251,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAg
   storeLog <-
     forM storeLogFile $ \f -> do
       logInfo $ "restoring queues from file " <> T.pack f
-      restoreQueues queueStore f
+      readWriteQueueStore f queueStore
   tlsServerCreds <- getCredentials "SMP" smpCredentials
   httpServerCreds <- mapM (getCredentials "HTTPS") httpCredentials
   mapM_ checkHTTPSCredentials httpServerCreds
@@ -286,19 +284,6 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, smpAg
           putStrLn $ "Error: unsupported HTTPS credentials, required 4096-bit RSA\n" <> letsEncrypt
           exitFailure
     letsEncrypt = "Use Let's Encrypt to generate: certbot certonly --standalone -d yourdomainname --key-type rsa --rsa-key-size 4096"
-    restoreQueues :: QueueStore -> FilePath -> IO (StoreLog 'WriteMode)
-    restoreQueues QueueStore {queues, senders, notifiers} f = do
-      (qs, s) <- readWriteStoreLog f
-      atomically . writeTVar queues =<< mapM newTVarIO qs
-      atomically $ writeTVar senders $! M.foldr' addSender M.empty qs
-      atomically $ writeTVar notifiers $! M.foldr' addNotifier M.empty qs
-      pure s
-    addSender :: QueueRec -> Map SenderId RecipientId -> Map SenderId RecipientId
-    addSender q = M.insert (senderId q) (recipientId q)
-    addNotifier :: QueueRec -> Map NotifierId RecipientId -> Map NotifierId RecipientId
-    addNotifier q = case notifier q of
-      Nothing -> id
-      Just NtfCreds {notifierId} -> M.insert notifierId (recipientId q)
     serverInfo =
       ServerInformation
         { information,
diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index 5efff9cfd..6f0fd80b5 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -49,8 +49,7 @@ newQueueStore = do
 addQueue :: QueueStore -> QueueRec -> IO (Either ErrorType ())
 addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId = sId} = atomically $ do
   ifM hasId (pure $ Left DUPLICATE_) $ do
-    qVar <- newTVar q
-    TM.insert rId qVar queues
+    TM.insertM rId (newTVar q) queues
     TM.insert sId rId senders
     pure $ Right ()
   where
diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs
index e28434f69..a6ac14cb0 100644
--- a/src/Simplex/Messaging/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Server/StoreLog.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
@@ -22,23 +23,27 @@ module Simplex.Messaging.Server.StoreLog
     logDeleteQueue,
     logDeleteNotifier,
     logUpdateQueueTime,
+    readWriteQueueStore,
     readWriteStoreLog,
   )
 where
 
 import Control.Applicative (optional, (<|>))
-import Control.Monad (foldM, unless, when)
+import Control.Concurrent.STM
+import Control.Logger.Simple
+import Control.Monad
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Functor (($>))
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
+import qualified Data.ByteString.Base64.URL as B64
+import qualified Data.Text as T
+import Data.Time.Clock (getCurrentTime)
+import Data.Time.Format.ISO8601 (iso8601Show)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
-import Simplex.Messaging.Transport.Buffer (trimCR)
-import Simplex.Messaging.Util (ifM)
+import Simplex.Messaging.Server.QueueStore.STM
+import Simplex.Messaging.Util (bshow, ifM, unlessM, whenM)
 import System.Directory (doesFileExist, renameFile)
 import System.IO
 
@@ -144,7 +149,7 @@ openWriteStoreLog f = do
 
 openReadStoreLog :: FilePath -> IO (StoreLog 'ReadMode)
 openReadStoreLog f = do
-  doesFileExist f >>= (`unless` writeFile f "")
+  unlessM (doesFileExist f) (writeFile f "")
   ReadStoreLog f <$> openFile f ReadMode
 
 storeLogFilePath :: StoreLog a -> FilePath
@@ -183,37 +188,69 @@ logDeleteNotifier s = writeStoreLogRecord s . DeleteNotifier
 logUpdateQueueTime :: StoreLog 'WriteMode -> QueueId -> RoundedSystemTime -> IO ()
 logUpdateQueueTime s qId t = writeStoreLogRecord s $ UpdateTime qId t
 
-readWriteStoreLog :: FilePath -> IO (Map RecipientId QueueRec, StoreLog 'WriteMode)
-readWriteStoreLog f = do
-  qs <- ifM (doesFileExist f) readQS (pure M.empty)
-  s <- openWriteStoreLog f
-  writeQueues s qs
-  pure (qs, s)
-  where
-    readQS = readQueues f <* renameFile f (f <> ".bak")
+readWriteQueueStore :: FilePath -> QueueStore -> IO (StoreLog 'WriteMode)
+readWriteQueueStore = readWriteStoreLog readQueues writeQueues
 
-writeQueues :: StoreLog 'WriteMode -> Map RecipientId QueueRec -> IO ()
-writeQueues s = mapM_ $ \q -> when (active q) $ logCreateQueue s q
+readWriteStoreLog :: (FilePath -> s -> IO ()) -> (StoreLog 'WriteMode -> s -> IO ()) -> FilePath -> s -> IO (StoreLog 'WriteMode)
+readWriteStoreLog readStore writeStore f st =
+  ifM
+    (doesFileExist tempBackup)
+    (useTempBackup >> readWriteLog)
+    (ifM (doesFileExist f) readWriteLog (writeLog "creating store log..."))
   where
+    f' = T.pack f
+    tempBackup = f <> ".start"
+    useTempBackup = do
+      -- preserve current file, use temp backup
+      logWarn $ "Server terminated abnormally on last start, restoring state from " <> T.pack tempBackup
+      whenM (doesFileExist f) $ do
+        renameFile f (f <> ".bak")
+        logInfo $ "preserved incomplete state " <> f' <> " as " <> (f' <> ".bak")
+      renameFile tempBackup f
+    readWriteLog = do
+      -- log backup is made in two steps to mitigate the crash during the compacting.
+      -- Temporary backup file .start will be used when it is present.
+      readStore f st
+      renameFile f tempBackup -- 1) make temp backup
+      s <- writeLog "compacting store log (do not terminate)..." -- 2) save state
+      renameBackup -- 3) timed backup
+      pure s
+    writeLog msg = do
+      s <- openWriteStoreLog f
+      logInfo msg
+      writeStore s st
+      pure s
+    renameBackup = do
+      ts <- getCurrentTime
+      let timedBackup = f <> "." <> iso8601Show ts
+      renameFile tempBackup timedBackup
+      logInfo $ "original state preserved as " <> T.pack timedBackup
+
+writeQueues :: StoreLog 'WriteMode -> QueueStore -> IO ()
+writeQueues s st = readTVarIO (queues st) >>= mapM_ writeQueue
+  where
+    writeQueue v = readTVarIO v >>= \q -> when (active q) $ logCreateQueue s q
     active QueueRec {status} = status == QueueActive
 
-readQueues :: FilePath -> IO (Map RecipientId QueueRec)
-readQueues f = foldM processLine M.empty . LB.lines =<< LB.readFile f
+readQueues :: FilePath -> QueueStore -> IO ()
+readQueues f st = withFile f ReadMode $ LB.hGetContents >=> mapM_ processLine . LB.lines
   where
-    processLine :: Map RecipientId QueueRec -> LB.ByteString -> IO (Map RecipientId QueueRec)
-    processLine m s' = case strDecode $ trimCR s of
-      Right r -> pure $ procLogRecord r
-      Left e -> printError e $> m
+    processLine :: LB.ByteString -> IO ()
+    processLine s' = either printError procLogRecord (strDecode s)
       where
         s = LB.toStrict s'
-        procLogRecord :: StoreLogRecord -> Map RecipientId QueueRec
+        procLogRecord :: StoreLogRecord -> IO ()
         procLogRecord = \case
-          CreateQueue q -> M.insert (recipientId q) q m
-          SecureQueue qId sKey -> M.adjust (\q -> q {senderKey = Just sKey}) qId m
-          AddNotifier qId ntfCreds -> M.adjust (\q -> q {notifier = Just ntfCreds}) qId m
-          SuspendQueue qId -> M.adjust (\q -> q {status = QueueOff}) qId m
-          DeleteQueue qId -> M.delete qId m
-          DeleteNotifier qId -> M.adjust (\q -> q {notifier = Nothing}) qId m
-          UpdateTime qId t -> M.adjust (\q -> q {updatedAt = Just t}) qId m
+          CreateQueue q -> addQueue st q >>= qError (recipientId q)
+          SecureQueue qId sKey -> secureQueue st qId sKey >>= qError qId
+          AddNotifier qId ntfCreds -> addQueueNotifier st qId ntfCreds >>= qError qId
+          SuspendQueue qId -> suspendQueue st qId >>= qError qId
+          DeleteQueue qId -> deleteQueue st qId >>= qError qId
+          DeleteNotifier qId -> deleteQueueNotifier st qId >>= qError qId
+          UpdateTime qId t -> updateQueueTime st qId t
         printError :: String -> IO ()
         printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s
+        qError :: RecipientId -> Either ErrorType a -> IO ()
+        qError (EntityId qId) = \case
+          Left e -> B.putStrLn $ "stored queue " <> B64.encode qId <> " error: " <> bshow e
+          Right _ -> pure ()
diff --git a/tests/CoreTests/StoreLogTests.hs b/tests/CoreTests/StoreLogTests.hs
index d2462a09e..7ee5767fd 100644
--- a/tests/CoreTests/StoreLogTests.hs
+++ b/tests/CoreTests/StoreLogTests.hs
@@ -21,6 +21,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.Server.QueueStore
+import Simplex.Messaging.Server.QueueStore.STM (QueueStore (..), newQueueStore)
 import Test.Hspec
 
 testNewQueueRec :: TVar ChaChaDRG -> Bool -> IO QueueRec
@@ -116,8 +117,11 @@ testSMPStoreLog testSuite tests =
     replicateM_ 3 $ testReadWrite t
   where
     testReadWrite SLTC {compacted, state} = do
-      (state', l) <- readWriteStoreLog testStoreLogFile
-      state' `shouldBe` state
+      st <- newQueueStore
+      l <- readWriteQueueStore testStoreLogFile st
+      storeState st `shouldReturn` state
       closeStoreLog l
       ([], compacted') <- partitionEithers . map strDecode . B.lines <$> B.readFile testStoreLogFile
       compacted' `shouldBe` compacted
+    storeState :: QueueStore -> IO (M.Map RecipientId QueueRec)
+    storeState st = readTVarIO (queues st) >>= mapM readTVarIO

From a7f5297ad18dcee17bbec8cb2b3ec18db1060fe0 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Fri, 25 Oct 2024 15:41:30 +0100
Subject: [PATCH 174/195] 6.1.2.0

---
 CHANGELOG.md    | 10 ++++++++++
 package.yaml    |  2 +-
 simplexmq.cabal |  2 +-
 3 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 820374afc..caf28478e 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,13 @@
+# 6.1.2
+
+Servers: more reliable restoring of state.
+
+SMP server: reduced memory usage and faster start.
+
+Notifications: compensate for iOS notifications being droppted by Apple while device is offline (#1378):
+- Ntf server: send multiple SMP notifications in one iOS notification.
+- Agent: get multiple messages for one iOS notification.
+
 # 6.1.1
 
 SMP:
diff --git a/package.yaml b/package.yaml
index e679be893..491c103f4 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.1.1.0
+version: 6.1.2.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 78555eabc..386f7ffa2 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.1.1.0
+version:        6.1.2.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 386034158496248ea377cb2fdcf3bc125150a576 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 25 Oct 2024 18:42:13 +0100
Subject: [PATCH 175/195] rfc: iOS notifications 2 (#1334)

---
 rfcs/2024-09-25-ios-notifications-2.md | 49 ++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 rfcs/2024-09-25-ios-notifications-2.md

diff --git a/rfcs/2024-09-25-ios-notifications-2.md b/rfcs/2024-09-25-ios-notifications-2.md
new file mode 100644
index 000000000..79416b83f
--- /dev/null
+++ b/rfcs/2024-09-25-ios-notifications-2.md
@@ -0,0 +1,49 @@
+# iOS notifications delivery
+
+## Problem
+
+For iOS notifications to be delivered the client has to create credentials for notification subscription on SMP server using NKEY command and after that create a subscription on notification server using SNEW command. These two commands are sent in sequence, after the connections are created, and for it to happen the client needs to be online and in foreground.
+
+iOS users tend to close the app when it is not used, and iOS has very limited permissions for background activities, so these notification subscriptions are created with a substantial delay, and notifications do not work.
+
+This problem is distinct from and probably more common than other problems affecting notifications delivery described [here](./2024-07-06-ios-notifications.md).
+
+## Solution
+
+1. When the new connection is created, the client already knows if it needs to create notification subscription or not, based on the conversation setting (e.g., if the group is muted, the client will not create notification subscription as well.). We should extend NEW command to avoid the need to send additional NKEY command with an option to create notification subscription at the point where connection is created. NDEL would still be used to disable this notification, and NKEY will be used to re-enable it.
+
+2. In the same way we stopped using SDEL command (NDEL sends notification DELD to subscribed notification server) to delete notificaiton subscriptions from notification server, we should delegate creating notification subscription on notification server to SMP servers. Clients could use keys agreed with ntf server for e2e encryption and for command authorization to encrypt and sign instruction to create notification subscription that will be forwarded to notification server using protocol similar to SMP proxies. This will avoid the need for clients to separately contact notification servers that won't happen until they are online.
+
+3. Instead of making Ntf server trust DELD notifications, we could send deletion instructions signed by the client, which will only fail to send in case notification server is down (and they won't be sent later after server restart).
+
+Cons:
+- If SMP servers were to retain in the storage the information about which notification server is used for which queue, it would reduce metadata privacy. While currently it is not an issue, as all notification servers are known and operated by us, once there are other client apps, this can be used for app users fingerprinting, which would act as a deterrence from using new apps – but only if app users use servers of operators who are different from the app provider. To mitigate it, we could only store it in server memory and include notification instruction in subscription commands (SUB) and include notification subscription status in SUB responses. We don't need to mitigate the problem of server being able to store this information, as messaging servers can observe which notification servers connect to them anyway.
+- If SMP server is restarted before the subscription request is forwared to the notification server, then it will have to be forwarded again, once the client subscribes. The problem here is that if the client is offline, it will neither subscribe to the queue to send notification subscription request, nor receive notifications from this queue. Storing notification server and subscription request would mitigate that, as in this case we could send all pending requests on server start, without depending on client subscriptions.
+- "Small" agent will need to support connections to ntf servers and manage workers that retry sending pending subscription requests.
+- Until the client learns the public keys of notification server, it will not be able to decrypt notifications. It potentially can be mitigated by using the public key of the server returned when token is created, in this way different client keys (per-queue) will be combined with the same ntf server key (per-token).
+
+## Implementation details
+
+1. NEW and NKEY commands will need to be extended to include notification subscription request. As the notifier ID needs to be sent to notification server, this notifier ID will have to be client-generated and supplied as part of NEW command.
+
+now:
+
+```haskell
+NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> SenderCanSecure -> Command Recipient
+NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> Command Recipient
+```
+
+extended:
+
+```haskell
+NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> SenderCanSecure -> Maybe NtfRequest -> Command Recipient
+
+data NtfRequest = NtfRequest NotifierId NtfPublicAuthKey RcvNtfPublicDhKey NtfServerRequest
+
+data NtfServerRequest = NtfServerRequest NtfServer EncSingedNtfCmd
+
+NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> Maybe NtfServerRequest -> Command Recipient
+-- NotifierID is passed in entity ID field of the transmission
+```
+
+2. Notification server will need to support an additional command to receive "proxied" subscription commands, `SFWD`, that would include `NtfServerRequest`. This command can include both `SNEW` and `SDEL` commands.

From 8b9eb49b57696a059cfb5523e7555bfc5f13f514 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 26 Oct 2024 08:11:07 +0100
Subject: [PATCH 176/195] smp server: log operation of restore error (#1389)

* smp server: log operation of restore error

* space

* rename

* revert version
---
 src/Simplex/Messaging/Server/StoreLog.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs
index a6ac14cb0..2e272260a 100644
--- a/src/Simplex/Messaging/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Server/StoreLog.hs
@@ -241,16 +241,16 @@ readQueues f st = withFile f ReadMode $ LB.hGetContents >=> mapM_ processLine .
         s = LB.toStrict s'
         procLogRecord :: StoreLogRecord -> IO ()
         procLogRecord = \case
-          CreateQueue q -> addQueue st q >>= qError (recipientId q)
-          SecureQueue qId sKey -> secureQueue st qId sKey >>= qError qId
-          AddNotifier qId ntfCreds -> addQueueNotifier st qId ntfCreds >>= qError qId
-          SuspendQueue qId -> suspendQueue st qId >>= qError qId
-          DeleteQueue qId -> deleteQueue st qId >>= qError qId
-          DeleteNotifier qId -> deleteQueueNotifier st qId >>= qError qId
+          CreateQueue q -> addQueue st q >>= qError "create" (recipientId q)
+          SecureQueue qId sKey -> secureQueue st qId sKey >>= qError "secure" qId
+          AddNotifier qId ntfCreds -> addQueueNotifier st qId ntfCreds >>= qError "addNotifier" qId
+          SuspendQueue qId -> suspendQueue st qId >>= qError "suspend" qId
+          DeleteQueue qId -> deleteQueue st qId >>= qError "delete" qId
+          DeleteNotifier qId -> deleteQueueNotifier st qId >>= qError "deleteNotifier" qId
           UpdateTime qId t -> updateQueueTime st qId t
         printError :: String -> IO ()
         printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s
-        qError :: RecipientId -> Either ErrorType a -> IO ()
-        qError (EntityId qId) = \case
-          Left e -> B.putStrLn $ "stored queue " <> B64.encode qId <> " error: " <> bshow e
+        qError :: B.ByteString -> RecipientId -> Either ErrorType a -> IO ()
+        qError op (EntityId qId) = \case
+          Left e -> B.putStrLn $ op <> " stored queue " <> B64.encode qId <> " error: " <> bshow e
           Right _ -> pure ()

From 56ca7bf30e813648d13cea6f3d13336bb9af25ad Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 26 Oct 2024 10:33:18 +0100
Subject: [PATCH 177/195] smp server: do not log progress when server starts
 (#1390)

* smp server: do not log progress when server starts

* test
---
 src/Simplex/Messaging/Server.hs               | 26 +++++++++----------
 src/Simplex/Messaging/Server/Main.hs          |  4 +--
 .../Messaging/Server/MsgStore/Journal.hs      | 13 ++++------
 src/Simplex/Messaging/Server/MsgStore/STM.hs  |  2 +-
 .../Messaging/Server/MsgStore/Types.hs        |  2 +-
 tests/CoreTests/MsgStoreTests.hs              | 12 ++++-----
 tests/ServerTests.hs                          |  2 +-
 7 files changed, 28 insertions(+), 33 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 81c995bb2..38d718fd2 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -1739,17 +1739,17 @@ saveServerMessages :: Bool -> M ()
 saveServerMessages drainMsgs =
   asks msgStore >>= \case
     AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-      Just f -> liftIO $ exportMessages ms f drainMsgs
+      Just f -> liftIO $ exportMessages False ms f drainMsgs
       Nothing -> logInfo "undelivered messages are not saved"
     AMS SMSJournal ms -> do
       liftIO $ closeMsgStore ms
       logInfo "closed journal message storage"
 
-exportMessages :: MsgStoreClass s => s -> FilePath -> Bool -> IO ()
-exportMessages ms f drainMsgs = do
+exportMessages :: MsgStoreClass s => Bool -> s -> FilePath -> Bool -> IO ()
+exportMessages tty ms f drainMsgs = do
   logInfo $ "saving messages to file " <> T.pack f
   liftIO $ withFile f WriteMode $ \h ->
-    tryAny (withAllMsgQueues ms $ saveQueueMsgs h) >>= \case
+    tryAny (withAllMsgQueues tty ms $ saveQueueMsgs h) >>= \case
       Right (Sum total) -> logInfo $ "messages saved: " <> tshow total
       Left e -> do
         logError $ "error exporting messages: " <> tshow e
@@ -1766,15 +1766,15 @@ processServerMessages = do
       processMessages :: Maybe Int64 -> AMsgStore -> IO MessageStats
       processMessages old_ = \case
         AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-          Just f -> ifM (doesFileExist f) (importMessages ms f old_) (pure newMessageStats)
+          Just f -> ifM (doesFileExist f) (importMessages False ms f old_) (pure newMessageStats)
           Nothing -> pure newMessageStats
         AMS SMSJournal ms -> case old_ of
           Just old -> do
             logInfo "expiring journal store messages..."
-            withAllMsgQueues ms $ \_ -> processExpireQueue old
+            withAllMsgQueues False ms $ \_ -> processExpireQueue old
           Nothing -> do
             logInfo "validating journal store messages..."
-            withAllMsgQueues ms $ \_ -> processValidateQueue
+            withAllMsgQueues False ms $ \_ -> processValidateQueue
         where
           processExpireQueue old q =
             runExceptT expireQueue >>= \case
@@ -1793,8 +1793,8 @@ processServerMessages = do
           processValidateQueue q =
             getQueueSize q >>= \storedMsgsCount -> pure mempty {storedMsgsCount, storedQueues = 1}
 
-importMessages :: forall s. MsgStoreClass s => s -> FilePath -> Maybe Int64 -> IO MessageStats
-importMessages ms f old_ = do
+importMessages :: forall s. MsgStoreClass s => Bool -> s -> FilePath -> Maybe Int64 -> IO MessageStats
+importMessages tty ms f old_ = do
   logInfo $ "restoring messages from file " <> T.pack f
   LB.readFile f >>= runExceptT . foldM restoreMsg (0, Nothing, (0, 0, M.empty)) . zip [0..] . LB.lines >>= \case
     Left e -> do
@@ -1802,19 +1802,17 @@ importMessages ms f old_ = do
       logError . T.pack $ "error restoring messages: " <> e
       liftIO exitFailure
     Right (lineCount, _, (storedMsgsCount, expiredMsgsCount, overQuota)) -> do
-      putStrLn $ "Processed " <> show lineCount <> " lines"
+      putStrLn $ progress lineCount
       renameFile f $ f <> ".bak"
       mapM_ setOverQuota_ overQuota
       logQueueStates ms
       storedQueues <- M.size <$> readTVarIO (activeMsgQueues ms)
       pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues}
   where
-    progress i = do
-      liftIO $ putStr $ "Processed " <> show i <> " lines\r"
-      hFlush stdout
+    progress i = "Processed " <> show i <> " lines"
     restoreMsg :: (Int, Maybe (RecipientId, MsgQueue s), (Int, Int, M.Map RecipientId (MsgQueue s))) -> (Int, LB.ByteString) -> ExceptT String IO (Int, Maybe (RecipientId, MsgQueue s), (Int, Int, M.Map RecipientId (MsgQueue s)))
     restoreMsg (!lineCount, q_, (!stored, !expired, !overQuota)) (i, s') = do
-      when (i `mod` 1000 == 0) $ progress i
+      when (tty && i `mod` 1000 == 0) $ liftIO $ putStr (progress i <> "\r")
       MLRv3 rId msg <- liftEither . first (msgErr "parsing") $ strDecode s
       liftError show $ addToMsgQueue rId msg
       where
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index f728e6be8..d3eab5f33 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -99,7 +99,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 ("WARNING: message log file " <> storeMsgsFilePath <> " will be imported to journal directory " <> storeMsgsJournalDir)
                 "Messages not imported"
               ms <- newJournalMsgStore
-              msgStats <- importMessages ms storeMsgsFilePath Nothing -- no expiration
+              msgStats <- importMessages True ms storeMsgsFilePath Nothing -- no expiration
               putStrLn "Import completed"
               printMessageStats "Messages" msgStats
               putStrLn $ case readMsgStoreType ini of
@@ -116,7 +116,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 ("WARNING: journal directory " <> storeMsgsJournalDir <> " will be exported to message log file " <> storeMsgsFilePath)
                 "Journal not exported"
               ms <- newJournalMsgStore
-              exportMessages ms storeMsgsFilePath False
+              exportMessages True ms storeMsgsFilePath False
               putStrLn "Export completed"
               putStrLn $ case readMsgStoreType ini of
                 Right (AMSType SMSMemory) -> "store_messages set to `memory`"
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index f98b5222a..5324c9997 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -216,20 +216,19 @@ instance MsgStoreClass JournalMsgStore where
   -- It is used to export storage to a single file and also to expire messages and validate all queues when server is started.
   -- TODO this function requires case-sensitive file system, because it uses queue directory as recipient ID.
   -- It can be made to support case-insensite FS by supporting more than one queue per directory, by getting recipient ID from state file name.
-  withAllMsgQueues :: forall a. Monoid a => JournalMsgStore -> (RecipientId -> JournalMsgQueue -> IO a) -> IO a
-  withAllMsgQueues ms@JournalMsgStore {config} action = ifM (doesDirectoryExist storePath) processStore (pure mempty)
+  withAllMsgQueues :: forall a. Monoid a => Bool -> JournalMsgStore -> (RecipientId -> JournalMsgQueue -> IO a) -> IO a
+  withAllMsgQueues tty ms@JournalMsgStore {config} action = ifM (doesDirectoryExist storePath) processStore (pure mempty)
     where
       processStore = do
         closeMsgStore ms
         lock <- createLockIO -- the same lock is used for all queues
         (!count, !res) <- foldQueues 0 (processQueue lock) (0, mempty) ("", storePath)
-        progress count
-        putStrLn ""
+        putStrLn $ progress count
         pure res
       JournalStoreConfig {storePath, pathParts} = config
       processQueue :: Lock -> (Int, a) -> (String, FilePath) -> IO (Int, a)
       processQueue queueLock (!i, !r) (queueId, dir) = do
-        when (i `mod` 100 == 0) $ progress i
+        when (tty && i `mod` 100 == 0) $ putStr (progress i <> "\r") >> IO.hFlush stdout
         let statePath = msgQueueStatePath dir queueId
         q <- openMsgQueue ms JMQueue {queueDirectory = dir, queueLock, statePath}
         r' <- case strDecode $ B.pack queueId of
@@ -239,9 +238,7 @@ instance MsgStoreClass JournalMsgStore where
             exitFailure
         closeMsgQueue q
         pure (i + 1, r <> r')
-      progress i = do
-        putStr $ "Processed: " <> show i <> " queues\r"
-        IO.hFlush stdout
+      progress i = "Processed: " <> show i <> " queues"
       foldQueues depth f acc (queueId, path) = do
         let f' = if depth == pathParts - 1 then f else foldQueues (depth + 1) f
         listDirs >>= foldM f' acc
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index f70a1e71d..1b27b6a10 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -57,7 +57,7 @@ instance MsgStoreClass STMMsgStore where
   activeMsgQueues = msgQueues
   {-# INLINE activeMsgQueues #-}
 
-  withAllMsgQueues = withActiveMsgQueues
+  withAllMsgQueues _ = withActiveMsgQueues
   {-# INLINE withAllMsgQueues #-}
 
   logQueueStates _ = pure ()
diff --git a/src/Simplex/Messaging/Server/MsgStore/Types.hs b/src/Simplex/Messaging/Server/MsgStore/Types.hs
index 718aa95ca..0486804f3 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Types.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Types.hs
@@ -26,7 +26,7 @@ class Monad (StoreMonad s) => MsgStoreClass s where
   newMsgStore :: MsgStoreConfig s -> IO s
   closeMsgStore :: s -> IO ()
   activeMsgQueues :: s -> TMap RecipientId (MsgQueue s)
-  withAllMsgQueues :: Monoid a => s -> (RecipientId -> MsgQueue s -> IO a) -> IO a
+  withAllMsgQueues :: Monoid a => Bool -> s -> (RecipientId -> MsgQueue s -> IO a) -> IO a
   logQueueStates :: s -> IO ()
   logQueueState :: MsgQueue s -> IO ()
   getMsgQueue :: s -> RecipientId -> ExceptT ErrorType IO (MsgQueue s)
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index fc00317a0..4a5d95eb2 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -164,24 +164,24 @@ testExportImportStore ms = do
     pure ()
   length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
   length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 3
-  exportMessages ms testStoreMsgsFile False
+  exportMessages False ms testStoreMsgsFile False
   renameFile testStoreMsgsFile (testStoreMsgsFile <> ".copy")
   closeMsgStore ms
-  exportMessages ms testStoreMsgsFile False
+  exportMessages False ms testStoreMsgsFile False
   (B.readFile testStoreMsgsFile `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".copy")
   let cfg = (testJournalStoreCfg :: JournalStoreConfig) {storePath = testStoreMsgsDir2}
   ms' <- newMsgStore cfg
   stats@MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
-    importMessages ms' testStoreMsgsFile Nothing
+    importMessages False ms' testStoreMsgsFile Nothing
   printMessageStats "Messages" stats
   length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
   length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 4 -- state file is backed up, 2 message files
-  exportMessages ms' testStoreMsgsFile2 False
+  exportMessages False ms' testStoreMsgsFile2 False
   (B.readFile testStoreMsgsFile2 `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".bak")
   stmStore <- newMsgStore testSMTStoreConfig
   MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
-    importMessages stmStore testStoreMsgsFile2 Nothing
-  exportMessages stmStore testStoreMsgsFile False
+    importMessages False stmStore testStoreMsgsFile2 Nothing
+  exportMessages False stmStore testStoreMsgsFile False
   (B.sort <$> B.readFile testStoreMsgsFile `shouldReturn`) =<< (B.sort <$> B.readFile (testStoreMsgsFile2 <> ".bak"))
 
 testQueueState :: JournalMsgStore -> IO ()
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index c133d94fc..e80d39897 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -813,7 +813,7 @@ testRestoreExpireMessages =
       AMSType SMSJournal -> do
         ms <- newMsgStore testJournalStoreCfg {quota = 4}
         removeFileIfExists testStoreMsgsFile
-        exportMessages ms testStoreMsgsFile False
+        exportMessages False ms testStoreMsgsFile False
       AMSType SMSMemory -> pure ()
     runTest :: Transport c => TProxy c -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
     runTest _ test' server = do

From 6b61d101dc060a8714059730a8fc71324ea9bd01 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 26 Oct 2024 12:56:29 +0100
Subject: [PATCH 178/195] smp server: fix restoring notifications (#1391)

---
 src/Simplex/Messaging/Server/QueueStore/STM.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index 6f0fd80b5..4cd499430 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -47,10 +47,11 @@ newQueueStore = do
   pure QueueStore {queues, senders, notifiers}
 
 addQueue :: QueueStore -> QueueRec -> IO (Either ErrorType ())
-addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId = sId} = atomically $ do
+addQueue QueueStore {queues, senders, notifiers} q@QueueRec {recipientId = rId, senderId = sId, notifier} = atomically $ do
   ifM hasId (pure $ Left DUPLICATE_) $ do
     TM.insertM rId (newTVar q) queues
     TM.insert sId rId senders
+    forM_ notifier $ \NtfCreds {notifierId} -> TM.insert notifierId rId notifiers
     pure $ Right ()
   where
     hasId = (||) <$> TM.member rId queues <*> TM.member sId senders

From 1735b619e8295f73865a7c66ad3f0f769434ce0d Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sat, 26 Oct 2024 12:57:43 +0100
Subject: [PATCH 179/195] 6.1.3.0

---
 CHANGELOG.md    | 4 ++++
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 3 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index caf28478e..aa1341647 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,7 @@
+# 6.1.3
+
+SMP server: fix restoring notification credentials.
+
 # 6.1.2
 
 Servers: more reliable restoring of state.
diff --git a/package.yaml b/package.yaml
index 491c103f4..f4efaf5bc 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.1.2.0
+version: 6.1.3.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 386f7ffa2..26febcd75 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.1.2.0
+version:        6.1.3.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 5940514f40f1e25ede535f4bb6502a5bc6e5321e Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 26 Oct 2024 16:14:55 +0100
Subject: [PATCH 180/195] smp server: remove queue from map when closing, test
 (#1392)

* smp server: remove queue from map when closing, test

* remove print

* refactor
---
 cabal.project                                 |  8 +++++
 package.yaml                                  |  1 +
 src/Simplex/Messaging/Server.hs               |  4 +--
 .../Messaging/Server/MsgStore/Journal.hs      | 28 +++++++++-------
 tests/CoreTests/MsgStoreTests.hs              | 32 +++++++++++++++++--
 5 files changed, 57 insertions(+), 16 deletions(-)

diff --git a/cabal.project b/cabal.project
index 1a4745ffc..b26c04055 100644
--- a/cabal.project
+++ b/cabal.project
@@ -4,6 +4,14 @@ packages: .
 -- packages: . ../http2
 -- packages: . ../network-transport
 
+-- package *
+   -- coverage: True
+   -- library-coverage: True
+
+-- package attoparsec
+   -- coverage: False
+   -- library-coverage: False
+
 index-state: 2023-12-12T00:00:00Z
 
 package cryptostore
diff --git a/package.yaml b/package.yaml
index f4efaf5bc..f3c1e71c5 100644
--- a/package.yaml
+++ b/package.yaml
@@ -188,6 +188,7 @@ tests:
       - -rtsopts
       - -with-rtsopts=-A64M
       - -with-rtsopts=-N1
+      # - -fhpc
 
 ghc-options:
   # - -haddock
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 38d718fd2..ea00c9591 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -94,7 +94,7 @@ import Simplex.Messaging.Server.Control
 import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
-import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgQueue (..), JMQueue (..), closeMsgQueue)
+import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgQueue (..), JMQueue (..), closeMsgQueueHandles)
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.NtfStore
@@ -1788,7 +1788,7 @@ processServerMessages = do
                 expired'' <- deleteExpiredMsgs q False old
                 stored'' <- liftIO $ getQueueSize q
                 liftIO $ logQueueState q
-                liftIO $ closeMsgQueue q
+                liftIO $ closeMsgQueueHandles q
                 pure (stored'', expired'')
           processValidateQueue q =
             getQueueSize q >>= \storedMsgsCount -> pure mempty {storedMsgsCount, storedQueues = 1}
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index 5324c9997..d40abc67f 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -20,11 +20,13 @@ module Simplex.Messaging.Server.MsgStore.Journal
     JournalStoreConfig (..),
     getQueueMessages,
     closeMsgQueue,
+    closeMsgQueueHandles,
     -- below are exported for tests
     MsgQueueState (..),
     JournalState (..),
     SJournalType (..),
     msgQueueDirectory,
+    msgQueueStatePath,
     readWriteQueueState,
     newMsgQueueState,
     newJournalId,
@@ -47,6 +49,7 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (intercalate)
+import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
@@ -207,7 +210,7 @@ instance MsgStoreClass JournalMsgStore where
     msgQueues <- TM.emptyIO
     pure JournalMsgStore {config, random, queueLocks, msgQueues}
 
-  closeMsgStore st = readTVarIO (msgQueues st) >>= mapM_ closeMsgQueue
+  closeMsgStore st = atomically (swapTVar (msgQueues st) M.empty) >>= mapM_ closeMsgQueueHandles
 
   activeMsgQueues = msgQueues
   {-# INLINE activeMsgQueues #-}
@@ -236,7 +239,7 @@ instance MsgStoreClass JournalMsgStore where
           Left e -> do
             putStrLn ("Error: message queue directory " <> dir <> " is invalid: " <> e)
             exitFailure
-        closeMsgQueue q
+        closeMsgQueueHandles q
         pure (i + 1, r <> r')
       progress i = "Processed: " <> show i <> " queues"
       foldQueues depth f acc (queueId, path) = do
@@ -283,15 +286,16 @@ instance MsgStoreClass JournalMsgStore where
 
   delMsgQueue :: JournalMsgStore -> RecipientId -> IO ()
   delMsgQueue ms rId = withLockMap (queueLocks ms) rId "delMsgQueue" $ do
-    void $ deleteMsgQueue_ ms rId
+    closeMsgQueue ms rId
     removeQueueDirectory ms rId
 
   delMsgQueueSize :: JournalMsgStore -> RecipientId -> IO Int
   delMsgQueueSize ms rId = withLockMap (queueLocks ms) rId "delMsgQueue" $ do
-    state_ <- deleteMsgQueue_ ms rId
-    sz <- maybe (pure $ -1) (fmap size . readTVarIO) state_
+    st_ <-
+      atomically (TM.lookupDelete rId (msgQueues ms))
+        >>= mapM (\q -> closeMsgQueueHandles q >> readTVarIO (state q))
     removeQueueDirectory ms rId
-    pure sz
+    pure $ maybe (-1) size st_
 
   getQueueMessages :: Bool -> JournalMsgQueue -> IO [Message]
   getQueueMessages drainMsgs q = run []
@@ -587,13 +591,13 @@ validQueueState MsgQueueState {readState = rs, writeState = ws, size}
         && msgPos ws == msgCount ws
         && bytePos ws == byteCount ws
 
-deleteMsgQueue_ :: JournalMsgStore -> RecipientId -> IO (Maybe (TVar MsgQueueState))
-deleteMsgQueue_ st rId =
-  atomically (TM.lookupDelete rId (msgQueues st))
-    >>= mapM (\q -> closeMsgQueue q $> state q)
+closeMsgQueue :: JournalMsgStore -> RecipientId -> IO ()
+closeMsgQueue ms rId =
+  atomically (TM.lookupDelete rId (msgQueues ms))
+    >>= mapM_ closeMsgQueueHandles
 
-closeMsgQueue :: JournalMsgQueue -> IO ()
-closeMsgQueue q = readTVarIO (handles q) >>= mapM_ closeHandles
+closeMsgQueueHandles :: JournalMsgQueue -> IO ()
+closeMsgQueueHandles q = readTVarIO (handles q) >>= mapM_ closeHandles
   where
     closeHandles (MsgQueueHandles sh rh wh_) = do
       hClose sh
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index 4a5d95eb2..5166ce7ef 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -5,19 +5,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module CoreTests.MsgStoreTests where
 
-import AgentTests.FunctionalAPITests (runRight_)
+import AgentTests.FunctionalAPITests (runRight, runRight_)
 import Control.Concurrent.STM
 import Control.Exception (bracket)
 import Control.Monad
 import Control.Monad.IO.Class
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Base64.URL as B64
 import Data.Time.Clock.System (getSystemTime)
 import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
@@ -41,6 +43,7 @@ msgStoreTests = do
     it "should export and import journal store" testExportImportStore
     describe "queue state" $ do
       it "should restore queue state from the last line" testQueueState
+      it "should recover when message is written and state is not" testMessageState
   where
     someMsgStoreTests :: MsgStoreClass s => SpecWith s
     someMsgStoreTests = do
@@ -189,7 +192,7 @@ testQueueState ms = do
   g <- C.newRandom
   rId <- EntityId <$> atomically (C.randomBytes 24 g)
   let dir = msgQueueDirectory ms rId
-      statePath = dir </> (queueLogFileName <> logFileExt)
+      statePath = msgQueueStatePath dir $ B.unpack (B64.encode $ unEntityId rId)
   createDirectoryIfMissing True dir
   state <- newMsgQueueState <$> newJournalId (random ms)
   withFile statePath WriteMode (`appendState` state)
@@ -248,3 +251,28 @@ testQueueState ms = do
       forM_ names $ \name ->
         let f = dir </> name
          in unless (f == keep) $ removeFile f
+
+testMessageState :: JournalMsgStore -> IO ()
+testMessageState ms = do
+  g <- C.newRandom
+  rId <- EntityId <$> atomically (C.randomBytes 24 g)
+  let dir = msgQueueDirectory ms rId
+      statePath = msgQueueStatePath dir $ B.unpack (B64.encode $ unEntityId rId)
+      write q s = writeMsg ms q True =<< mkMessage s
+
+  mId1 <- runRight $ do
+    q <- getMsgQueue ms rId
+    Just (Message {msgId = mId1}, True) <- write q "message 1"
+    Just (Message {}, False) <- write q "message 2"
+    liftIO $ closeMsgQueue ms rId
+    pure mId1
+
+  ls <- B.lines <$> B.readFile statePath
+  B.writeFile statePath $ B.unlines $ take (length ls - 1) ls
+
+  runRight_ $ do
+    q <- getMsgQueue ms rId
+    Just (Message {msgId = mId3}, False) <- write q "message 3"
+    (Msg "message 1", Msg "message 3") <- tryDelPeekMsg q mId1
+    (Msg "message 3", Nothing) <- tryDelPeekMsg q mId3
+    liftIO $ closeMsgQueueHandles q

From d49dc201c3c243d6404abb431c008534e3dc2fcd Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 28 Oct 2024 10:25:15 +0000
Subject: [PATCH 181/195] smp server: log file name on hClose error

---
 src/Simplex/Messaging/Server/MsgStore/Journal.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index d40abc67f..28e52f8e1 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -632,7 +632,10 @@ openFile f mode = do
   pure h
 
 hClose :: Handle -> IO ()
-hClose h = IO.hClose h `catchAny` (\e -> logError $ "STORE: hClose, error closing file, " <> tshow e)
+hClose h =
+  IO.hClose h `catchAny` \e -> do
+    name <- IO.hShow h
+    logError $ "STORE: hClose, " <> T.pack name <> ", " <> tshow e
 
 closeOnException :: Handle -> IO a -> IO a
 closeOnException h a = a `E.onException` hClose h

From 326cf08efaf1f76b79a7495b11c3b533612b4b9f Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 28 Oct 2024 10:28:54 +0000
Subject: [PATCH 182/195] 6.2.0.0

---
 package.yaml    | 2 +-
 simplexmq.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index f3c1e71c5..868465ecc 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 6.1.3.0
+version: 6.2.0.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 9d85fa9af..5fb2dfa8f 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        6.1.3.0
+version:        6.2.0.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 58d3c160efad343739ff154425c7153925b8c089 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 28 Oct 2024 14:22:18 +0000
Subject: [PATCH 183/195] smp server: fix logging progress when importing
 journal (#1393)

---
 src/Simplex/Messaging/Server.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index ea00c9591..9078ebace 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -1796,9 +1796,9 @@ processServerMessages = do
 importMessages :: forall s. MsgStoreClass s => Bool -> s -> FilePath -> Maybe Int64 -> IO MessageStats
 importMessages tty ms f old_ = do
   logInfo $ "restoring messages from file " <> T.pack f
-  LB.readFile f >>= runExceptT . foldM restoreMsg (0, Nothing, (0, 0, M.empty)) . zip [0..] . LB.lines >>= \case
+  LB.readFile f >>= runExceptT . foldM restoreMsg (0, Nothing, (0, 0, M.empty)) . LB.lines >>= \case
     Left e -> do
-      putStrLn ""
+      when tty $ putStrLn ""
       logError . T.pack $ "error restoring messages: " <> e
       liftIO exitFailure
     Right (lineCount, _, (storedMsgsCount, expiredMsgsCount, overQuota)) -> do
@@ -1810,9 +1810,9 @@ importMessages tty ms f old_ = do
       pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues}
   where
     progress i = "Processed " <> show i <> " lines"
-    restoreMsg :: (Int, Maybe (RecipientId, MsgQueue s), (Int, Int, M.Map RecipientId (MsgQueue s))) -> (Int, LB.ByteString) -> ExceptT String IO (Int, Maybe (RecipientId, MsgQueue s), (Int, Int, M.Map RecipientId (MsgQueue s)))
-    restoreMsg (!lineCount, q_, (!stored, !expired, !overQuota)) (i, s') = do
-      when (tty && i `mod` 1000 == 0) $ liftIO $ putStr (progress i <> "\r")
+    restoreMsg :: (Int, Maybe (RecipientId, MsgQueue s), (Int, Int, M.Map RecipientId (MsgQueue s))) -> LB.ByteString -> ExceptT String IO (Int, Maybe (RecipientId, MsgQueue s), (Int, Int, M.Map RecipientId (MsgQueue s)))
+    restoreMsg (!i, q_, (!stored, !expired, !overQuota)) s' = do
+      when (tty && i `mod` 1000 == 0) $ liftIO $ putStr (progress i <> "\r") >> hFlush stdout
       MLRv3 rId msg <- liftEither . first (msgErr "parsing") $ strDecode s
       liftError show $ addToMsgQueue rId msg
       where
@@ -1822,7 +1822,7 @@ importMessages tty ms f old_ = do
             -- to avoid lookup when restoring the next message to the same queue
             Just (rId', q') | rId' == rId -> pure q'
             _ -> getMsgQueue ms rId
-          (lineCount + 1,Just (rId, q),) <$> case msg of
+          (i + 1,Just (rId, q),) <$> case msg of
             Message {msgTs}
               | maybe True (systemSeconds msgTs >=) old_ -> do
                   writeMsg ms q False msg >>= \case

From ffecf200d4874dfa34f6d15b269964c0115a54ca Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 2 Nov 2024 15:34:33 +0000
Subject: [PATCH 184/195] build: client_library flag to build only used
 modules, remove package yaml (#1394)

* move dependencies to library

* remove package.yaml

* remove auto-generated comment

* cleanup target definitions

* add executable options

* add test rtsopts

* revert common options

* don't hide unused packages warning

* Add client_only cabal flag (#1396)

---------

Co-authored-by: IC Rainbow <aenor.realm@gmail.com>
Co-authored-by: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
---
 package.yaml                           | 224 ------------
 simplexmq.cabal                        | 467 ++++++-------------------
 src/Simplex/FileTransfer/Client.hs     |   1 -
 src/Simplex/FileTransfer/Server/Env.hs |   4 -
 src/Simplex/FileTransfer/Transport.hs  |   6 +-
 tests/XFTPAgent.hs                     |   4 +-
 tests/XFTPClient.hs                    |   4 +-
 7 files changed, 112 insertions(+), 598 deletions(-)
 delete mode 100644 package.yaml

diff --git a/package.yaml b/package.yaml
deleted file mode 100644
index 868465ecc..000000000
--- a/package.yaml
+++ /dev/null
@@ -1,224 +0,0 @@
-name: simplexmq
-version: 6.2.0.0
-synopsis: SimpleXMQ message broker
-description: |
-  This package includes <./docs/Simplex-Messaging-Server.html server>,
-  <./docs/Simplex-Messaging-Client.html client> and
-  <./docs/Simplex-Messaging-Agent.html agent> for SMP protocols:
-  .
-  * <https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md SMP protocol>
-  * <https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md SMP agent protocol>
-  .
-  See <https://github.com/simplex-chat/simplex-chat terminal chat prototype> built with SimpleXMQ broker.
-
-homepage: https://github.com/simplex-chat/simplexmq#readme
-license: AGPL-3
-author: simplex.chat
-maintainer: chat@simplex.chat
-copyright: 2020-2022 simplex.chat
-category: Chat, Network, Web, System, Cryptography
-extra-source-files:
-  - README.md
-  - CHANGELOG.md
-  - cbits/sha512.h
-  - cbits/sntrup761.h
-  - apps/smp-server/static/*.html
-  - apps/smp-server/static/media/*
-
-dependencies:
-  - aeson == 2.2.*
-  - ansi-terminal >= 0.10 && < 0.12
-  - asn1-encoding == 0.9.*
-  - asn1-types == 0.3.*
-  - async == 2.2.*
-  - attoparsec == 0.14.*
-  - base >= 4.14 && < 5
-  - base64-bytestring >= 1.0 && < 1.3
-  - case-insensitive == 1.2.*
-  - composition == 1.0.*
-  - constraints >= 0.12 && < 0.14
-  - containers == 0.6.*
-  - crypton == 0.34.*
-  - crypton-x509 == 1.7.*
-  - crypton-x509-store == 1.6.*
-  - crypton-x509-validation == 1.6.*
-  - cryptostore == 0.3.*
-  - data-default == 0.7.*
-  - direct-sqlcipher == 2.3.*
-  - directory == 1.3.*
-  - filepath == 1.4.*
-  - hashable == 1.4.*
-  - hourglass == 0.2.*
-  - http-types == 0.12.*
-  - http2 >= 4.2.2 && < 4.3
-  - ini == 0.4.1
-  - iproute == 1.7.*
-  - iso8601-time == 0.1.*
-  - memory == 0.18.*
-  - mtl >= 2.3.1 && < 3.0
-  - network >= 3.1.2.7 && < 3.2
-  - network-info >= 0.2 && < 0.3
-  - network-transport == 0.5.6
-  - network-udp >= 0.0 && < 0.1
-  - optparse-applicative >= 0.15 && < 0.17
-  - process == 1.6.*
-  - random >= 1.1 && < 1.3
-  - simple-logger == 0.1.*
-  - socks == 0.6.*
-  - sqlcipher-simple == 0.4.*
-  - stm == 2.5.*
-  - temporary == 1.3.*
-  - time == 1.12.*
-  - time-manager == 0.0.*
-  - tls >= 1.9.0 && < 1.10
-  - transformers == 0.6.*
-  - unliftio == 0.2.*
-  - unliftio-core == 0.2.*
-  - websockets == 0.12.*
-  - yaml == 0.11.*
-  - zstd == 0.1.3.*
-
-flags:
-  swift:
-    description: Enable swift JSON format
-    manual: True
-    default: False
-  use_crypton:
-    description: Use crypton etc. in cryptostore
-    manual: True
-    default: True
-
-# cpp-options:
-#   - -Dslow_servers
-
-when:
-  - condition: flag(swift)
-    cpp-options:
-      - -DswiftJSON
-  - condition: impl(ghc >= 9.6.2)
-    dependencies:
-      - bytestring == 0.11.*
-      - template-haskell == 2.20.*
-      - text >= 2.0.1 && < 2.2
-  - condition: impl(ghc < 9.6.2)
-    dependencies:
-      - bytestring == 0.10.*
-      - template-haskell == 2.16.*
-      - text >= 1.2.3.0 && < 1.3
-
-library:
-  source-dirs: src
-  c-sources:
-    - cbits/sha512.c
-    - cbits/sntrup761.c
-  include-dirs: cbits
-  extra-libraries: crypto
-
-executables:
-  smp-server:
-    source-dirs:
-    - apps/smp-server
-    - apps/smp-server/web
-    main: Main.hs
-    dependencies:
-      - file-embed
-      - simplexmq
-      - wai
-      - wai-app-static
-      - warp ==3.3.30 # the last one before http2-5.0
-      - warp-tls ==3.4.7 # extra internals exposed
-    ghc-options:
-      - -threaded
-      - -rtsopts
-
-  ntf-server:
-    source-dirs: apps/ntf-server
-    main: Main.hs
-    dependencies:
-      - simplexmq
-    ghc-options:
-      - -threaded
-      - -rtsopts
-
-  xftp-server:
-    source-dirs: apps/xftp-server
-    main: Main.hs
-    dependencies:
-      - simplexmq
-    ghc-options:
-      - -threaded
-      - -rtsopts
-
-  xftp:
-    source-dirs: apps/xftp
-    main: Main.hs
-    dependencies:
-      - simplexmq
-    ghc-options:
-      - -threaded
-      - -rtsopts
-
-tests:
-  simplexmq-test:
-    source-dirs:
-    - tests
-    - apps/smp-server/web
-    main: Test.hs
-    dependencies:
-      - deepseq == 1.4.*
-      - file-embed
-      - generic-random == 1.5.*
-      - hspec == 2.11.*
-      - hspec-core == 2.11.*
-      - http-client
-      - http-client-tls
-      - HUnit == 1.6.*
-      - main-tester == 0.2.*
-      - QuickCheck == 2.14.*
-      - silently == 1.2.*
-      - simplexmq
-      - timeit == 2.0.*
-      - unordered-containers
-      - wai
-      - wai-app-static
-      - warp
-      - warp-tls
-    ghc-options:
-      - -threaded
-      - -rtsopts
-      - -with-rtsopts=-A64M
-      - -with-rtsopts=-N1
-      # - -fhpc
-
-ghc-options:
-  # - -haddock
-  - -Weverything
-  - -Wno-missing-exported-signatures
-  - -Wno-missing-import-lists
-  - -Wno-missed-specialisations
-  - -Wno-all-missed-specialisations
-  - -Wno-unsafe
-  - -Wno-safe
-  - -Wno-missing-local-signatures
-  - -Wno-missing-kind-signatures
-  - -Wno-missing-deriving-strategies
-  - -Wno-monomorphism-restriction
-  - -Wno-prepositive-qualified-module
-  - -Wno-unused-packages
-  - -Wno-implicit-prelude
-  - -Wno-missing-safe-haskell-mode
-  - -Wno-missing-export-lists
-  - -Wno-partial-fields
-  - -Wcompat
-  - -Werror=incomplete-record-updates
-  - -Werror=incomplete-patterns
-  - -Werror=incomplete-uni-patterns
-  - -Werror=missing-methods
-  - -Werror=tabs
-  - -Wredundant-constraints
-  - -Wincomplete-record-updates
-  - -Wunused-type-patterns
-  - -O2
-
-default-extensions:
-  - StrictData
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 5fb2dfa8f..58f0b74a0 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -1,9 +1,5 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.0.
---
--- see: https://github.com/sol/hpack
-
 name:           simplexmq
 version:        6.2.0.0
 synopsis:       SimpleXMQ message broker
@@ -66,6 +62,11 @@ flag use_crypton
   manual: True
   default: True
 
+flag client_library
+  description: Don't build server-related code.
+  manual: True
+  default: False
+
 library
   exposed-modules:
       Simplex.FileTransfer.Agent
@@ -77,13 +78,6 @@ library
       Simplex.FileTransfer.Crypto
       Simplex.FileTransfer.Description
       Simplex.FileTransfer.Protocol
-      Simplex.FileTransfer.Server
-      Simplex.FileTransfer.Server.Control
-      Simplex.FileTransfer.Server.Env
-      Simplex.FileTransfer.Server.Main
-      Simplex.FileTransfer.Server.Stats
-      Simplex.FileTransfer.Server.Store
-      Simplex.FileTransfer.Server.StoreLog
       Simplex.FileTransfer.Transport
       Simplex.FileTransfer.Types
       Simplex.FileTransfer.Util
@@ -154,36 +148,13 @@ library
       Simplex.Messaging.Encoding.String
       Simplex.Messaging.Notifications.Client
       Simplex.Messaging.Notifications.Protocol
-      Simplex.Messaging.Notifications.Server
-      Simplex.Messaging.Notifications.Server.Control
-      Simplex.Messaging.Notifications.Server.Env
-      Simplex.Messaging.Notifications.Server.Main
-      Simplex.Messaging.Notifications.Server.Push.APNS
-      Simplex.Messaging.Notifications.Server.Push.APNS.Internal
-      Simplex.Messaging.Notifications.Server.Stats
-      Simplex.Messaging.Notifications.Server.Store
-      Simplex.Messaging.Notifications.Server.StoreLog
       Simplex.Messaging.Notifications.Transport
       Simplex.Messaging.Notifications.Types
       Simplex.Messaging.Parsers
       Simplex.Messaging.Protocol
-      Simplex.Messaging.Server
       Simplex.Messaging.Server.CLI
-      Simplex.Messaging.Server.Control
-      Simplex.Messaging.Server.Env.STM
       Simplex.Messaging.Server.Expiration
-      Simplex.Messaging.Server.Information
-      Simplex.Messaging.Server.Main
-      Simplex.Messaging.Server.MsgStore
-      Simplex.Messaging.Server.MsgStore.Journal
-      Simplex.Messaging.Server.MsgStore.STM
-      Simplex.Messaging.Server.MsgStore.Types
-      Simplex.Messaging.Server.NtfStore
-      Simplex.Messaging.Server.QueueStore
       Simplex.Messaging.Server.QueueStore.QueueInfo
-      Simplex.Messaging.Server.QueueStore.STM
-      Simplex.Messaging.Server.Stats
-      Simplex.Messaging.Server.StoreLog
       Simplex.Messaging.ServiceScheme
       Simplex.Messaging.Session
       Simplex.Messaging.TMap
@@ -206,13 +177,45 @@ library
       Simplex.RemoteControl.Discovery.Multicast
       Simplex.RemoteControl.Invitation
       Simplex.RemoteControl.Types
+  if !flag(client_library)
+      exposed-modules:
+          Simplex.FileTransfer.Server
+          Simplex.FileTransfer.Server.Control
+          Simplex.FileTransfer.Server.Env
+          Simplex.FileTransfer.Server.Main
+          Simplex.FileTransfer.Server.Stats
+          Simplex.FileTransfer.Server.Store
+          Simplex.FileTransfer.Server.StoreLog
+          Simplex.Messaging.Server
+          Simplex.Messaging.Server.Control
+          Simplex.Messaging.Server.Env.STM
+          Simplex.Messaging.Server.Information
+          Simplex.Messaging.Server.Main
+          Simplex.Messaging.Server.MsgStore
+          Simplex.Messaging.Server.MsgStore.Journal
+          Simplex.Messaging.Server.MsgStore.STM
+          Simplex.Messaging.Server.MsgStore.Types
+          Simplex.Messaging.Server.NtfStore
+          Simplex.Messaging.Server.QueueStore
+          Simplex.Messaging.Server.QueueStore.STM
+          Simplex.Messaging.Server.Stats
+          Simplex.Messaging.Server.StoreLog
+          Simplex.Messaging.Notifications.Server
+          Simplex.Messaging.Notifications.Server.Control
+          Simplex.Messaging.Notifications.Server.Env
+          Simplex.Messaging.Notifications.Server.Main
+          Simplex.Messaging.Notifications.Server.Push.APNS
+          Simplex.Messaging.Notifications.Server.Push.APNS.Internal
+          Simplex.Messaging.Notifications.Server.Stats
+          Simplex.Messaging.Notifications.Server.Store
+          Simplex.Messaging.Notifications.Server.StoreLog
   other-modules:
       Paths_simplexmq
   hs-source-dirs:
       src
   default-extensions:
       StrictData
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-home-modules -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2
   include-dirs:
       cbits
   c-sources:
@@ -222,14 +225,12 @@ library
       crypto
   build-depends:
       aeson ==2.2.*
-    , ansi-terminal >=0.10 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
     , attoparsec ==0.14.*
     , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
-    , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
@@ -242,7 +243,6 @@ library
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
-    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -275,18 +275,22 @@ library
   default-language: Haskell2010
   if flag(swift)
     cpp-options: -DswiftJSON
+  if !flag(client_library)
+    build-depends:
+        case-insensitive ==1.2.*
+      , hashable ==1.4.*
   if impl(ghc >= 9.6.2)
     build-depends:
         bytestring ==0.11.*
-      , template-haskell ==2.20.*
       , text >=2.0.1 && <2.2
   if impl(ghc < 9.6.2)
     build-depends:
         bytestring ==0.10.*
-      , template-haskell ==2.16.*
       , text >=1.2.3.0 && <1.3
 
 executable ntf-server
+  if flag(client_library)
+      buildable: False
   main-is: Main.hs
   other-modules:
       Paths_simplexmq
@@ -294,75 +298,16 @@ executable ntf-server
       apps/ntf-server
   default-extensions:
       StrictData
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
   build-depends:
-      aeson ==2.2.*
-    , ansi-terminal >=0.10 && <0.12
-    , asn1-encoding ==0.9.*
-    , asn1-types ==0.3.*
-    , async ==2.2.*
-    , attoparsec ==0.14.*
-    , base >=4.14 && <5
-    , base64-bytestring >=1.0 && <1.3
-    , case-insensitive ==1.2.*
-    , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , crypton ==0.34.*
-    , crypton-x509 ==1.7.*
-    , crypton-x509-store ==1.6.*
-    , crypton-x509-validation ==1.6.*
-    , cryptostore ==0.3.*
-    , data-default ==0.7.*
-    , direct-sqlcipher ==2.3.*
-    , directory ==1.3.*
-    , filepath ==1.4.*
-    , hashable ==1.4.*
-    , hourglass ==0.2.*
-    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
-    , ini ==0.4.1
-    , iproute ==1.7.*
-    , iso8601-time ==0.1.*
-    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
-    , network >=3.1.2.7 && <3.2
-    , network-info ==0.2.*
-    , network-transport ==0.5.6
-    , network-udp ==0.0.*
-    , optparse-applicative >=0.15 && <0.17
-    , process ==1.6.*
-    , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
+      base
+    , simple-logger
     , simplexmq
-    , socks ==0.6.*
-    , sqlcipher-simple ==0.4.*
-    , stm ==2.5.*
-    , temporary ==1.3.*
-    , time ==1.12.*
-    , time-manager ==0.0.*
-    , tls >=1.9.0 && <1.10
-    , transformers ==0.6.*
-    , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
-    , websockets ==0.12.*
-    , yaml ==0.11.*
-    , zstd ==0.1.3.*
   default-language: Haskell2010
-  if flag(swift)
-    cpp-options: -DswiftJSON
-  if impl(ghc >= 9.6.2)
-    build-depends:
-        bytestring ==0.11.*
-      , template-haskell ==2.20.*
-      , text >=2.0.1 && <2.2
-  if impl(ghc < 9.6.2)
-    build-depends:
-        bytestring ==0.10.*
-      , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
 
 executable smp-server
+  if flag(client_library)
+      buildable: False
   main-is: Main.hs
   other-modules:
       Static
@@ -373,80 +318,27 @@ executable smp-server
       apps/smp-server/web
   default-extensions:
       StrictData
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
   build-depends:
-      aeson ==2.2.*
-    , ansi-terminal >=0.10 && <0.12
-    , asn1-encoding ==0.9.*
-    , asn1-types ==0.3.*
-    , async ==2.2.*
-    , attoparsec ==0.14.*
-    , base >=4.14 && <5
-    , base64-bytestring >=1.0 && <1.3
-    , case-insensitive ==1.2.*
-    , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , crypton ==0.34.*
-    , crypton-x509 ==1.7.*
-    , crypton-x509-store ==1.6.*
-    , crypton-x509-validation ==1.6.*
-    , cryptostore ==0.3.*
-    , data-default ==0.7.*
-    , direct-sqlcipher ==2.3.*
-    , directory ==1.3.*
+      base
+    , bytestring
+    , directory
     , file-embed
-    , filepath ==1.4.*
-    , hashable ==1.4.*
-    , hourglass ==0.2.*
-    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
-    , ini ==0.4.1
-    , iproute ==1.7.*
-    , iso8601-time ==0.1.*
-    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
-    , network >=3.1.2.7 && <3.2
-    , network-info ==0.2.*
-    , network-transport ==0.5.6
-    , network-udp ==0.0.*
-    , optparse-applicative >=0.15 && <0.17
-    , process ==1.6.*
-    , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
+    , filepath
+    , network
+    , simple-logger
     , simplexmq
-    , socks ==0.6.*
-    , sqlcipher-simple ==0.4.*
-    , stm ==2.5.*
-    , temporary ==1.3.*
-    , time ==1.12.*
-    , time-manager ==0.0.*
-    , tls >=1.9.0 && <1.10
-    , transformers ==0.6.*
-    , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
+    , text
+    , unliftio
     , wai
     , wai-app-static
     , warp ==3.3.30
     , warp-tls ==3.4.7
-    , websockets ==0.12.*
-    , yaml ==0.11.*
-    , zstd ==0.1.3.*
   default-language: Haskell2010
-  if flag(swift)
-    cpp-options: -DswiftJSON
-  if impl(ghc >= 9.6.2)
-    build-depends:
-        bytestring ==0.11.*
-      , template-haskell ==2.20.*
-      , text >=2.0.1 && <2.2
-  if impl(ghc < 9.6.2)
-    build-depends:
-        bytestring ==0.10.*
-      , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
 
 executable xftp
+  if flag(client_library)
+      buildable: False
   main-is: Main.hs
   other-modules:
       Paths_simplexmq
@@ -454,75 +346,15 @@ executable xftp
       apps/xftp
   default-extensions:
       StrictData
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
   build-depends:
-      aeson ==2.2.*
-    , ansi-terminal >=0.10 && <0.12
-    , asn1-encoding ==0.9.*
-    , asn1-types ==0.3.*
-    , async ==2.2.*
-    , attoparsec ==0.14.*
-    , base >=4.14 && <5
-    , base64-bytestring >=1.0 && <1.3
-    , case-insensitive ==1.2.*
-    , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , crypton ==0.34.*
-    , crypton-x509 ==1.7.*
-    , crypton-x509-store ==1.6.*
-    , crypton-x509-validation ==1.6.*
-    , cryptostore ==0.3.*
-    , data-default ==0.7.*
-    , direct-sqlcipher ==2.3.*
-    , directory ==1.3.*
-    , filepath ==1.4.*
-    , hashable ==1.4.*
-    , hourglass ==0.2.*
-    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
-    , ini ==0.4.1
-    , iproute ==1.7.*
-    , iso8601-time ==0.1.*
-    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
-    , network >=3.1.2.7 && <3.2
-    , network-info ==0.2.*
-    , network-transport ==0.5.6
-    , network-udp ==0.0.*
-    , optparse-applicative >=0.15 && <0.17
-    , process ==1.6.*
-    , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
+      base
     , simplexmq
-    , socks ==0.6.*
-    , sqlcipher-simple ==0.4.*
-    , stm ==2.5.*
-    , temporary ==1.3.*
-    , time ==1.12.*
-    , time-manager ==0.0.*
-    , tls >=1.9.0 && <1.10
-    , transformers ==0.6.*
-    , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
-    , websockets ==0.12.*
-    , yaml ==0.11.*
-    , zstd ==0.1.3.*
   default-language: Haskell2010
-  if flag(swift)
-    cpp-options: -DswiftJSON
-  if impl(ghc >= 9.6.2)
-    build-depends:
-        bytestring ==0.11.*
-      , template-haskell ==2.20.*
-      , text >=2.0.1 && <2.2
-  if impl(ghc < 9.6.2)
-    build-depends:
-        bytestring ==0.10.*
-      , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
 
 executable xftp-server
+  if flag(client_library)
+      buildable: False
   main-is: Main.hs
   other-modules:
       Paths_simplexmq
@@ -530,75 +362,16 @@ executable xftp-server
       apps/xftp-server
   default-extensions:
       StrictData
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
   build-depends:
-      aeson ==2.2.*
-    , ansi-terminal >=0.10 && <0.12
-    , asn1-encoding ==0.9.*
-    , asn1-types ==0.3.*
-    , async ==2.2.*
-    , attoparsec ==0.14.*
-    , base >=4.14 && <5
-    , base64-bytestring >=1.0 && <1.3
-    , case-insensitive ==1.2.*
-    , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , crypton ==0.34.*
-    , crypton-x509 ==1.7.*
-    , crypton-x509-store ==1.6.*
-    , crypton-x509-validation ==1.6.*
-    , cryptostore ==0.3.*
-    , data-default ==0.7.*
-    , direct-sqlcipher ==2.3.*
-    , directory ==1.3.*
-    , filepath ==1.4.*
-    , hashable ==1.4.*
-    , hourglass ==0.2.*
-    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
-    , ini ==0.4.1
-    , iproute ==1.7.*
-    , iso8601-time ==0.1.*
-    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
-    , network >=3.1.2.7 && <3.2
-    , network-info ==0.2.*
-    , network-transport ==0.5.6
-    , network-udp ==0.0.*
-    , optparse-applicative >=0.15 && <0.17
-    , process ==1.6.*
-    , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
+      base
+    , simple-logger
     , simplexmq
-    , socks ==0.6.*
-    , sqlcipher-simple ==0.4.*
-    , stm ==2.5.*
-    , temporary ==1.3.*
-    , time ==1.12.*
-    , time-manager ==0.0.*
-    , tls >=1.9.0 && <1.10
-    , transformers ==0.6.*
-    , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
-    , websockets ==0.12.*
-    , yaml ==0.11.*
-    , zstd ==0.1.3.*
   default-language: Haskell2010
-  if flag(swift)
-    cpp-options: -DswiftJSON
-  if impl(ghc >= 9.6.2)
-    build-depends:
-        bytestring ==0.11.*
-      , template-haskell ==2.20.*
-      , text >=2.0.1 && <2.2
-  if impl(ghc < 9.6.2)
-    build-depends:
-        bytestring ==0.10.*
-      , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
 
 test-suite simplexmq-test
+  if flag(client_library)
+      buildable: False
   type: exitcode-stdio-1.0
   main-is: Test.hs
   other-modules:
@@ -644,87 +417,53 @@ test-suite simplexmq-test
       apps/smp-server/web
   default-extensions:
       StrictData
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts -with-rtsopts=-A64M -with-rtsopts=-N1
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts -with-rtsopts=-A64M -with-rtsopts=-N1
   build-depends:
-      HUnit ==1.6.*
-    , QuickCheck ==2.14.*
-    , aeson ==2.2.*
-    , ansi-terminal >=0.10 && <0.12
-    , asn1-encoding ==0.9.*
-    , asn1-types ==0.3.*
-    , async ==2.2.*
-    , attoparsec ==0.14.*
-    , base >=4.14 && <5
-    , base64-bytestring >=1.0 && <1.3
-    , case-insensitive ==1.2.*
-    , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , crypton ==0.34.*
-    , crypton-x509 ==1.7.*
-    , crypton-x509-store ==1.6.*
-    , crypton-x509-validation ==1.6.*
-    , cryptostore ==0.3.*
-    , data-default ==0.7.*
+      base
+    , aeson
+    , async
+    , base64-bytestring
+    , bytestring
+    , containers
+    , crypton
+    , crypton-x509
+    , crypton-x509-store
+    , crypton-x509-validation
     , deepseq ==1.4.*
-    , direct-sqlcipher ==2.3.*
-    , directory ==1.3.*
+    , directory
     , file-embed
-    , filepath ==1.4.*
+    , filepath
     , generic-random ==1.5.*
-    , hashable ==1.4.*
-    , hourglass ==0.2.*
+    , hashable
     , hspec ==2.11.*
-    , hspec-core ==2.11.*
     , http-client
-    , http-client-tls
-    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
-    , ini ==0.4.1
-    , iproute ==1.7.*
-    , iso8601-time ==0.1.*
+    , http-types
+    , http2
+    , HUnit ==1.6.*
+    , ini
+    , iso8601-time
     , main-tester ==0.2.*
-    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
-    , network >=3.1.2.7 && <3.2
-    , network-info ==0.2.*
-    , network-transport ==0.5.6
-    , network-udp ==0.0.*
-    , optparse-applicative >=0.15 && <0.17
-    , process ==1.6.*
-    , random >=1.1 && <1.3
+    , memory
+    , mtl
+    , network
+    , process
+    , QuickCheck ==2.14.*
+    , random
     , silently ==1.2.*
-    , simple-logger ==0.1.*
+    , simple-logger
     , simplexmq
-    , socks ==0.6.*
-    , sqlcipher-simple ==0.4.*
-    , stm ==2.5.*
-    , temporary ==1.3.*
-    , time ==1.12.*
-    , time-manager ==0.0.*
+    , sqlcipher-simple
+    , stm
+    , text
+    , time
     , timeit ==2.0.*
-    , tls >=1.9.0 && <1.10
-    , transformers ==0.6.*
-    , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
+    , transformers
+    , unliftio
+    , unliftio-core
     , unordered-containers
     , wai
     , wai-app-static
     , warp
     , warp-tls
-    , websockets ==0.12.*
-    , yaml ==0.11.*
-    , zstd ==0.1.3.*
+    , yaml
   default-language: Haskell2010
-  if flag(swift)
-    cpp-options: -DswiftJSON
-  if impl(ghc >= 9.6.2)
-    build-depends:
-        bytestring ==0.11.*
-      , template-haskell ==2.20.*
-      , text >=2.0.1 && <2.2
-  if impl(ghc < 9.6.2)
-    build-depends:
-        bytestring ==0.10.*
-      , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs
index 7abfdfe5a..e5c66e764 100644
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -29,7 +29,6 @@ import qualified Data.X509.Validation as XV
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Client as H
 import Simplex.FileTransfer.Protocol
-import Simplex.FileTransfer.Server.Env (supportedXFTPhandshakes)
 import Simplex.FileTransfer.Transport
 import Simplex.Messaging.Client
   ( NetworkConfig (..),
diff --git a/src/Simplex/FileTransfer/Server/Env.hs b/src/Simplex/FileTransfer/Server/Env.hs
index a9b6c9a79..4bccda0ff 100644
--- a/src/Simplex/FileTransfer/Server/Env.hs
+++ b/src/Simplex/FileTransfer/Server/Env.hs
@@ -28,7 +28,6 @@ import Simplex.FileTransfer.Transport (VersionRangeXFTP)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (BasicAuth, RcvPublicAuthKey)
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Transport (ALPN)
 import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), loadFingerprint, loadServerCredential)
 import Simplex.Messaging.Util (tshow)
 import System.IO (IOMode (..))
@@ -96,9 +95,6 @@ defaultFileExpiration =
       checkInterval = 2 * 3600 -- seconds, 2 hours
     }
 
-supportedXFTPhandshakes :: [ALPN]
-supportedXFTPhandshakes = ["xftp/1"]
-
 newXFTPServerEnv :: XFTPServerConfig -> IO XFTPEnv
 newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, xftpCredentials} = do
   random <- C.newRandom
diff --git a/src/Simplex/FileTransfer/Transport.hs b/src/Simplex/FileTransfer/Transport.hs
index d72f9862b..a028a3773 100644
--- a/src/Simplex/FileTransfer/Transport.hs
+++ b/src/Simplex/FileTransfer/Transport.hs
@@ -12,6 +12,7 @@ module Simplex.FileTransfer.Transport
   ( supportedFileServerVRange,
     authCmdsXFTPVersion,
     xftpClientHandshakeStub,
+    supportedXFTPhandshakes,
     XFTPClientHandshake (..),
     -- xftpClientHandshake,
     XFTPServerHandshake (..),
@@ -57,7 +58,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol (CommandError)
-import Simplex.Messaging.Transport (SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
+import Simplex.Messaging.Transport (ALPN, SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
 import Simplex.Messaging.Transport.HTTP2.File
 import Simplex.Messaging.Util (bshow, tshow)
 import Simplex.Messaging.Version
@@ -101,6 +102,9 @@ supportedFileServerVRange = mkVersionRange initialXFTPVersion currentXFTPVersion
 xftpClientHandshakeStub :: c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
 xftpClientHandshakeStub _c _ks _keyHash _xftpVRange = throwE TEVersion
 
+supportedXFTPhandshakes :: [ALPN]
+supportedXFTPhandshakes = ["xftp/1"]
+
 data XFTPServerHandshake = XFTPServerHandshake
   { xftpVersionRange :: VersionRangeXFTP,
     sessionId :: SessionId,
diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index a425e1bdb..6d6446959 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -24,8 +24,8 @@ import SMPClient (xit'')
 import Simplex.FileTransfer.Client (XFTPClientConfig (..))
 import Simplex.FileTransfer.Description (FileChunk (..), FileDescription (..), FileDescriptionURI (..), ValidFileDescription, fileDescriptionURI, kb, mb, qrSizeLimit, pattern ValidFileDescription)
 import Simplex.FileTransfer.Protocol (FileParty (..))
-import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), supportedXFTPhandshakes)
-import Simplex.FileTransfer.Transport (XFTPErrorType (AUTH))
+import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
+import Simplex.FileTransfer.Transport (XFTPErrorType (AUTH), supportedXFTPhandshakes)
 import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
 import Simplex.Messaging.Agent (AgentClient, testProtocolServer, xftpDeleteRcvFile, xftpDeleteSndFileInternal, xftpDeleteSndFileRemote, xftpReceiveFile, xftpSendDescription, xftpSendFile, xftpStartWorkers)
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
diff --git a/tests/XFTPClient.hs b/tests/XFTPClient.hs
index bd7b23568..f99283a79 100644
--- a/tests/XFTPClient.hs
+++ b/tests/XFTPClient.hs
@@ -14,8 +14,8 @@ import SMPClient (serverBracket)
 import Simplex.FileTransfer.Client
 import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Server (runXFTPServerBlocking)
-import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defaultFileExpiration, defaultInactiveClientExpiration, supportedXFTPhandshakes)
-import Simplex.FileTransfer.Transport (supportedFileServerVRange)
+import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defaultFileExpiration, defaultInactiveClientExpiration)
+import Simplex.FileTransfer.Transport (supportedFileServerVRange, supportedXFTPhandshakes)
 import Simplex.Messaging.Protocol (XFTPServer)
 import Simplex.Messaging.Transport (ALPN)
 import Simplex.Messaging.Transport.Server

From 7c219455691012e4f6f18c2074df4fff1352bdd8 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 3 Nov 2024 21:08:07 +0000
Subject: [PATCH 185/195] smp server: option to skip expiring messages on
 start, read queue state file end only (#1400)

---
 src/Simplex/Messaging/Server.hs                  | 10 ++++++----
 src/Simplex/Messaging/Server/Env/STM.hs          |  6 +++++-
 src/Simplex/Messaging/Server/Main.hs             |  4 +++-
 src/Simplex/Messaging/Server/MsgStore/Journal.hs | 16 ++++++++++++----
 tests/CoreTests/MsgStoreTests.hs                 |  3 ++-
 tests/SMPClient.hs                               |  1 +
 6 files changed, 29 insertions(+), 11 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 9078ebace..ba91e50cf 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -1761,20 +1761,22 @@ exportMessages tty ms f drainMsgs = do
 processServerMessages :: M MessageStats
 processServerMessages = do
   old_ <- asks (messageExpiration . config) $>>= (liftIO . fmap Just . expireBeforeEpoch)
-  asks msgStore >>= liftIO . processMessages old_
+  expire <- asks $ expireMessagesOnStart . config
+  asks msgStore >>= liftIO . processMessages old_ expire
     where
-      processMessages :: Maybe Int64 -> AMsgStore -> IO MessageStats
-      processMessages old_ = \case
+      processMessages :: Maybe Int64 -> Bool -> AMsgStore -> IO MessageStats
+      processMessages old_ expire = \case
         AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
           Just f -> ifM (doesFileExist f) (importMessages False ms f old_) (pure newMessageStats)
           Nothing -> pure newMessageStats
-        AMS SMSJournal ms -> case old_ of
+        AMS SMSJournal ms | expire -> case old_ of
           Just old -> do
             logInfo "expiring journal store messages..."
             withAllMsgQueues False ms $ \_ -> processExpireQueue old
           Nothing -> do
             logInfo "validating journal store messages..."
             withAllMsgQueues False ms $ \_ -> processValidateQueue
+        AMS SMSJournal _ -> logWarn "skipping message expiration" $> newMessageStats
         where
           processExpireQueue old q =
             runExceptT expireQueue >>= \case
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index b25a76a05..c46519d90 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -79,6 +79,7 @@ data ServerConfig = ServerConfig
     controlPortAdminAuth :: Maybe BasicAuth,
     -- | time after which the messages can be removed from the queues and check interval, seconds
     messageExpiration :: Maybe ExpirationConfig,
+    expireMessagesOnStart :: Bool,
     -- | notification expiration interval (seconds)
     notificationExpiration :: ExpirationConfig,
     -- | time after which the socket with inactive client can be disconnected (without any messages or commands, incl. PING),
@@ -155,6 +156,9 @@ defaultMaxJournalMsgCount = 256
 defaultMsgQueueQuota :: Int
 defaultMsgQueueQuota = 128
 
+defaultStateTailSize :: Int
+defaultStateTailSize = 512
+
 data Env = Env
   { config :: ServerConfig,
     serverActive :: TVar Bool,
@@ -284,7 +288,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, msgSt
     AMSType SMSMemory -> AMS SMSMemory <$> newMsgStore STMStoreConfig {storePath = storeMsgsFile, quota = msgQueueQuota}
     AMSType SMSJournal -> case storeMsgsFile of
       Just storePath -> 
-        let cfg = JournalStoreConfig {storePath, quota = msgQueueQuota, pathParts = journalMsgStoreDepth, maxMsgCount = maxJournalMsgCount, maxStateLines = maxJournalStateLines}
+        let cfg = JournalStoreConfig {storePath, quota = msgQueueQuota, pathParts = journalMsgStoreDepth, maxMsgCount = maxJournalMsgCount, maxStateLines = maxJournalStateLines, stateTailSize = defaultStateTailSize}
          in AMS SMSJournal <$> newMsgStore cfg
       Nothing -> putStrLn "Error: journal msg store require path in [STORE_LOG], restore_messages" >> exitFailure
   ntfStore <- NtfStore <$> TM.emptyIO
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index d3eab5f33..0251b6705 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -137,7 +137,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       doesFileExist iniFile >>= \case
         True -> readIniFile iniFile >>= either exitError a
         _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
-    newJournalMsgStore = newMsgStore JournalStoreConfig {storePath = storeMsgsJournalDir, pathParts = journalMsgStoreDepth, quota = defaultMsgQueueQuota, maxMsgCount = defaultMaxJournalMsgCount, maxStateLines = defaultMaxJournalStateLines}
+    newJournalMsgStore = newMsgStore JournalStoreConfig {storePath = storeMsgsJournalDir, pathParts = journalMsgStoreDepth, quota = defaultMsgQueueQuota, maxMsgCount = defaultMaxJournalMsgCount, maxStateLines = defaultMaxJournalStateLines, stateTailSize = defaultStateTailSize}
     iniFile = combine cfgPath "smp-server.ini"
     serverVersion = "SMP server v" <> simplexMQVersion
     defaultServerPorts = "5223,443"
@@ -238,6 +238,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 <> ("restore_messages: " <> onOff enableStoreLog <> "\n\n")
                 <> "# Messages and notifications expiration periods.\n"
                 <> ("expire_messages_days: " <> tshow defMsgExpirationDays <> "\n")
+                <> "expire_messages_on_start: on\n"
                 <> ("expire_ntfs_hours: " <> tshow defNtfExpirationHours <> "\n\n")
                 <> "# Log daily server statistics to CSV file\n"
                 <> ("log_stats: " <> onOff logStats <> "\n\n")
@@ -403,6 +404,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                   defaultMessageExpiration
                     { ttl = 86400 * readIniDefault defMsgExpirationDays "STORE_LOG" "expire_messages_days" ini
                     },
+              expireMessagesOnStart = fromMaybe True $ iniOnOff "STORE_LOG" "expire_messages_on_start" ini,
               notificationExpiration =
                 defaultNtfExpiration
                   { ttl = 3600 * readIniDefault defNtfExpirationHours "STORE_LOG" "expire_ntfs_hours" ini
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index 28e52f8e1..44297bf37 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -45,7 +45,6 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bitraversable (bimapM)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (intercalate)
@@ -85,7 +84,8 @@ data JournalStoreConfig = JournalStoreConfig
     -- When this limit is reached, the file will be changed.
     -- This number should be set bigger than queue quota.
     maxMsgCount :: Int,
-    maxStateLines :: Int
+    maxStateLines :: Int,
+    stateTailSize :: Int
   }
 
 data JMQueue = JMQueue
@@ -530,7 +530,7 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
   where
     tempBackup = statePath <> ".bak"
     readQueueState = do
-      ls <- LB.lines <$> LB.readFile statePath
+      ls <- B.lines <$> readFileTail
       case ls of
         [] -> writeNewQueueState
         _ -> do
@@ -541,7 +541,7 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
       logWarn $ "STORE: readWriteQueueState, empty queue state - initialized, " <> T.pack statePath
       st <- newMsgQueueState <$> newJournalId random
       writeQueueState st
-    useLastLine len isLastLine ls = case strDecode $ LB.toStrict $ last ls of
+    useLastLine len isLastLine ls = case strDecode $ last ls of
       Right st
         | len > maxStateLines config || not isLastLine ->
             backupWriteQueueState st
@@ -571,6 +571,14 @@ readWriteQueueState JournalMsgStore {random, config} statePath =
       sh <- openFile statePath AppendMode
       closeOnException sh $ appendState sh st
       pure (st, sh)
+    readFileTail =
+      IO.withFile statePath ReadMode $ \h -> do
+        size <- IO.hFileSize h
+        let sz = stateTailSize config
+            sz' = fromIntegral sz
+        if size > sz'
+          then IO.hSeek h AbsoluteSeek (size - sz') >> B.hGet h sz
+          else B.hGet h (fromIntegral size)
 
 validQueueState :: MsgQueueState -> Bool
 validQueueState MsgQueueState {readState = rs, writeState = ws, size}
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index 5166ce7ef..16e3a12f0 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -63,7 +63,8 @@ testJournalStoreCfg =
       pathParts = journalMsgStoreDepth,
       quota = 3,
       maxMsgCount = 4,
-      maxStateLines = 2
+      maxStateLines = 2,
+      stateTailSize = 256
     }
 
 mkMessage :: MonadIO m => ByteString -> m Message
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 0efb64c02..b28f2b804 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -132,6 +132,7 @@ cfgMS msType =
       controlPortUserAuth = Nothing,
       controlPortAdminAuth = Nothing,
       messageExpiration = Just defaultMessageExpiration,
+      expireMessagesOnStart = True,
       notificationExpiration = defaultNtfExpiration,
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
       logStatsInterval = Nothing,

From 0fd4aa1e23cd7f97db986d60f4a24dedc927bf56 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 3 Nov 2024 21:10:45 +0000
Subject: [PATCH 186/195] 6.2.0.1

---
 simplexmq.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 58f0b74a0..309b67b83 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           simplexmq
-version:        6.2.0.0
+version:        6.2.0.1
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From d3275cef482ebcf5c89cf3efd3f3094f53db879e Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 7 Nov 2024 08:09:11 +0000
Subject: [PATCH 187/195] smp server: combine messages and queue storage to
 optimise performance, prevent race condition when deleting queue and to avoid
 "orphan" messages. (#1395)

* smp server: combine queue and message store into one class (WIP)

* keep deleted queue tombstones to prevent race conditions and errors when restoring

* move store log from server to store implementations

* STMQueueStore type class

* fix store closed when messages expired, handle store writing errors

* types

* version

* fix recovery from missing write journal, tests

* version
---
 simplexmq.cabal                               |   3 +-
 src/Simplex/FileTransfer/Server.hs            |   1 +
 src/Simplex/Messaging/Notifications/Server.hs |   2 +
 src/Simplex/Messaging/Protocol.hs             |   2 +
 src/Simplex/Messaging/Server.hs               | 473 +++++++++---------
 src/Simplex/Messaging/Server/Env/STM.hs       |  47 +-
 src/Simplex/Messaging/Server/Main.hs          |  13 +-
 .../Messaging/Server/MsgStore/Journal.hs      | 265 ++++++----
 src/Simplex/Messaging/Server/MsgStore/STM.hs  | 114 +++--
 .../Messaging/Server/MsgStore/Types.hs        |  83 ++-
 .../Messaging/Server/QueueStore/STM.hs        | 234 ++++++---
 src/Simplex/Messaging/Server/StoreLog.hs      |  63 +--
 .../Messaging/Server/StoreLog/Types.hs        |  13 +
 src/Simplex/Messaging/Util.hs                 |   6 +-
 tests/CoreTests/MsgStoreTests.hs              | 274 +++++++---
 tests/CoreTests/StoreLogTests.hs              |  53 +-
 tests/ServerTests.hs                          |   4 +-
 17 files changed, 996 insertions(+), 654 deletions(-)
 create mode 100644 src/Simplex/Messaging/Server/StoreLog/Types.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 309b67b83..9dd60595b 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           simplexmq
-version:        6.2.0.1
+version:        6.2.0.101
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
@@ -200,6 +200,7 @@ library
           Simplex.Messaging.Server.QueueStore.STM
           Simplex.Messaging.Server.Stats
           Simplex.Messaging.Server.StoreLog
+          Simplex.Messaging.Server.StoreLog.Types
           Simplex.Messaging.Notifications.Server
           Simplex.Messaging.Notifications.Server.Control
           Simplex.Messaging.Notifications.Server.Env
diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index 4635034fc..29cc5bf6a 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -181,6 +181,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
     stopServer = do
       withFileLog closeStoreLog
       saveServerStats
+      logInfo "Server stopped"
 
     expireFilesThread_ :: XFTPServerConfig -> [M ()]
     expireFilesThread_ XFTPServerConfig {fileExpiration = Just fileExp} = [expireFiles fileExp]
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 81094e1a7..ca24a2318 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -115,10 +115,12 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
 
     stopServer :: M ()
     stopServer = do
+      logInfo "Saving server state..."
       saveServer
       NtfSubscriber {smpSubscribers, smpAgent} <- asks subscriber
       liftIO $ readTVarIO smpSubscribers >>= mapM_ (\SMPSubscriber {subThreadId} -> readTVarIO subThreadId >>= mapM_ (deRefWeak >=> mapM_ killThread))
       liftIO $ closeSMPClientAgent smpAgent
+      logInfo "Server stopped"
 
     saveServer :: M ()
     saveServer = withNtfLog closeStoreLog >> saveServerLastNtfs >> saveServerStats
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index d5d816bec..03234aad4 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -538,11 +538,13 @@ messageId :: Message -> MsgId
 messageId = \case
   Message {msgId} -> msgId
   MessageQuota {msgId} -> msgId
+{-# INLINE messageId #-}
 
 messageTs :: Message -> SystemTime
 messageTs = \case
   Message {msgTs} -> msgTs
   MessageQuota {msgTs} -> msgTs
+{-# INLINE messageTs #-}
 
 newtype EncRcvMsgBody = EncRcvMsgBody ByteString
   deriving (Eq, Show)
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index ba91e50cf..b0e499d3f 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -94,15 +94,14 @@ import Simplex.Messaging.Server.Control
 import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
-import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgQueue (..), JMQueue (..), closeMsgQueueHandles)
+import Simplex.Messaging.Server.MsgStore.Journal (JournalQueue, closeMsgQueue)
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
-import Simplex.Messaging.Server.QueueStore.STM as QS
+import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.Stats
-import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
@@ -223,8 +222,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
 
     saveServer :: Bool -> M ()
     saveServer drainMsgs = do
-      withLog closeStoreLog
-      saveServerMessages drainMsgs
+      ams@(AMS _ ms) <- asks msgStore
+      liftIO $ saveServerMessages drainMsgs ams >> closeMsgStore ms
       saveServerNtfs
       saveServerStats
 
@@ -236,10 +235,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
       Server ->
       String ->
       (Server -> TQueue (QueueId, ClientId, Subscribed)) ->
-      (Server -> TMap QueueId (TVar Client)) ->
-      (Server -> TVar (IM.IntMap Client)) ->
+      (Server -> TMap QueueId (TVar AClient)) ->
+      (Server -> TVar (IM.IntMap AClient)) ->
       (Server -> TVar (IM.IntMap (NonEmpty (QueueId, Subscribed)))) ->
-      (Client -> TMap QueueId s) ->
+      (forall st. Client st -> TMap QueueId s) ->
       (s -> IO ()) ->
       M ()
     serverThread s label subQ subs subClnts pendingEvts clientSubs unsub = do
@@ -250,7 +249,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
           $>>= endPreviousSubscriptions
           >>= mapM_ unsub
       where
-        updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, ClientId, Subscribed) -> STM (Maybe ((QueueId, Subscribed), Client))
+        updateSubscribers :: TVar (IM.IntMap (Maybe AClient)) -> (QueueId, ClientId, Subscribed) -> STM (Maybe ((QueueId, Subscribed), AClient))
         updateSubscribers cls (qId, clntId, subscribed) =
           -- Client lookup by ID is in the same STM transaction.
           -- In case client disconnects during the transaction,
@@ -273,17 +272,17 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
               -- This case catches Just Nothing - it cannot happen here.
               -- Nothing is there only before client thread is started.
               _ -> TM.lookup qId ss >>= mapM readTVar -- do not insert client if it is already disconnected, but send END to any other client
-            clientToBeNotified c'
+            clientToBeNotified ac@(AClient _ c')
               | clntId == clientId c' = pure Nothing
-              | otherwise = (\yes -> if yes then Just ((qId, subscribed), c') else Nothing) <$> readTVar (connected c')
-        endPreviousSubscriptions :: ((QueueId, Subscribed), Client) -> IO (Maybe s)
-        endPreviousSubscriptions (qEvt@(qId, _), c) = do
+              | otherwise = (\yes -> if yes then Just ((qId, subscribed), ac) else Nothing) <$> readTVar (connected c')
+        endPreviousSubscriptions :: ((QueueId, Subscribed), AClient) -> IO (Maybe s)
+        endPreviousSubscriptions (qEvt@(qId, _), ac@(AClient _ c)) = do
           atomically $ modifyTVar' (pendingEvts s) $ IM.alter (Just . maybe [qEvt] (qEvt <|)) (clientId c)
           atomically $ do
             sub <- TM.lookupDelete qId (clientSubs c)
-            removeWhenNoSubs c $> sub
+            removeWhenNoSubs ac $> sub
         -- remove client from server's subscribed cients
-        removeWhenNoSubs c = whenM (null <$> readTVar (clientSubs c)) $ modifyTVar' (subClnts s) $ IM.delete (clientId c)
+        removeWhenNoSubs (AClient _ c) = whenM (null <$> readTVar (clientSubs c)) $ modifyTVar' (subClnts s) $ IM.delete (clientId c)
 
     deliverNtfsThread :: Server -> M ()
     deliverNtfsThread Server {ntfSubClients} = do
@@ -294,7 +293,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
         threadDelay ntfInt
         readTVarIO ntfSubClients >>= mapM_ (deliverNtfs ns stats)
       where
-        deliverNtfs ns stats Client {clientId, ntfSubscriptions, sndQ, connected} =
+        deliverNtfs ns stats (AClient _ Client {clientId, ntfSubscriptions, sndQ, connected}) =
           whenM (currentClient readTVarIO) $ do
             subs <- readTVarIO ntfSubscriptions
             logDebug $ "NOTIFICATIONS: client #" <> tshow clientId <> " is current with " <> tshow (M.size subs) <> " subs"
@@ -342,7 +341,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
           ends <- atomically $ swapTVar ref IM.empty
           unless (null ends) $ forM_ (IM.assocs ends) $ \(cId, qEvts) ->
             mapM_ (queueEvts qEvts) . join . IM.lookup cId =<< readTVarIO cls
-        queueEvts qEvts c@Client {connected, sndQ = q} =
+        queueEvts qEvts (AClient _ c@Client {connected, sndQ = q}) =
           whenM (readTVarIO connected) $ do
             sent <- atomically $ ifM (isFullTBQueue q) (pure False) (writeTBQueue q ts $> True)
             if sent
@@ -387,11 +386,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
       liftIO $ forever $ do
         threadDelay' interval
         old <- expireBeforeEpoch expCfg
-        Sum deleted <- withActiveMsgQueues ms $ \_ -> expireQueueMsgs stats old
+        Sum deleted <- withActiveMsgQueues ms $ expireQueueMsgs stats old
         logInfo $ "STORE: expireMessagesThread, expired " <> tshow deleted <> " messages"
       where
-        expireQueueMsgs stats old q =
-          runExceptT (deleteExpiredMsgs q True old) >>= \case
+        expireQueueMsgs stats old rId q =
+          runExceptT (deleteExpiredMsgs rId q True old) >>= \case
             Right deleted -> Sum deleted <$ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
             Left _ -> pure 0
 
@@ -422,8 +421,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
       liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
       ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedAllB, qDeletedNew, qDeletedSecured, qSub, qSubAllB, qSubAuth, qSubDuplicate, qSubProhibited, qSubEnd, qSubEndB, ntfCreated, ntfDeleted, ntfDeletedB, ntfSub, ntfSubB, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, ntfCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv}
         <- asks serverStats
-      QueueStore {queues, notifiers} <- asks queueStore
-      let interval = 1000000 * logInterval
+      AMS _ st <- asks msgStore
+      let queues = activeMsgQueues st
+          notifiers = notifiers' st
+          interval = 1000000 * logInterval
       forever $ do
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
           hSetBuffering h LineBuffering
@@ -612,7 +613,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
               CPClients -> withAdminRole $ do
                 active <- unliftIO u (asks clients) >>= readTVarIO
                 hPutStrLn h "clientId,sessionId,connected,createdAt,rcvActiveAt,sndActiveAt,age,subscriptions"
-                forM_ (IM.toList active) $ \(cid, cl) -> forM_ cl $ \Client {sessionId, connected, createdAt, rcvActiveAt, sndActiveAt, subscriptions} -> do
+                forM_ (IM.toList active) $ \(cid, cl) -> forM_ cl $ \(AClient _ Client {sessionId, connected, createdAt, rcvActiveAt, sndActiveAt, subscriptions}) -> do
                   connected' <- bshow <$> readTVarIO connected
                   rcvActiveAt' <- strEncode <$> readTVarIO rcvActiveAt
                   sndActiveAt' <- strEncode <$> readTVarIO sndActiveAt
@@ -622,8 +623,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                   hPutStrLn h . B.unpack $ B.intercalate "," [bshow cid, encode sessionId, connected', strEncode createdAt, rcvActiveAt', sndActiveAt', bshow age, subscriptions']
               CPStats -> withUserRole $ do
                 ss <- unliftIO u $ asks serverStats
-                QueueStore {queues, notifiers} <- unliftIO u $ asks queueStore
-                let getStat :: (ServerStats -> IORef a) -> IO a
+                AMS _ st <- unliftIO u $ asks msgStore
+                let queues = activeMsgQueues st
+                    notifiers = notifiers' st
+                    getStat :: (ServerStats -> IORef a) -> IO a
                     getStat var = readIORef (var ss)
                     putStat :: Show a => String -> (ServerStats -> IORef a) -> IO ()
                     putStat label var = getStat var >>= \v -> hPutStrLn h $ label <> ": " <> show v
@@ -745,25 +748,25 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                   putSubscribedClients "SMP" subClients False
                   putSubscribedClients "Ntf" ntfSubClients True
                   where
-                    putActiveClientsInfo :: String -> TMap QueueId (TVar Client) -> Bool -> IO ()
+                    putActiveClientsInfo :: String -> TMap QueueId (TVar AClient) -> Bool -> IO ()
                     putActiveClientsInfo protoName clients showIds = do
                       activeSubs <- readTVarIO clients
                       hPutStrLn h $ protoName <> " subscriptions: " <> show (M.size activeSubs)
                       clnts <- countSubClients activeSubs
                       hPutStrLn h $ protoName <> " subscribed clients: " <> show (IS.size clnts) <> (if showIds then " " <> show (IS.toList clnts) else "")
                       where
-                        countSubClients :: M.Map QueueId (TVar Client) -> IO IS.IntSet
-                        countSubClients = foldM (\ !s c -> (`IS.insert` s) . clientId <$> readTVarIO c) IS.empty
-                    putSubscribedClients :: String -> TVar (IM.IntMap Client) -> Bool -> IO ()
+                        countSubClients :: M.Map QueueId (TVar AClient) -> IO IS.IntSet
+                        countSubClients = foldM (\ !s c -> (`IS.insert` s) . clientId' <$> readTVarIO c) IS.empty
+                    putSubscribedClients :: String -> TVar (IM.IntMap AClient) -> Bool -> IO ()
                     putSubscribedClients protoName subClnts showIds = do
                       clnts <- readTVarIO subClnts
                       hPutStrLn h $ protoName <> " subscribed clients count 2: " <> show (IM.size clnts) <> (if showIds then " " <> show (IM.keys clnts) else "")
-                    countClientSubs :: (Client -> TMap QueueId a) -> Maybe (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap (Maybe Client) -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
+                    countClientSubs :: (forall s. Client s -> TMap QueueId a) -> Maybe (M.Map QueueId a -> IO (Int, Int, Int, Int)) -> IM.IntMap (Maybe AClient) -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
                     countClientSubs subSel countSubs_ = foldM addSubs (0, (0, 0, 0, 0), 0, (0, 0, 0))
                       where
-                        addSubs :: (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural)) -> Maybe Client -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
+                        addSubs :: (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural)) -> Maybe AClient -> IO (Int, (Int, Int, Int, Int), Int, (Natural, Natural, Natural))
                         addSubs acc Nothing = pure acc
-                        addSubs (!subCnt, cnts@(!c1, !c2, !c3, !c4), !clCnt, !qs) (Just cl) = do
+                        addSubs (!subCnt, cnts@(!c1, !c2, !c3, !c4), !clCnt, !qs) (Just acl@(AClient _ cl)) = do
                           subs <- readTVarIO $ subSel cl
                           cnts' <- case countSubs_ of
                             Nothing -> pure cnts
@@ -772,11 +775,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                               pure (c1 + c1', c2 + c2', c3 + c3', c4 + c4')
                           let cnt = M.size subs
                               clCnt' = if cnt == 0 then clCnt else clCnt + 1
-                          qs' <- if cnt == 0 then pure qs else addQueueLengths qs cl
+                          qs' <- if cnt == 0 then pure qs else addQueueLengths qs acl
                           pure (subCnt + cnt, cnts', clCnt', qs')
-                    clientTBQueueLengths' :: Foldable t => t (Maybe Client) -> IO (Natural, Natural, Natural)
+                    clientTBQueueLengths' :: Foldable t => t (Maybe AClient) -> IO (Natural, Natural, Natural)
                     clientTBQueueLengths' = foldM (\acc -> maybe (pure acc) (addQueueLengths acc)) (0, 0, 0)
-                    addQueueLengths (!rl, !sl, !ml) cl = do
+                    addQueueLengths (!rl, !sl, !ml) (AClient _ cl) = do
                       (rl', sl', ml') <- queueLengths cl
                       pure (rl + rl', sl + sl', ml + ml')
                     queueLengths Client {rcvQ, sndQ, msgQ} = do
@@ -795,21 +798,16 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                               SubPending -> (c1, c2 + 1, c3, c4)
                               SubThread _ -> (c1, c2, c3 + 1, c4)
                           ProhibitSub -> pure (c1, c2, c3, c4 + 1)
-              CPDelete queueId' -> withUserRole $ unliftIO u $ do
-                st <- asks queueStore
-                AMS _ ms <- asks msgStore
-                queueId <- liftIO (getQueue st SSender queueId') >>= \case
-                  Left _ -> pure queueId' -- fallback to using as recipientId directly
-                  Right QueueRec {recipientId} -> pure recipientId
-                r <- liftIO $
-                  deleteQueue st queueId $>>= \q ->
-                    Right . (q,) <$> delMsgQueueSize ms queueId
+              CPDelete qId -> withUserRole $ unliftIO u $ do
+                AMS _ st <- asks msgStore
+                r <- liftIO $ runExceptT $ do
+                  (q, qr) <- ExceptT (getQueueRec st SSender qId) `catchE` \_ -> ExceptT (getQueueRec st SRecipient qId)
+                  ExceptT $ deleteQueueSize st (recipientId qr) q
                 case r of
-                  Left e -> liftIO . hPutStrLn h $ "error: " <> show e
-                  Right (q, numDeleted) -> do
-                    withLog (`logDeleteQueue` queueId)
-                    updateDeletedStats q
-                    liftIO . hPutStrLn h $ "ok, " <> show numDeleted <> " messages deleted"
+                  Left e -> liftIO $ hPutStrLn h $ "error: " <> show e
+                  Right (qr, numDeleted) -> do
+                    updateDeletedStats qr
+                    liftIO $ hPutStrLn h $ "ok, " <> show numDeleted <> " messages deleted"
               CPSave -> withAdminRole $ withLock' (savingLock srv) "control" $ do
                 hPutStrLn h "saving server state..."
                 unliftIO u $ saveServer False
@@ -838,16 +836,19 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
   nextClientId <- asks clientSeq
   clientId <- atomically $ stateTVar nextClientId $ \next -> (next, next + 1)
   atomically $ modifyTVar' active $ IM.insert clientId Nothing
-  c <- liftIO $ newClient clientId q thVersion sessionId ts
-  runClientThreads active c clientId `finally` clientDisconnected c
+  AMS msType ms <- asks msgStore
+  c <- liftIO $ newClient msType clientId q thVersion sessionId ts
+  runClientThreads msType ms active c clientId `finally` clientDisconnected c
   where
-    runClientThreads active c clientId = do
-      atomically $ modifyTVar' active $ IM.insert clientId $ Just c
+    runClientThreads :: STMQueueStore (MsgStore s) => SMSType s -> MsgStore s -> TVar (IM.IntMap (Maybe AClient)) -> Client (MsgStore s) -> IS.Key -> M ()
+    runClientThreads msType ms active c clientId = do
+      atomically $ modifyTVar' active $ IM.insert clientId $ Just (AClient msType c)
       s <- asks server
       expCfg <- asks $ inactiveClientExpiration . config
       th <- newMVar h -- put TH under a fair lock to interleave messages and command responses
       labelMyThread . B.unpack $ "client $" <> encode sessionId
-      raceAny_ $ [liftIO $ send th c, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c s expCfg
+      raceAny_ $ [liftIO $ send th c, liftIO $ sendMsg th c, client thParams s ms c, receive h ms c] <> disconnectThread_ c s expCfg
+    disconnectThread_ :: Client s -> Server -> Maybe ExpirationConfig -> [M ()]
     disconnectThread_ c s (Just expCfg) = [liftIO $ disconnectTransport h (rcvActiveAt c) (sndActiveAt c) expCfg (noSubscriptions c s)]
     disconnectThread_ _ _ _ = []
     noSubscriptions Client {clientId} s = do
@@ -856,7 +857,7 @@ runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessio
         then pure False
         else not . IM.member clientId <$> readTVarIO (ntfSubClients s)
 
-clientDisconnected :: Client -> M ()
+clientDisconnected :: Client s -> M ()
 clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, connected, sessionId, endThreads} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " disc"
   -- these can be in separate transactions,
@@ -875,7 +876,7 @@ clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, connecte
   tIds <- atomically $ swapTVar endThreads IM.empty
   liftIO $ mapM_ (mapM_ killThread <=< deRefWeak) tIds
   where
-    updateSubscribers :: M.Map QueueId a -> TMap QueueId (TVar Client) -> IO ()
+    updateSubscribers :: M.Map QueueId a -> TMap QueueId (TVar AClient) -> IO ()
     updateSubscribers subs srvSubs =
       forM_ (M.keys subs) $ \qId ->
         -- lookup of the subscribed client TVar can be in separate transaction,
@@ -884,8 +885,8 @@ clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, connecte
         TM.lookupIO qId srvSubs >>=
           mapM_ (\c' -> atomically $ whenM (sameClientId c <$> readTVar c') $ TM.delete qId srvSubs)
 
-sameClientId :: Client -> Client -> Bool
-sameClientId Client {clientId} Client {clientId = cId'} = clientId == cId'
+sameClientId :: Client s -> AClient -> Bool
+sameClientId Client {clientId} (AClient _ Client {clientId = cId'}) = clientId == cId'
 
 cancelSub :: Sub -> IO ()
 cancelSub s = case subThread s of
@@ -895,8 +896,8 @@ cancelSub s = case subThread s of
       _ -> pure ()
   ProhibitSub -> pure ()
 
-receive :: Transport c => THandleSMP c 'TServer -> Client -> M ()
-receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
+receive :: forall c s. (Transport c, STMQueueStore s) => THandleSMP c 'TServer -> s -> Client s -> M ()
+receive h@THandle {params = THandleParams {thAuth}} ms Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
   sa <- asks serverActive
   forever $ do
@@ -909,7 +910,7 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
     write sndQ errs
     write rcvQ cmds
   where
-    updateBatchStats :: ServerStats -> [(Maybe QueueRec, Transmission Cmd)] -> M ()
+    updateBatchStats :: ServerStats -> [(Maybe (StoreQueue s, QueueRec), Transmission Cmd)] -> M ()
     updateBatchStats stats = \case
       (_, (_, _, (Cmd _ cmd))) : _ -> do
         let sel_ = case cmd of
@@ -920,14 +921,14 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
               _ -> Nothing
         mapM_ (\sel -> incStat $ sel stats) sel_
       [] -> pure ()
-    cmdAction :: ServerStats -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
+    cmdAction :: ServerStats -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe (StoreQueue s, QueueRec), Transmission Cmd))
     cmdAction stats (tAuth, authorized, (corrId, entId, cmdOrError)) =
       case cmdOrError of
         Left e -> pure $ Left (corrId, entId, ERR e)
-        Right cmd -> verified =<< verifyTransmission ((,C.cbNonce (bs corrId)) <$> thAuth) tAuth authorized entId cmd
+        Right cmd -> verified =<< verifyTransmission ms ((,C.cbNonce (bs corrId)) <$> thAuth) tAuth authorized entId cmd
           where
             verified = \case
-              VRVerified qr -> pure $ Right (qr, (corrId, entId, cmd))
+              VRVerified q -> pure $ Right (q, (corrId, entId, cmd))
               VRFailed -> do
                 case cmd of
                   Cmd _ SEND {} -> incStat $ msgSentAuth stats
@@ -938,7 +939,7 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
                 pure $ Left (corrId, entId, ERR AUTH)
     write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
 
-send :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO ()
+send :: Transport c => MVar (THandleSMP c 'TServer) -> Client s -> IO ()
 send th c@Client {sndQ, msgQ, sessionId} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " send"
   forever $ atomically (readTBQueue sndQ) >>= sendTransmissions
@@ -963,12 +964,12 @@ send th c@Client {sndQ, msgQ, sessionId} = do
           MSG {} -> ((CorrId "", entId, cmd) : msgs, (corrId, entId, OK))
           _ -> (msgs, t)
 
-sendMsg :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO ()
+sendMsg :: Transport c => MVar (THandleSMP c 'TServer) -> Client s -> IO ()
 sendMsg th c@Client {msgQ, sessionId} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " sendMsg"
   forever $ atomically (readTBQueue msgQ) >>= mapM_ (\t -> tSend th c [t])
 
-tSend :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> NonEmpty (Transmission BrokerMsg) -> IO ()
+tSend :: Transport c => MVar (THandleSMP c 'TServer) -> Client s -> NonEmpty (Transmission BrokerMsg) -> IO ()
 tSend th Client {sndActiveAt} ts = do
   withMVar th $ \h@THandle {params} ->
     void . tPut h $ L.map (\t -> Right (Nothing, encodeTransmission params t)) ts
@@ -987,7 +988,7 @@ disconnectTransport THandle {connection, params = THandleParams {sessionId}} rcv
       ts <- max <$> readTVarIO rcvActiveAt <*> readTVarIO sndActiveAt
       if systemSeconds ts < old then closeConnection connection else loop
 
-data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
+data VerificationResult s = VRVerified (Maybe (StoreQueue s, QueueRec)) | VRFailed
 
 -- This function verifies queue command authorization, with the objective to have constant time between the three AUTH error scenarios:
 -- - the queue and party key exist, and the provided authorization has type matching queue key, but it is made with the different key.
@@ -995,30 +996,29 @@ data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
 -- - the queue or party key do not exist.
 -- In all cases, the time of the verification should depend only on the provided authorization type,
 -- a dummy key is used to run verification in the last two cases, and failure is returned irrespective of the result.
-verifyTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> QueueId -> Cmd -> M VerificationResult
-verifyTransmission auth_ tAuth authorized queueId cmd =
+verifyTransmission :: forall s. STMQueueStore s => s -> Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> QueueId -> Cmd -> M (VerificationResult s)
+verifyTransmission ms auth_ tAuth authorized queueId cmd =
   case cmd of
     Cmd SRecipient (NEW k _ _ _ _) -> pure $ Nothing `verifiedWith` k
-    Cmd SRecipient _ -> verifyQueue (\q -> Just q `verifiedWith` recipientKey q) <$> get SRecipient
+    Cmd SRecipient _ -> verifyQueue (\q -> Just q `verifiedWith` recipientKey (snd q)) <$> get SRecipient
     -- SEND will be accepted without authorization before the queue is secured with KEY or SKEY command
-    Cmd SSender (SKEY k) -> verifyQueue (\q -> if maybe True (k ==) (senderKey q) then Just q `verifiedWith` k else dummyVerify) <$> get SSender
-    Cmd SSender SEND {} -> verifyQueue (\q -> Just q `verified` maybe (isNothing tAuth) verify (senderKey q)) <$> get SSender
+    Cmd SSender (SKEY k) -> verifyQueue (\q -> if maybe True (k ==) (senderKey $ snd q) then Just q `verifiedWith` k else dummyVerify) <$> get SSender
+    Cmd SSender SEND {} -> verifyQueue (\q -> Just q `verified` maybe (isNothing tAuth) verify (senderKey $ snd q)) <$> get SSender
     Cmd SSender PING -> pure $ VRVerified Nothing
     Cmd SSender RFWD {} -> pure $ VRVerified Nothing
     -- NSUB will not be accepted without authorization
-    Cmd SNotifier NSUB -> verifyQueue (\q -> maybe dummyVerify (\n -> Just q `verifiedWith` notifierKey n) (notifier q)) <$> get SNotifier
+    Cmd SNotifier NSUB -> verifyQueue (\q -> maybe dummyVerify (\n -> Just q `verifiedWith` notifierKey n) (notifier $ snd q)) <$> get SNotifier
     Cmd SProxiedClient _ -> pure $ VRVerified Nothing
   where
     verify = verifyCmdAuthorization auth_ tAuth authorized
     dummyVerify = verify (dummyAuthKey tAuth) `seq` VRFailed
-    verifyQueue :: (QueueRec -> VerificationResult) -> Either ErrorType QueueRec -> VerificationResult
+    verifyQueue :: ((StoreQueue s, QueueRec) -> VerificationResult s) -> Either ErrorType (StoreQueue s, QueueRec) -> VerificationResult s
     verifyQueue = either (const dummyVerify)
     verified q cond = if cond then VRVerified q else VRFailed
+    verifiedWith :: Maybe (StoreQueue s, QueueRec) -> C.APublicAuthKey -> VerificationResult s
     verifiedWith q k = q `verified` verify k
-    get :: DirectParty p => SParty p -> M (Either ErrorType QueueRec)
-    get party = do
-      st <- asks queueStore
-      liftIO $ getQueue st party queueId
+    get :: DirectParty p => SParty p -> M (Either ErrorType (StoreQueue s, QueueRec))
+    get party = liftIO $ getQueueRec ms party queueId
 
 verifyCmdAuthorization :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> C.APublicAuthKey -> Bool
 verifyCmdAuthorization auth_ tAuth authorized key = maybe False (verify key) tAuth
@@ -1065,7 +1065,7 @@ dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/Xo
 dummyKeyX25519 :: C.PublicKey 'C.X25519
 dummyKeyX25519 = "MCowBQYDK2VuAyEA4JGSMYht18H4mas/jHeBwfcM7jLwNYJNOAhi2/g4RXg="
 
-forkClient :: Client -> String -> M () -> M ()
+forkClient :: Client s -> String -> M () -> M ()
 forkClient Client {endThreads, endThreadSeq} label action = do
   tId <- atomically $ stateTVar endThreadSeq $ \next -> (next, next + 1)
   t <- forkIO $ do
@@ -1073,13 +1073,17 @@ forkClient Client {endThreads, endThreadSeq} label action = do
     action `finally` atomically (modifyTVar' endThreads $ IM.delete tId)
   mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId
 
-client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
-client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers} = do
-  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
-  forever $
-    atomically (readTBQueue rcvQ)
-      >>= mapM processCommand
-      >>= mapM_ reply . L.nonEmpty . catMaybes . L.toList
+client :: forall s. STMQueueStore s => THandleParams SMPVersion 'TServer -> Server -> s -> Client s -> M ()
+client
+  thParams'
+  Server {subscribedQ, ntfSubscribedQ, subscribers}
+  ms
+  clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} = do
+    labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
+    forever $
+      atomically (readTBQueue rcvQ)
+        >>= mapM processCommand
+        >>= mapM_ reply . L.nonEmpty . catMaybes . L.toList
   where
     reply :: MonadIO m => NonEmpty (Transmission BrokerMsg) -> m ()
     reply = atomically . writeTBQueue sndQ
@@ -1163,43 +1167,40 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
     mkIncProxyStats ps psOwn own sel = do
       incStat $ sel ps
       when own $ incStat $ sel psOwn
-    processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
-    processCommand (qr_, (corrId, entId, cmd)) = case cmd of
+    processCommand :: (Maybe (StoreQueue s, QueueRec), Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
+    processCommand (q_, (corrId, entId, cmd)) = case cmd of
       Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command)
       Cmd SSender command -> Just <$> case command of
         SKEY sKey ->
-          withQueue $ \QueueRec {sndSecure, recipientId} ->
-            (corrId,entId,) <$> if sndSecure then secureQueue_ "SKEY" recipientId sKey else pure $ ERR AUTH
-        SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
+          withQueue $ \q QueueRec {sndSecure} ->
+            (corrId,entId,) <$> if sndSecure then secureQueue_ q sKey else pure $ ERR AUTH
+        SEND flags msgBody -> withQueue $ sendMessage flags msgBody
         PING -> pure (corrId, NoEntity, PONG)
         RFWD encBlock -> (corrId, NoEntity,) <$> processForwardedCommand encBlock
       Cmd SNotifier NSUB -> Just <$> subscribeNotifications
-      Cmd SRecipient command -> do
-        st <- asks queueStore
+      Cmd SRecipient command ->
         Just <$> case command of
           NEW rKey dhKey auth subMode sndSecure ->
             ifM
               allowNew
-              (createQueue st rKey dhKey subMode sndSecure)
+              (createQueue rKey dhKey subMode sndSecure)
               (pure (corrId, entId, ERR AUTH))
             where
               allowNew = do
                 ServerConfig {allowNewQueues, newQueueBasicAuth} <- asks config
                 pure $ allowNewQueues && maybe True ((== auth) . Just) newQueueBasicAuth
-          SUB -> withQueue (`subscribeQueue` entId)
+          SUB -> withQueue subscribeQueue
           GET -> withQueue getMessage
-          ACK msgId -> withQueue (`acknowledgeMsg` msgId)
-          KEY sKey ->
-            withQueue $ \QueueRec {recipientId} ->
-              (corrId,entId,) <$> secureQueue_ "KEY" recipientId sKey
-          NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
-          NDEL -> deleteQueueNotifier_ st
-          OFF -> suspendQueue_ st
-          DEL -> delQueueAndMsgs st
-          QUE -> withQueue $ fmap (corrId,entId,) . getQueueInfo
+          ACK msgId -> withQueue $ acknowledgeMsg msgId
+          KEY sKey -> withQueue $ \q _ -> (corrId,entId,) <$> secureQueue_ q sKey
+          NKEY nKey dhKey -> withQueue $ \q _ -> addQueueNotifier_ q nKey dhKey
+          NDEL -> withQueue $ \q _ -> deleteQueueNotifier_ q
+          OFF -> maybe (pure $ err INTERNAL) suspendQueue_ q_
+          DEL -> maybe (pure $ err INTERNAL) delQueueAndMsgs q_          
+          QUE -> withQueue $ \q qr -> (corrId,entId,) <$> getQueueInfo q qr
       where
-        createQueue :: QueueStore -> RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> SenderCanSecure -> M (Transmission BrokerMsg)
-        createQueue st recipientKey dhKey subMode sndSecure = time "NEW" $ do
+        createQueue :: RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> SenderCanSecure -> M (Transmission BrokerMsg)
+        createQueue recipientKey dhKey subMode sndSecure = time "NEW" $ do
           (rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
           updatedAt <- Just <$> liftIO getSystemDate
           let rcvDhSecret = C.dh' dhKey privDhKey
@@ -1222,20 +1223,18 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               Int -> ((RecipientId, SenderId) -> QueueIdsKeys) -> ((RecipientId, SenderId) -> QueueRec) -> M BrokerMsg
             addQueueRetry 0 _ _ = pure $ ERR INTERNAL
             addQueueRetry n qik qRec = do
-              ids@(rId, _) <- getIds
-              -- create QueueRec record with these ids and keys
+              ids <- getIds
               let qr = qRec ids
-              liftIO (addQueue st qr) >>= \case
+              liftIO (addQueue ms qr) >>= \case
                 Left DUPLICATE_ -> addQueueRetry (n - 1) qik qRec
                 Left e -> pure $ ERR e
-                Right () -> do
-                  withLog (`logCreateQueue` qr)
+                Right q -> do
                   stats <- asks serverStats
                   incStat $ qCreated stats
                   incStat $ qCount stats
                   case subMode of
                     SMOnlyCreate -> pure ()
-                    SMSubscribe -> void $ subscribeQueue qr rId
+                    SMSubscribe -> void $ subscribeQueue q qr
                   pure $ IDS (qik ids)
 
             getIds :: M (RecipientId, SenderId)
@@ -1243,16 +1242,17 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               n <- asks $ queueIdBytes . config
               liftM2 (,) (randomId n) (randomId n)
 
-        secureQueue_ :: T.Text -> RecipientId -> SndPublicAuthKey -> M BrokerMsg
-        secureQueue_ name rId sKey = time name $ do
-          withLog $ \s -> logSecureQueue s rId sKey
-          st <- asks queueStore
-          stats <- asks serverStats
-          incStat $ qSecured stats
-          liftIO $ either ERR (const OK) <$> secureQueue st rId sKey
+        secureQueue_ :: StoreQueue s -> SndPublicAuthKey -> M BrokerMsg
+        secureQueue_ q sKey = do
+          liftIO (secureQueue ms q sKey) >>= \case
+            Left e -> pure $ ERR e
+            Right () -> do
+              stats <- asks serverStats
+              incStat $ qSecured stats
+              pure OK
 
-        addQueueNotifier_ :: QueueStore -> NtfPublicAuthKey -> RcvNtfPublicDhKey -> M (Transmission BrokerMsg)
-        addQueueNotifier_ st notifierKey dhKey = time "NKEY" $ do
+        addQueueNotifier_ :: StoreQueue s -> NtfPublicAuthKey -> RcvNtfPublicDhKey -> M (Transmission BrokerMsg)
+        addQueueNotifier_ q notifierKey dhKey = time "NKEY" $ do
           (rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
           let rcvNtfDhSecret = C.dh' dhKey privDhKey
           (corrId,entId,) <$> addNotifierRetry 3 rcvPublicDhKey rcvNtfDhSecret
@@ -1262,19 +1262,17 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
             addNotifierRetry n rcvPublicDhKey rcvNtfDhSecret = do
               notifierId <- randomId =<< asks (queueIdBytes . config)
               let ntfCreds = NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}
-              liftIO (addQueueNotifier st entId ntfCreds) >>= \case
+              liftIO (addQueueNotifier ms q ntfCreds) >>= \case
                 Left DUPLICATE_ -> addNotifierRetry (n - 1) rcvPublicDhKey rcvNtfDhSecret
                 Left e -> pure $ ERR e
                 Right nId_ -> do
-                  withLog $ \s -> logAddNotifier s entId ntfCreds
                   incStat . ntfCreated =<< asks serverStats
                   forM_ nId_ $ \nId -> atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
                   pure $ NID notifierId rcvPublicDhKey
 
-        deleteQueueNotifier_ :: QueueStore -> M (Transmission BrokerMsg)
-        deleteQueueNotifier_ st = do
-          withLog (`logDeleteNotifier` entId)
-          liftIO (deleteQueueNotifier st entId) >>= \case
+        deleteQueueNotifier_ :: StoreQueue s -> M (Transmission BrokerMsg)
+        deleteQueueNotifier_ q =
+          liftIO (deleteQueueNotifier ms q) >>= \case
             Right (Just nId) -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
               stats <- asks serverStats
@@ -1286,13 +1284,11 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
             Right Nothing -> pure ok
             Left e -> pure $ err e
 
-        suspendQueue_ :: QueueStore -> M (Transmission BrokerMsg)
-        suspendQueue_ st = do
-          withLog (`logSuspendQueue` entId)
-          okResp <$> liftIO (suspendQueue st entId)
+        suspendQueue_ :: (StoreQueue s, QueueRec) -> M (Transmission BrokerMsg)
+        suspendQueue_ (q, _) = liftIO $ either err (const ok) <$> suspendQueue ms q
 
-        subscribeQueue :: QueueRec -> RecipientId -> M (Transmission BrokerMsg)
-        subscribeQueue qr rId =
+        subscribeQueue :: StoreQueue s -> QueueRec -> M (Transmission BrokerMsg)
+        subscribeQueue q qr =
           atomically (TM.lookup rId subscriptions) >>= \case
             Nothing -> newSub >>= deliver True
             Just s@Sub {subThread} -> do
@@ -1306,6 +1302,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                   incStat $ qSubDuplicate stats
                   atomically (tryTakeTMVar $ delivered s) >> deliver False s
           where
+            rId = recipientId qr
             newSub :: M Sub
             newSub = time "SUB newSub" . atomically $ do
               writeTQueue subscribedQ (rId, clientId, True)
@@ -1314,17 +1311,15 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               pure sub
             deliver :: Bool -> Sub -> M (Transmission BrokerMsg)
             deliver inc sub = do
-              AMS _ ms <- asks msgStore
               stats <- asks serverStats
               fmap (either (\e -> (corrId, rId, ERR e)) id) $ liftIO $ runExceptT $ do
-                q <- getMsgQueue ms rId
-                msg_ <- tryPeekMsg q
+                msg_ <- tryPeekMsg ms rId q
                 liftIO $ when (inc && isJust msg_) $ incStat (qSub stats)
                 liftIO $ deliverMessage "SUB" qr rId sub msg_
 
         -- clients that use GET are not added to server subscribers
-        getMessage :: QueueRec -> M (Transmission BrokerMsg)
-        getMessage qr = time "GET" $ do
+        getMessage :: StoreQueue s -> QueueRec -> M (Transmission BrokerMsg)
+        getMessage q qr = time "GET" $ do
           atomically (TM.lookup entId subscriptions) >>= \case
             Nothing ->
               atomically newSub >>= (`getMessage_` Nothing)
@@ -1350,29 +1345,23 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               pure s
             getMessage_ :: Sub -> Maybe MsgId -> M (Transmission BrokerMsg)
             getMessage_ s delivered_ = do
-              AMS _ ms <- asks msgStore
               stats <- asks serverStats
-              fmap (either err id) $ liftIO $ runExceptT $ do
-                q <- getMsgQueue ms entId
-                tryPeekMsg q >>= \case
+              fmap (either err id) $ liftIO $ runExceptT $
+                tryPeekMsg ms (recipientId qr) q >>= \case
                   Just msg -> do
                     let encMsg = encryptMsg qr msg
                     incStat $ (if isJust delivered_ then msgGetDuplicate else msgGet) stats
                     atomically $ setDelivered s msg $> (corrId, entId, MSG encMsg)
                   Nothing -> incStat (msgGetNoMsg stats) $> ok
 
-        withQueue :: (QueueRec -> M (Transmission BrokerMsg)) -> M (Transmission BrokerMsg)
-        withQueue action = case qr_ of
-          Just qr -> updateQueueDate qr >> action qr
+        withQueue :: (StoreQueue s -> QueueRec -> M (Transmission BrokerMsg)) -> M (Transmission BrokerMsg)
+        withQueue action = case q_ of
           Nothing -> pure $ err INTERNAL
-
-        updateQueueDate :: QueueRec -> M ()
-        updateQueueDate QueueRec {updatedAt, recipientId = rId} = do
-          t <- liftIO getSystemDate
-          when (Just t /= updatedAt) $ do
-            withLog $ \s -> logUpdateQueueTime s rId t
-            st <- asks queueStore
-            liftIO $ updateQueueTime st rId t
+          Just (q, qr@QueueRec {updatedAt}) -> do
+            t <- liftIO getSystemDate
+            if updatedAt == Just t
+              then action q qr
+              else liftIO (updateQueueTime ms q t) >>= either (pure . err) (action q)
 
         subscribeNotifications :: M (Transmission BrokerMsg)
         subscribeNotifications = do
@@ -1389,24 +1378,22 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               writeTQueue ntfSubscribedQ (entId, clientId, True)
               TM.insert entId () ntfSubscriptions
 
-        acknowledgeMsg :: QueueRec -> MsgId -> M (Transmission BrokerMsg)
-        acknowledgeMsg qr msgId = time "ACK" $ do
+        acknowledgeMsg :: MsgId -> StoreQueue s -> QueueRec -> M (Transmission BrokerMsg)
+        acknowledgeMsg msgId q qr = time "ACK" $ do
           liftIO (TM.lookupIO entId subscriptions) >>= \case
             Nothing -> pure $ err NO_MSG
             Just sub ->
               atomically (getDelivered sub) >>= \case
                 Just st -> do
-                  AMS _ ms <- asks msgStore
                   stats <- asks serverStats
                   fmap (either err id) $ liftIO $ runExceptT $ do
-                    q <- getMsgQueue ms entId
                     case st of
                       ProhibitSub -> do
-                        deletedMsg_ <- tryDelMsg q msgId
+                        deletedMsg_ <- tryDelMsg ms (recipientId qr) q msgId
                         liftIO $ mapM_ (updateStats stats True) deletedMsg_
                         pure ok
                       _ -> do
-                        (deletedMsg_, msg_) <- tryDelPeekMsg q msgId
+                        (deletedMsg_, msg_) <- tryDelPeekMsg ms (recipientId qr) q msgId
                         liftIO $ mapM_ (updateStats stats False) deletedMsg_
                         liftIO $ deliverMessage "ACK" qr entId sub msg_
                 _ -> pure $ err NO_MSG
@@ -1436,8 +1423,8 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                   incStat $ msgRecvNtf stats
                   updatePeriodStats (activeQueuesNtf stats) entId
 
-        sendMessage :: QueueRec -> MsgFlags -> MsgBody -> M (Transmission BrokerMsg)
-        sendMessage qr msgFlags msgBody
+        sendMessage :: MsgFlags -> MsgBody -> StoreQueue s -> QueueRec -> M (Transmission BrokerMsg)
+        sendMessage msgFlags msgBody q qr
           | B.length msgBody > maxMessageLength thVersion = do
               stats <- asks serverStats
               incStat $ msgSentLarge stats
@@ -1452,14 +1439,12 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                   case C.maxLenBS msgBody of
                     Left _ -> pure $ err LARGE_MSG
                     Right body -> do
-                      AMS _ ms <- asks msgStore
                       ServerConfig {messageExpiration, msgIdBytes} <- asks config
                       msgId <- randomId' msgIdBytes
                       msg_ <- liftIO $ time "SEND" $ runExceptT $ do
-                        q <- getMsgQueue ms $ recipientId qr
-                        expireMessages q messageExpiration stats
+                        expireMessages messageExpiration stats
                         msg <- liftIO $ mkMessage msgId body
-                        writeMsg ms q True msg
+                        writeMsg ms (recipientId qr) q True msg
                       case msg_ of
                         Left e -> pure $ err e
                         Right Nothing -> do
@@ -1482,9 +1467,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
               msgTs <- getSystemTime
               pure $! Message msgId msgTs msgFlags body
 
-            expireMessages :: MsgStoreClass s => MsgQueue s -> Maybe ExpirationConfig -> ServerStats -> ExceptT ErrorType IO ()
-            expireMessages q msgExp stats = do
-              deleted <- maybe (pure 0) (deleteExpiredMsgs q True <=< liftIO . expireBeforeEpoch) msgExp
+            expireMessages :: Maybe ExpirationConfig -> ServerStats -> ExceptT ErrorType IO ()
+            expireMessages msgExp stats = do
+              deleted <- maybe (pure 0) (deleteExpiredMsgs (recipientId qr) q True <=< liftIO . expireBeforeEpoch) msgExp
               liftIO $ when (deleted > 0) $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
 
             -- The condition for delivery of the message is:
@@ -1509,7 +1494,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                   -- and delivery is cancelled -
                   -- the new client will receive message in response to SUB.
                   (TM.lookup rId subscribers >>= mapM readTVar)
-                    $>>= \rc@Client {subscriptions = subs, sndQ = q} -> TM.lookup rId subs
+                    $>>= \rc@(AClient _ Client {subscriptions = subs, sndQ = sndQ'}) -> TM.lookup rId subs
                     $>>= \s@Sub {subThread, delivered} -> case subThread of
                       ProhibitSub -> pure Nothing
                       ServerSub st -> readTVar st >>= \case
@@ -1518,15 +1503,15 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                             Just _ -> pure Nothing -- if a message was already delivered, should not deliver more
                             Nothing ->
                               ifM
-                                (isFullTBQueue q)
+                                (isFullTBQueue sndQ')
                                 (writeTVar st SubPending $> Just (rc, s, st))
-                                (deliver q s $> Nothing)
+                                (deliver sndQ' s $> Nothing)
                         _ -> pure Nothing
-                deliver q s = do
+                deliver sndQ' s = do
                   let encMsg = encryptMsg qr msg
-                  writeTBQueue q [(CorrId "", rId, MSG encMsg)]
+                  writeTBQueue sndQ' [(CorrId "", rId, MSG encMsg)]
                   void $ setDelivered s msg
-                forkDeliver (rc@Client {sndQ = q}, s@Sub {delivered}, st) = do
+                forkDeliver ((AClient _ rc@Client {sndQ = sndQ'}), s@Sub {delivered}, st) = do
                   t <- mkWeakThreadId =<< forkIO deliverThread
                   atomically $ modifyTVar' st $ \case
                     -- this case is needed because deliverThread can exit before it
@@ -1544,7 +1529,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                           Just _ -> pure () -- if a message was already delivered, should not deliver more
                           Nothing -> do
                             -- a separate thread is needed because it blocks when client sndQ is full.
-                            deliver q s
+                            deliver sndQ' s
                             writeTVar st NoSub
 
             enqueueNotification :: NtfCreds -> Message -> M ()
@@ -1601,12 +1586,12 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
           incStat $ pMsgFwdsRecv stats
           pure $ RRES r3
           where
-            rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
+            rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe (StoreQueue s, QueueRec), Transmission Cmd))
             rejectOrVerify clntThAuth (tAuth, authorized, (corrId', entId', cmdOrError)) =
               case cmdOrError of
                 Left e -> pure $ Left (corrId', entId', ERR e)
                 Right cmd'
-                  | allowed -> verified <$> verifyTransmission ((,C.cbNonce (bs corrId')) <$> clntThAuth) tAuth authorized entId' cmd'
+                  | allowed -> verified <$> verifyTransmission ms ((,C.cbNonce (bs corrId')) <$> clntThAuth) tAuth authorized entId' cmd'
                   | otherwise -> pure $ Left (corrId', entId', ERR $ CMD PROHIBITED)
                   where
                     allowed = case cmd' of
@@ -1614,7 +1599,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
                       Cmd SSender (SKEY _) -> True
                       _ -> False
                     verified = \case
-                      VRVerified qr -> Right (qr, (corrId', entId', cmd'))
+                      VRVerified q -> Right (q, (corrId', entId', cmd'))
                       VRFailed -> Left (corrId', entId', ERR AUTH)
         deliverMessage :: T.Text -> QueueRec -> RecipientId -> Sub -> Maybe Message -> IO (Transmission BrokerMsg)
         deliverMessage name qr rId s@Sub {subThread} msg_ = time (name <> " deliver") . atomically $
@@ -1644,37 +1629,33 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
         setDelivered :: Sub -> Message -> STM Bool
         setDelivered s msg = tryPutTMVar (delivered s) $! messageId msg
 
-        delQueueAndMsgs :: QueueStore -> M (Transmission BrokerMsg)
-        delQueueAndMsgs st = do
-          withLog (`logDeleteQueue` entId)
-          AMS _ ms <- asks msgStore
-          liftIO (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case
-            Right q -> do
+        delQueueAndMsgs :: (StoreQueue s, QueueRec) -> M (Transmission BrokerMsg)
+        delQueueAndMsgs (q, _) = do
+          liftIO (deleteQueue ms entId q) >>= \case
+            Right qr -> do
               -- Possibly, the same should be done if the queue is suspended, but currently we do not use it
               atomically $ do
                 writeTQueue subscribedQ (entId, clientId, False)
                 -- queue is usually deleted by the same client that is currently subscribed,
                 -- we delete subscription here, so the client with no subscriptions can be disconnected.
                 TM.delete entId subscriptions
-              forM_ (notifierId <$> notifier q) $ \nId -> do
+              forM_ (notifierId <$> notifier qr) $ \nId -> do
                 -- queue is deleted by a different client from the one subscribed to notifications,
                 -- so we don't need to remove subscription from the current client.
                 stats <- asks serverStats
                 deleted <- asks ntfStore >>= liftIO . (`deleteNtfs` nId)
                 when (deleted > 0) $ liftIO $ atomicModifyIORef'_ (ntfCount stats) (subtract deleted)
                 atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
-              updateDeletedStats q
+              updateDeletedStats qr
               pure ok
             Left e -> pure $ err e
 
-        getQueueInfo :: QueueRec -> M BrokerMsg
-        getQueueInfo QueueRec {senderKey, notifier} = do
-          AMS _ ms <- asks msgStore
+        getQueueInfo :: StoreQueue s -> QueueRec -> M BrokerMsg
+        getQueueInfo q QueueRec {recipientId = rId, senderKey, notifier} = do
           fmap (either ERR id) $ liftIO $ runExceptT $ do
-            q <- getMsgQueue ms entId
             qiSub <- liftIO $ TM.lookupIO entId subscriptions >>= mapM mkQSub
-            qiSize <- liftIO $ getQueueSize q
-            qiMsg <- toMsgInfo <$$> tryPeekMsg q
+            qiSize <- getQueueSize ms rId q
+            qiMsg <- toMsgInfo <$$> tryPeekMsg ms rId q
             let info = QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
             pure $ INFO info
           where
@@ -1696,9 +1677,6 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
         err :: ErrorType -> Transmission BrokerMsg
         err e = (corrId, entId, ERR e)
 
-        okResp :: Either ErrorType () -> Transmission BrokerMsg
-        okResp = either err $ const ok
-
 updateDeletedStats :: QueueRec -> M ()
 updateDeletedStats q = do
   stats <- asks serverStats
@@ -1711,11 +1689,6 @@ incStat :: MonadIO m => IORef Int -> m ()
 incStat r = liftIO $ atomicModifyIORef'_ r (+ 1)
 {-# INLINE incStat #-}
 
-withLog :: (StoreLog 'WriteMode -> IO a) -> M ()
-withLog action = do
-  env <- ask
-  liftIO . mapM_ action $ storeLog (env :: Env)
-
 timed :: MonadIO m => T.Text -> RecipientId -> m a -> m a
 timed name (EntityId qId) a = do
   t <- liftIO getSystemTime
@@ -1735,15 +1708,12 @@ randomId :: Int -> M EntityId
 randomId = fmap EntityId . randomId'
 {-# INLINE randomId #-}
 
-saveServerMessages :: Bool -> M ()
-saveServerMessages drainMsgs =
-  asks msgStore >>= \case
-    AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-      Just f -> liftIO $ exportMessages False ms f drainMsgs
-      Nothing -> logInfo "undelivered messages are not saved"
-    AMS SMSJournal ms -> do
-      liftIO $ closeMsgStore ms
-      logInfo "closed journal message storage"
+saveServerMessages :: Bool -> AMsgStore -> IO ()
+saveServerMessages drainMsgs = \case
+  AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
+    Just f -> exportMessages False ms f drainMsgs
+    Nothing -> logInfo "undelivered messages are not saved"
+  AMS SMSJournal _ -> logInfo "closed journal message storage"
 
 exportMessages :: MsgStoreClass s => Bool -> s -> FilePath -> Bool -> IO ()
 exportMessages tty ms f drainMsgs = do
@@ -1755,7 +1725,12 @@ exportMessages tty ms f drainMsgs = do
         logError $ "error exporting messages: " <> tshow e
         exitFailure
   where
-    saveQueueMsgs h rId q = getQueueMessages drainMsgs q >>= \msgs -> Sum (length msgs) <$ BLD.hPutBuilder h (encodeMessages rId msgs)
+    saveQueueMsgs h rId q =
+      runExceptT (getQueueMessages drainMsgs ms rId q) >>= \case
+        Right msgs -> Sum (length msgs) <$ BLD.hPutBuilder h (encodeMessages rId msgs)
+        Left e -> do
+          logError $ "STORE: saveQueueMsgs, error exporting messages from queue " <> decodeLatin1 (strEncode rId) <> ", " <> tshow e
+          exitFailure
     encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
 
 processServerMessages :: M MessageStats
@@ -1769,33 +1744,40 @@ processServerMessages = do
         AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
           Just f -> ifM (doesFileExist f) (importMessages False ms f old_) (pure newMessageStats)
           Nothing -> pure newMessageStats
-        AMS SMSJournal ms | expire -> case old_ of
-          Just old -> do
-            logInfo "expiring journal store messages..."
-            withAllMsgQueues False ms $ \_ -> processExpireQueue old
-          Nothing -> do
-            logInfo "validating journal store messages..."
-            withAllMsgQueues False ms $ \_ -> processValidateQueue
-        AMS SMSJournal _ -> logWarn "skipping message expiration" $> newMessageStats
-        where
-          processExpireQueue old q =
-            runExceptT expireQueue >>= \case
-              Right (storedMsgsCount, expiredMsgsCount) ->
-                pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = 1}
-              Left e -> do
-                logError $ "failed expiring messages in queue " <> T.pack (queueDirectory $ queue q) <> ": " <> tshow e
-                exitFailure
-            where
-              expireQueue = do
-                expired'' <- deleteExpiredMsgs q False old
-                stored'' <- liftIO $ getQueueSize q
-                liftIO $ logQueueState q
-                liftIO $ closeMsgQueueHandles q
-                pure (stored'', expired'')
-          processValidateQueue q =
-            getQueueSize q >>= \storedMsgsCount -> pure mempty {storedMsgsCount, storedQueues = 1}
+        AMS SMSJournal ms
+          | expire -> case old_ of
+              Just old -> do
+                logInfo "expiring journal store messages..."
+                withAllMsgQueues False ms $ processExpireQueue old
+              Nothing -> do
+                logInfo "validating journal store messages..."
+                withAllMsgQueues False ms $ processValidateQueue
+          | otherwise -> logWarn "skipping message expiration" $> newMessageStats
+          where
+            processExpireQueue old rId q =
+              runExceptT expireQueue >>= \case
+                Right (storedMsgsCount, expiredMsgsCount) ->
+                  pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = 1}
+                Left e -> do
+                  logError $ "STORE: processExpireQueue, failed expiring messages in queue, " <> tshow e
+                  exitFailure
+              where
+                expireQueue = do
+                  expired'' <- deleteExpiredMsgs rId q False old
+                  stored'' <- getQueueSize ms rId q
+                  liftIO $ logQueueState q
+                  liftIO $ closeMsgQueue q
+                  pure (stored'', expired'')
+            processValidateQueue :: RecipientId -> JournalQueue -> IO MessageStats
+            processValidateQueue rId q =
+              runExceptT (getQueueSize ms rId q) >>= \case
+                Right storedMsgsCount -> pure newMessageStats {storedMsgsCount, storedQueues = 1}
+                Left e -> do
+                  logError $ "STORE: processValidateQueue, failed opening message queue, " <> tshow e
+                  exitFailure
 
-importMessages :: forall s. MsgStoreClass s => Bool -> s -> FilePath -> Maybe Int64 -> IO MessageStats
+-- TODO this function should be called after importing queues from store log
+importMessages :: forall s. STMQueueStore s => Bool -> s -> FilePath -> Maybe Int64 -> IO MessageStats
 importMessages tty ms f old_ = do
   logInfo $ "restoring messages from file " <> T.pack f
   LB.readFile f >>= runExceptT . foldM restoreMsg (0, Nothing, (0, 0, M.empty)) . LB.lines >>= \case
@@ -1812,7 +1794,7 @@ importMessages tty ms f old_ = do
       pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues}
   where
     progress i = "Processed " <> show i <> " lines"
-    restoreMsg :: (Int, Maybe (RecipientId, MsgQueue s), (Int, Int, M.Map RecipientId (MsgQueue s))) -> LB.ByteString -> ExceptT String IO (Int, Maybe (RecipientId, MsgQueue s), (Int, Int, M.Map RecipientId (MsgQueue s)))
+    restoreMsg :: (Int, Maybe (RecipientId, StoreQueue s), (Int, Int, M.Map RecipientId (StoreQueue s))) -> LB.ByteString -> ExceptT String IO (Int, Maybe (RecipientId, StoreQueue s), (Int, Int, M.Map RecipientId (StoreQueue s)))
     restoreMsg (!i, q_, (!stored, !expired, !overQuota)) s' = do
       when (tty && i `mod` 1000 == 0) $ liftIO $ putStr (progress i <> "\r") >> hFlush stdout
       MLRv3 rId msg <- liftEither . first (msgErr "parsing") $ strDecode s
@@ -1823,11 +1805,11 @@ importMessages tty ms f old_ = do
           q <- case q_ of
             -- to avoid lookup when restoring the next message to the same queue
             Just (rId', q') | rId' == rId -> pure q'
-            _ -> getMsgQueue ms rId
+            _ -> ExceptT $ getQueue ms SRecipient rId
           (i + 1,Just (rId, q),) <$> case msg of
             Message {msgTs}
               | maybe True (systemSeconds msgTs >=) old_ -> do
-                  writeMsg ms q False msg >>= \case
+                  writeMsg ms rId q False msg >>= \case
                     Just _ -> pure (stored + 1, expired, overQuota)
                     Nothing -> do
                       logError $ decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
@@ -1836,12 +1818,12 @@ importMessages tty ms f old_ = do
             MessageQuota {} ->
               -- queue was over quota at some point,
               -- it will be set as over quota once fully imported
-              mergeQuotaMsgs >> writeMsg ms q False msg $> (stored, expired, M.insert rId q overQuota)
+              mergeQuotaMsgs >> writeMsg ms rId q False msg $> (stored, expired, M.insert rId q overQuota)
               where
                 -- if the first message in queue head is "quota", remove it.
-                mergeQuotaMsgs = isolateQueue q "mergeQuotaMsgs" $
-                  tryPeekMsg_ q >>= \case
-                    Just MessageQuota {} -> tryDeleteMsg_ q False
+                mergeQuotaMsgs = withMsgQueue ms rId q "mergeQuotaMsgs" $ \mq ->
+                  tryPeekMsg_ mq >>= \case
+                    Just MessageQuota {} -> tryDeleteMsg_ mq False
                     _ -> pure ()
         msgErr :: Show e => String -> e -> String
         msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
@@ -1916,7 +1898,8 @@ restoreServerStats msgStats ntfStats = asks (serverStatsBackupFile . config) >>=
       liftIO (strDecode <$> B.readFile f) >>= \case
         Right d@ServerStatsData {_qCount = statsQCount, _msgCount = statsMsgCount, _ntfCount = statsNtfCount} -> do
           s <- asks serverStats
-          _qCount <- fmap M.size . readTVarIO . queues =<< asks queueStore
+          AMS _ st <- asks msgStore
+          _qCount <- M.size <$> readTVarIO (activeMsgQueues st)
           let _msgCount = storedMsgsCount msgStats
               _ntfCount = storedMsgsCount ntfStats
           liftIO $ setServerStats s d {_qCount, _msgCount, _ntfCount, _msgExpired = _msgExpired d + expiredMsgsCount msgStats, _msgNtfExpired = _msgNtfExpired d + expiredMsgsCount ntfStats}
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index c46519d90..5e60757c1 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -43,7 +43,7 @@ import Simplex.Messaging.Server.MsgStore.Journal
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.NtfStore
-import Simplex.Messaging.Server.QueueStore (QueueRec (..))
+import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.Server.StoreLog
@@ -165,17 +165,15 @@ data Env = Env
     serverInfo :: ServerInformation,
     server :: Server,
     serverIdentity :: KeyHash,
-    queueStore :: QueueStore,
     msgStore :: AMsgStore,
     ntfStore :: NtfStore,
     random :: TVar ChaChaDRG,
-    storeLog :: Maybe (StoreLog 'WriteMode),
     tlsServerCreds :: T.Credential,
     httpServerCreds :: Maybe T.Credential,
     serverStats :: ServerStats,
     sockets :: TVar [(ServiceName, SocketState)],
     clientSeq :: TVar ClientId,
-    clients :: TVar (IntMap (Maybe Client)),
+    clients :: TVar (IntMap (Maybe AClient)),
     proxyAgent :: ProxyAgent -- senders served on this proxy
   }
 
@@ -183,9 +181,9 @@ type family MsgStore s where
   MsgStore 'MSMemory = STMMsgStore
   MsgStore 'MSJournal = JournalMsgStore
 
-data AMsgStore = forall s. MsgStoreClass (MsgStore s) => AMS (SMSType s) (MsgStore s)
+data AMsgStore = forall s. (STMQueueStore (MsgStore s), MsgStoreClass (MsgStore s)) => AMS (SMSType s) (MsgStore s)
 
-data AMsgQueue = forall s. MsgStoreClass (MsgStore s) => AMQ (SMSType s) (MsgQueue (MsgStore s))
+data AStoreQueue = forall s. MsgStoreClass (MsgStore s) => ASQ (SMSType s) (StoreQueue (MsgStore s))
 
 data AMsgStoreCfg = forall s. MsgStoreClass (MsgStore s) => AMSC (SMSType s) (MsgStoreConfig (MsgStore s))
 
@@ -197,11 +195,11 @@ type Subscribed = Bool
 
 data Server = Server
   { subscribedQ :: TQueue (RecipientId, ClientId, Subscribed),
-    subscribers :: TMap RecipientId (TVar Client),
+    subscribers :: TMap RecipientId (TVar AClient),
     ntfSubscribedQ :: TQueue (NotifierId, ClientId, Subscribed),
-    notifiers :: TMap NotifierId (TVar Client),
-    subClients :: TVar (IntMap Client), -- clients with SMP subscriptions
-    ntfSubClients :: TVar (IntMap Client), -- clients with Ntf subscriptions
+    notifiers :: TMap NotifierId (TVar AClient),
+    subClients :: TVar (IntMap AClient), -- clients with SMP subscriptions
+    ntfSubClients :: TVar (IntMap AClient), -- clients with Ntf subscriptions
     pendingSubEvents :: TVar (IntMap (NonEmpty (RecipientId, Subscribed))),
     pendingNtfSubEvents :: TVar (IntMap (NonEmpty (NotifierId, Subscribed))),
     savingLock :: Lock
@@ -213,11 +211,16 @@ newtype ProxyAgent = ProxyAgent
 
 type ClientId = Int
 
-data Client = Client
+data AClient = forall s. MsgStoreClass (MsgStore s) => AClient (SMSType s) (Client (MsgStore s))
+
+clientId' :: AClient -> ClientId
+clientId' (AClient _ Client {clientId}) = clientId
+
+data Client s = Client
   { clientId :: ClientId,
     subscriptions :: TMap RecipientId Sub,
     ntfSubscriptions :: TMap NotifierId (),
-    rcvQ :: TBQueue (NonEmpty (Maybe QueueRec, Transmission Cmd)),
+    rcvQ :: TBQueue (NonEmpty (Maybe (StoreQueue s, QueueRec), Transmission Cmd)),
     sndQ :: TBQueue (NonEmpty (Transmission BrokerMsg)),
     msgQ :: TBQueue (NonEmpty (Transmission BrokerMsg)),
     procThreads :: TVar Int,
@@ -253,8 +256,8 @@ newServer = do
   savingLock <- createLockIO
   return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, subClients, ntfSubClients, pendingSubEvents, pendingNtfSubEvents, savingLock}
 
-newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
-newClient clientId qSize thVersion sessionId createdAt = do
+newClient :: SMSType s -> ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO (Client (MsgStore s))
+newClient _msType clientId qSize thVersion sessionId createdAt = do
   subscriptions <- TM.emptyIO
   ntfSubscriptions <- TM.emptyIO
   rcvQ <- newTBQueueIO qSize
@@ -283,8 +286,7 @@ newEnv :: ServerConfig -> IO Env
 newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, msgStoreType, storeMsgsFile, smpAgentCfg, information, messageExpiration, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines} = do
   serverActive <- newTVarIO True
   server <- newServer
-  queueStore <- newQueueStore
-  msgStore <- case msgStoreType of
+  msgStore@(AMS _ store) <- case msgStoreType of
     AMSType SMSMemory -> AMS SMSMemory <$> newMsgStore STMStoreConfig {storePath = storeMsgsFile, quota = msgQueueQuota}
     AMSType SMSJournal -> case storeMsgsFile of
       Just storePath -> 
@@ -293,10 +295,10 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, msgSt
       Nothing -> putStrLn "Error: journal msg store require path in [STORE_LOG], restore_messages" >> exitFailure
   ntfStore <- NtfStore <$> TM.emptyIO
   random <- C.newRandom
-  storeLog <-
-    forM storeLogFile $ \f -> do
-      logInfo $ "restoring queues from file " <> T.pack f
-      readWriteQueueStore f queueStore
+  forM_ storeLogFile $ \f -> do
+    logInfo $ "restoring queues from file " <> T.pack f
+    sl <- readWriteQueueStore f store
+    setStoreLog store sl
   tlsServerCreds <- getCredentials "SMP" smpCredentials
   httpServerCreds <- mapM (getCredentials "HTTPS") httpCredentials
   mapM_ checkHTTPSCredentials httpServerCreds
@@ -307,7 +309,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, msgSt
   clientSeq <- newTVarIO 0
   clients <- newTVarIO mempty
   proxyAgent <- newSMPProxyAgent smpAgentCfg random
-  pure Env {serverActive, config, serverInfo, server, serverIdentity, queueStore, msgStore, ntfStore, random, storeLog, tlsServerCreds, httpServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
+  pure Env {serverActive, config, serverInfo, server, serverIdentity, msgStore, ntfStore, random, tlsServerCreds, httpServerCreds, serverStats, sockets, clientSeq, clients, proxyAgent}
   where
     getCredentials protocol creds = do
       files <- missingCreds
@@ -351,3 +353,6 @@ newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO ProxyAgent
 newSMPProxyAgent smpAgentCfg random = do
   smpAgent <- newSMPClientAgent smpAgentCfg random
   pure ProxyAgent {smpAgent}
+
+readWriteQueueStore :: STMQueueStore s => FilePath -> s -> IO (StoreLog 'WriteMode)
+readWriteQueueStore = readWriteStoreLog readQueueStore writeQueueStore
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 0251b6705..79709d3eb 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -46,10 +46,11 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.MsgStore.Journal (JournalStoreConfig (..))
 import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..), newMsgStore)
+import Simplex.Messaging.Server.QueueStore.STM (readQueueStore)
 import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedServerSMPRelayVRange)
 import Simplex.Messaging.Transport.Client (SocksProxy, TransportHost (..), defaultSocksProxy)
 import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
-import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow)
+import Simplex.Messaging.Util (eitherToMaybe, ifM, safeDecodeUtf8, tshow)
 import Simplex.Messaging.Version (mkVersionRange)
 import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
 import System.Exit (exitFailure)
@@ -85,6 +86,14 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
     Journal cmd -> withIniFile $ \ini -> do
       msgsDirExists <- doesDirectoryExist storeMsgsJournalDir
       msgsFileExists <- doesFileExist storeMsgsFilePath
+      let enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
+      storeLogFile <- case enableStoreLog $> storeLogFilePath of
+        Just storeLogFile -> do
+          ifM
+            (doesFileExist storeLogFile)
+            (pure storeLogFile)
+            (putStrLn ("Store log file " <> storeLogFile <> " not found") >> exitFailure)
+        Nothing -> putStrLn "Store log disabled, see `[STORE_LOG] enable`" >> exitFailure
       case cmd of
         JCImport
           | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
@@ -99,6 +108,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 ("WARNING: message log file " <> storeMsgsFilePath <> " will be imported to journal directory " <> storeMsgsJournalDir)
                 "Messages not imported"
               ms <- newJournalMsgStore
+              readQueueStore storeLogFile ms
               msgStats <- importMessages True ms storeMsgsFilePath Nothing -- no expiration
               putStrLn "Import completed"
               printMessageStats "Messages" msgStats
@@ -116,6 +126,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                 ("WARNING: journal directory " <> storeMsgsJournalDir <> " will be exported to message log file " <> storeMsgsFilePath)
                 "Journal not exported"
               ms <- newJournalMsgStore
+              readQueueStore storeLogFile ms
               exportMessages True ms storeMsgsFilePath False
               putStrLn "Export completed"
               putStrLn $ case readMsgStoreType ini of
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index 44297bf37..0310a5991 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -11,11 +11,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Simplex.Messaging.Server.MsgStore.Journal
-  ( JournalMsgStore (msgQueues, random),
-    JournalMsgQueue (queue),
+  ( JournalMsgStore (queues, senders, notifiers, random),
+    JournalQueue,
+    JournalMsgQueue (queue, state),
     JMQueue (queueDirectory, statePath),
     JournalStoreConfig (..),
     getQueueMessages,
@@ -32,6 +34,7 @@ module Simplex.Messaging.Server.MsgStore.Journal
     newJournalId,
     appendState,
     queueLogFileName,
+    journalFilePath,
     logFileExt,
   )
 where
@@ -42,13 +45,11 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Trans.Except
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.Bitraversable (bimapM)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (intercalate)
-import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
@@ -57,11 +58,14 @@ import GHC.IO (catchAny)
 import Simplex.Messaging.Agent.Client (getMapLock, withLockMap)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (ErrorType (..), Message (..), RecipientId)
+import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.MsgStore.Types
+import Simplex.Messaging.Server.QueueStore
+import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (ifM, tshow, ($>>=))
+import Simplex.Messaging.Server.StoreLog
+import Simplex.Messaging.Util (ifM, tshow, ($>>=), (<$$>))
 import System.Directory
 import System.Exit
 import System.FilePath ((</>))
@@ -73,7 +77,10 @@ data JournalMsgStore = JournalMsgStore
   { config :: JournalStoreConfig,
     random :: TVar StdGen,
     queueLocks :: TMap RecipientId Lock,
-    msgQueues :: TMap RecipientId JournalMsgQueue
+    queues :: TMap RecipientId JournalQueue,
+    senders :: TMap SenderId RecipientId,
+    notifiers :: TMap NotifierId RecipientId,
+    storeLog :: TVar (Maybe (StoreLog 'WriteMode))
   }
 
 data JournalStoreConfig = JournalStoreConfig
@@ -88,9 +95,16 @@ data JournalStoreConfig = JournalStoreConfig
     stateTailSize :: Int
   }
 
+data JournalQueue = JournalQueue
+  { queueLock :: Lock,
+    -- To avoid race conditions and errors when restoring queues,
+    -- Nothing is written to TVar when queue is deleted.
+    queueRec :: TVar (Maybe QueueRec),
+    msgQueue_ :: TVar (Maybe JournalMsgQueue)
+  }
+
 data JMQueue = JMQueue
   { queueDirectory :: FilePath,
-    queueLock :: Lock,
     statePath :: FilePath
   }
 
@@ -198,8 +212,21 @@ logFileExt = ".log"
 newtype StoreIO a = StoreIO {unStoreIO :: IO a}
   deriving newtype (Functor, Applicative, Monad)
 
+instance STMQueueStore JournalMsgStore where
+  queues' = queues
+  senders' = senders
+  notifiers' = notifiers
+  storeLog' = storeLog
+  mkQueue st qr = do
+    lock <- getMapLock (queueLocks st) $ recipientId qr
+    q <- newTVar $! Just qr
+    mq <- newTVar Nothing
+    pure $ JournalQueue lock q mq
+  msgQueue_' = msgQueue_
+
 instance MsgStoreClass JournalMsgStore where
   type StoreMonad JournalMsgStore = StoreIO
+  type StoreQueue JournalMsgStore = JournalQueue
   type MsgQueue JournalMsgStore = JournalMsgQueue
   type MsgStoreConfig JournalMsgStore = JournalStoreConfig
 
@@ -207,39 +234,51 @@ instance MsgStoreClass JournalMsgStore where
   newMsgStore config = do
     random <- newTVarIO =<< newStdGen
     queueLocks <- TM.emptyIO
-    msgQueues <- TM.emptyIO
-    pure JournalMsgStore {config, random, queueLocks, msgQueues}
+    queues <- TM.emptyIO
+    senders <- TM.emptyIO
+    notifiers <- TM.emptyIO
+    storeLog <- newTVarIO Nothing
+    pure JournalMsgStore {config, random, queueLocks, queues, senders, notifiers, storeLog}
 
-  closeMsgStore st = atomically (swapTVar (msgQueues st) M.empty) >>= mapM_ closeMsgQueueHandles
+  setStoreLog :: JournalMsgStore -> StoreLog 'WriteMode -> IO ()
+  setStoreLog st sl = atomically $ writeTVar (storeLog st) (Just sl)
 
-  activeMsgQueues = msgQueues
+  closeMsgStore st = do
+    readTVarIO (storeLog st) >>= mapM_ closeStoreLog
+    readTVarIO (queues st) >>= mapM_ closeMsgQueue
+
+  activeMsgQueues = queues
   {-# INLINE activeMsgQueues #-}
 
   -- This function is a "foldr" that opens and closes all queues, processes them as defined by action and accumulates the result.
   -- It is used to export storage to a single file and also to expire messages and validate all queues when server is started.
   -- TODO this function requires case-sensitive file system, because it uses queue directory as recipient ID.
   -- It can be made to support case-insensite FS by supporting more than one queue per directory, by getting recipient ID from state file name.
-  withAllMsgQueues :: forall a. Monoid a => Bool -> JournalMsgStore -> (RecipientId -> JournalMsgQueue -> IO a) -> IO a
+  withAllMsgQueues :: forall a. Monoid a => Bool -> JournalMsgStore -> (RecipientId -> JournalQueue -> IO a) -> IO a
   withAllMsgQueues tty ms@JournalMsgStore {config} action = ifM (doesDirectoryExist storePath) processStore (pure mempty)
     where
       processStore = do
-        closeMsgStore ms
-        lock <- createLockIO -- the same lock is used for all queues
-        (!count, !res) <- foldQueues 0 (processQueue lock) (0, mempty) ("", storePath)
+        (!count, !res) <- foldQueues 0 processQueue (0, mempty) ("", storePath)
         putStrLn $ progress count
         pure res
       JournalStoreConfig {storePath, pathParts} = config
-      processQueue :: Lock -> (Int, a) -> (String, FilePath) -> IO (Int, a)
-      processQueue queueLock (!i, !r) (queueId, dir) = do
+      processQueue :: (Int, a) -> (String, FilePath) -> IO (Int, a)
+      processQueue (!i, !r) (queueId, dir) = do
         when (tty && i `mod` 100 == 0) $ putStr (progress i <> "\r") >> IO.hFlush stdout
-        let statePath = msgQueueStatePath dir queueId
-        q <- openMsgQueue ms JMQueue {queueDirectory = dir, queueLock, statePath}
         r' <- case strDecode $ B.pack queueId of
-          Right rId -> action rId q
+          Right rId ->
+            getQueue ms SRecipient rId >>= \case
+              Right q -> unStoreIO (getMsgQueue ms rId q) *> action rId q <* closeMsgQueue q
+              Left AUTH -> do
+                logWarn $ "STORE: processQueue, queue " <> T.pack queueId <> " was removed, removing " <> T.pack dir
+                removeQueueDirectory_ dir
+                pure mempty
+              Left e -> do
+                logError $ "STORE: processQueue, error getting queue " <> T.pack queueId <> ", " <> tshow e
+                exitFailure
           Left e -> do
-            putStrLn ("Error: message queue directory " <> dir <> " is invalid: " <> e)
+            logError $ "STORE: processQueue, message queue directory " <> T.pack dir <> " is invalid, " <> tshow e
             exitFailure
-        closeMsgQueueHandles q
         pure (i + 1, r <> r')
       progress i = "Processed: " <> show i <> " queues"
       foldQueues depth f acc (queueId, path) = do
@@ -258,23 +297,26 @@ instance MsgStoreClass JournalMsgStore where
   logQueueStates :: JournalMsgStore -> IO ()
   logQueueStates ms = withActiveMsgQueues ms $ \_ -> logQueueState
 
-  logQueueState :: JournalMsgQueue -> IO ()
-  logQueueState q = 
-    readTVarIO (handles q)
-      >>= maybe (pure ()) (\hs -> readTVarIO (state q) >>= appendState (stateHandle hs))
+  logQueueState :: JournalQueue -> IO ()
+  logQueueState q =
+    void $
+      readTVarIO (msgQueue_ q)
+        $>>= \mq -> readTVarIO (handles mq)
+        $>>= (\hs -> (readTVarIO (state mq) >>= appendState (stateHandle hs)) $> Just ())
 
-  getMsgQueue :: JournalMsgStore -> RecipientId -> ExceptT ErrorType IO JournalMsgQueue
-  getMsgQueue ms@JournalMsgStore {queueLocks, msgQueues, random} rId =
-    tryStore "getMsgQueue" (B.unpack $ strEncode rId) $ withLockMap queueLocks rId "getMsgQueue" $
-      TM.lookupIO rId msgQueues >>= maybe newQ pure
+  queueRec' = queueRec
+  {-# INLINE queueRec' #-}
+
+  getMsgQueue :: JournalMsgStore -> RecipientId -> JournalQueue -> StoreIO JournalMsgQueue
+  getMsgQueue ms@JournalMsgStore {random} rId JournalQueue {msgQueue_} =
+    StoreIO $ readTVarIO msgQueue_ >>= maybe newQ pure
     where
       newQ = do
-        queueLock <- atomically $ getMapLock queueLocks rId
         let dir = msgQueueDirectory ms rId
             statePath = msgQueueStatePath dir $ B.unpack (strEncode rId)
-            queue = JMQueue {queueDirectory = dir, queueLock, statePath}
+            queue = JMQueue {queueDirectory = dir, statePath}
         q <- ifM (doesDirectoryExist dir) (openMsgQueue ms queue) (createQ queue)
-        atomically $ TM.insert rId q msgQueues
+        atomically $ writeTVar msgQueue_ $! Just q
         pure q
         where
           createQ :: JMQueue -> IO JournalMsgQueue
@@ -282,23 +324,25 @@ instance MsgStoreClass JournalMsgStore where
             -- folder and files are not created here,
             -- to avoid file IO for queues without messages during subscription
             journalId <- newJournalId random
-            mkJournalQueue queue (newMsgQueueState journalId, Nothing)
+            mkJournalQueue queue (newMsgQueueState journalId) Nothing
 
-  delMsgQueue :: JournalMsgStore -> RecipientId -> IO ()
-  delMsgQueue ms rId = withLockMap (queueLocks ms) rId "delMsgQueue" $ do
-    closeMsgQueue ms rId
-    removeQueueDirectory ms rId
+  openedMsgQueue :: JournalQueue -> StoreIO (Maybe JournalMsgQueue)
+  openedMsgQueue = StoreIO . readTVarIO . msgQueue_
+  {-# INLINE openedMsgQueue #-}
 
-  delMsgQueueSize :: JournalMsgStore -> RecipientId -> IO Int
-  delMsgQueueSize ms rId = withLockMap (queueLocks ms) rId "delMsgQueue" $ do
-    st_ <-
-      atomically (TM.lookupDelete rId (msgQueues ms))
-        >>= mapM (\q -> closeMsgQueueHandles q >> readTVarIO (state q))
-    removeQueueDirectory ms rId
-    pure $ maybe (-1) size st_
+  deleteQueue :: JournalMsgStore -> RecipientId -> JournalQueue -> IO (Either ErrorType QueueRec)
+  deleteQueue ms rId q =
+    fst <$$> deleteQueue_ ms rId q
 
-  getQueueMessages :: Bool -> JournalMsgQueue -> IO [Message]
-  getQueueMessages drainMsgs q = run []
+  deleteQueueSize :: JournalMsgStore -> RecipientId -> JournalQueue -> IO (Either ErrorType (QueueRec, Int))
+  deleteQueueSize ms rId q =
+    deleteQueue_ ms rId q >>= mapM (traverse getSize)
+    -- traverse operates on the second tuple element
+    where
+      getSize = maybe (pure (-1)) (fmap size . readTVarIO . state)
+
+  getQueueMessages_ :: Bool -> JournalMsgQueue -> StoreIO [Message]
+  getQueueMessages_ drainMsgs q = StoreIO (run [])
     where
       run msgs = readTVarIO (handles q) >>= maybe (pure []) (getMsg msgs)
       getMsg msgs hs = chooseReadJournal q drainMsgs hs >>= maybe (pure msgs) readMsg
@@ -308,22 +352,23 @@ instance MsgStoreClass JournalMsgStore where
             updateReadPos q drainMsgs len hs
             (msg :) <$> run msgs
 
-  writeMsg :: JournalMsgStore -> JournalMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  writeMsg ms q@JournalMsgQueue {queue = JMQueue {queueDirectory, statePath}, handles} logState msg =
-    isolateQueue q "writeMsg" $ StoreIO $ do
+  writeMsg :: JournalMsgStore -> RecipientId -> JournalQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  writeMsg ms rId q' logState msg = isolateQueue rId q' "writeMsg" $ do
+    q <- getMsgQueue ms rId q'
+    StoreIO $ do
       st@MsgQueueState {canWrite, size} <- readTVarIO (state q)
       let empty = size == 0
       if canWrite || empty
         then do
           let canWrt' = quota > size
           if canWrt'
-            then writeToJournal st canWrt' msg $> Just (msg, empty)
-            else writeToJournal st canWrt' msgQuota $> Nothing
+            then writeToJournal q st canWrt' msg $> Just (msg, empty)
+            else writeToJournal q st canWrt' msgQuota $> Nothing
         else pure Nothing
     where
       JournalStoreConfig {quota, maxMsgCount} = config ms
-      msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
-      writeToJournal st@MsgQueueState {writeState, readState = rs, size} canWrt' !msg' = do
+      msgQuota = MessageQuota {msgId = messageId msg, msgTs = messageTs msg}
+      writeToJournal q st@MsgQueueState {writeState, readState = rs, size} canWrt' !msg' = do
         let msgStr = strEncode msg' `B.snoc` '\n'
             msgLen = fromIntegral $ B.length msgStr
         hs <- maybe createQueueDir pure =<< readTVarIO handles
@@ -339,6 +384,7 @@ instance MsgStoreClass JournalMsgStore where
         updateQueueState q logState hs st' $
           when (size == 0) $ writeTVar (tipMsg q) $ Just (Just (msg, msgLen))
         where
+          JournalMsgQueue {queue = JMQueue {queueDirectory, statePath}, handles} = q
           createQueueDir = do
             createDirectoryIfMissing True queueDirectory
             sh <- openFile statePath AppendMode
@@ -354,11 +400,13 @@ instance MsgStoreClass JournalMsgStore where
             pure (newJournalState journalId, wh)
 
   -- can ONLY be used while restoring messages, not while server running
-  setOverQuota_ :: JournalMsgQueue -> IO ()
-  setOverQuota_ JournalMsgQueue {state} = atomically $ modifyTVar' state $ \st -> st {canWrite = False}
+  setOverQuota_ :: JournalQueue -> IO ()
+  setOverQuota_ q =
+    readTVarIO (msgQueue_ q)
+      >>= mapM_ (\JournalMsgQueue {state} -> atomically $ modifyTVar' state $ \st -> st {canWrite = False})
 
-  getQueueSize :: JournalMsgQueue -> IO Int
-  getQueueSize JournalMsgQueue {state} = size <$> readTVarIO state
+  getQueueSize_ :: JournalMsgQueue -> StoreIO Int
+  getQueueSize_ JournalMsgQueue {state} = StoreIO $ size <$> readTVarIO state
 
   tryPeekMsg_ :: JournalMsgQueue -> StoreIO (Maybe Message)
   tryPeekMsg_ q@JournalMsgQueue {tipMsg, handles} =
@@ -379,27 +427,33 @@ instance MsgStoreClass JournalMsgStore where
         $>>= \len -> readTVarIO handles
         $>>= \hs -> updateReadPos q logState len hs $> Just ()
 
-  isolateQueue :: JournalMsgQueue -> String -> StoreIO a -> ExceptT ErrorType IO a
-  isolateQueue JournalMsgQueue {queue = q} op =
-    tryStore op (queueDirectory q) . withLock' (queueLock q) op . unStoreIO
+  isolateQueue :: RecipientId -> JournalQueue -> String -> StoreIO a -> ExceptT ErrorType IO a
+  isolateQueue rId JournalQueue {queueLock} op =
+    tryStore' op rId . withLock' queueLock op . unStoreIO
 
-tryStore :: String -> String -> IO a -> ExceptT ErrorType IO a
-tryStore op qId a = ExceptT $ E.mask_ $ E.try a >>= bimapM storeErr pure
+tryStore' :: String -> RecipientId -> IO a -> ExceptT ErrorType IO a
+tryStore' op rId = tryStore op rId . fmap Right
+
+tryStore :: forall a. String -> RecipientId -> IO (Either ErrorType a) -> ExceptT ErrorType IO a
+tryStore op rId a = ExceptT $ E.mask_ $ E.try a >>= either storeErr pure
   where
-    storeErr :: E.SomeException -> IO ErrorType
+    storeErr :: E.SomeException -> IO (Either ErrorType a)
     storeErr e =
-      let e' = intercalate ", " [op, qId, show e]
-       in logError ("STORE: " <> T.pack e') $> STORE e'
+      let e' = intercalate ", " [op, B.unpack $ strEncode rId, show e]
+       in logError ("STORE: " <> T.pack e') $> Left (STORE e')
+
+isolateQueueId :: String -> JournalMsgStore -> RecipientId -> IO (Either ErrorType a) -> ExceptT ErrorType IO a
+isolateQueueId op ms rId = tryStore op rId . withLockMap (queueLocks ms) rId op
 
 openMsgQueue :: JournalMsgStore -> JMQueue -> IO JournalMsgQueue
 openMsgQueue ms q@JMQueue {queueDirectory = dir, statePath} = do
   (st, sh) <- readWriteQueueState ms statePath
-  (st', rh, wh_) <- closeOnException sh $ openJournals dir st sh
+  (st', rh, wh_) <- closeOnException sh $ openJournals ms dir st sh
   let hs = MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = wh_}
-  mkJournalQueue q (st', Just hs)
+  mkJournalQueue q st' (Just hs)
 
-mkJournalQueue :: JMQueue -> (MsgQueueState, Maybe MsgQueueHandles) -> IO JournalMsgQueue
-mkJournalQueue queue (st, hs_) = do
+mkJournalQueue :: JMQueue -> MsgQueueState -> Maybe MsgQueueHandles -> IO JournalMsgQueue
+mkJournalQueue queue st hs_ = do
   state <- newTVarIO st
   tipMsg <- newTVarIO Nothing
   handles <- newTVarIO hs_
@@ -464,17 +518,26 @@ createNewJournal dir journalId = do
 newJournalId :: TVar StdGen -> IO ByteString
 newJournalId g = strEncode <$> atomically (stateTVar g $ genByteString 12)
 
-openJournals :: FilePath -> MsgQueueState -> Handle -> IO (MsgQueueState, Handle, Maybe Handle)
-openJournals dir st@MsgQueueState {readState = rs, writeState = ws} sh = do
+openJournals :: JournalMsgStore -> FilePath -> MsgQueueState -> Handle -> IO (MsgQueueState, Handle, Maybe Handle)
+openJournals ms dir st@MsgQueueState {readState = rs, writeState = ws} sh = do
   let rjId = journalId rs
       wjId = journalId ws
   openJournal rs >>= \case
-    Left path -> do
-      logError $ "STORE: openJournals, no read file - creating new file, " <> T.pack path
-      rh <- createNewJournal dir rjId
-      let st' = newMsgQueueState rjId
-      closeOnException rh $ appendState sh st'
-      pure (st', rh, Nothing)
+    Left path
+      | rjId == wjId -> do
+          logError $ "STORE: openJournals, no read/write file - creating new file, " <> T.pack path
+          newReadJournal
+      | otherwise -> do
+          let rs' = (newJournalState wjId) {msgCount = msgCount ws, byteCount = byteCount ws}
+              st' = st {readState = rs', size = msgCount ws}
+          openJournal rs' >>= \case
+            Left path' -> do
+              logError $ "STORE: openJournals, no read and write files - creating new file, read: " <> T.pack path <> ", write: " <> T.pack path'
+              newReadJournal
+            Right rh -> do
+              logError $ "STORE: openJournals, no read file - switched to write file, " <> T.pack path
+              closeOnException rh $ fixFileSize rh $ bytePos ws
+              pure (st', rh, Nothing)
     Right rh
       | rjId == wjId -> do
           closeOnException rh $ fixFileSize rh $ bytePos ws
@@ -483,16 +546,23 @@ openJournals dir st@MsgQueueState {readState = rs, writeState = ws} sh = do
           fixFileSize rh $ byteCount rs
           openJournal ws >>= \case
             Left path -> do
-              logError $ "STORE: openJournals, no write file - creating new file, " <> T.pack path
-              wh <- createNewJournal dir wjId
-              let size' = msgCount rs - msgPos rs
-                  st' = st {writeState = newJournalState wjId, size = size'} -- we don't amend canWrite to trigger QCONT
-              closeOnException wh $ appendState sh st'
-              pure (st', rh, Just wh)
+              let msgs = msgCount rs
+                  bytes = byteCount rs
+                  size' = msgs - msgPos rs
+                  ws' = (newJournalState rjId) {msgPos = msgs, msgCount = msgs, bytePos = bytes, byteCount = bytes}
+                  st' = st {writeState = ws', size = size'} -- we don't amend canWrite to trigger QCONT
+              logError $ "STORE: openJournals, no write file, " <> T.pack path
+              pure (st', rh, Nothing)
             Right wh -> do
               closeOnException wh $ fixFileSize wh $ bytePos ws
               pure (st, rh, Just wh)
   where
+    newReadJournal = do
+      rjId' <- newJournalId $ random ms
+      rh <- createNewJournal dir rjId'
+      let st' = newMsgQueueState rjId'
+      closeOnException rh $ appendState sh st'
+      pure (st', rh, Nothing)
     openJournal :: JournalState t -> IO (Either FilePath Handle)
     openJournal JournalState {journalId} =
       let path = journalFilePath dir journalId
@@ -599,10 +669,18 @@ validQueueState MsgQueueState {readState = rs, writeState = ws, size}
         && msgPos ws == msgCount ws
         && bytePos ws == byteCount ws
 
-closeMsgQueue :: JournalMsgStore -> RecipientId -> IO ()
-closeMsgQueue ms rId =
-  atomically (TM.lookupDelete rId (msgQueues ms))
-    >>= mapM_ closeMsgQueueHandles
+deleteQueue_ :: JournalMsgStore -> RecipientId -> JournalQueue -> IO (Either ErrorType (QueueRec, Maybe JournalMsgQueue))
+deleteQueue_ ms rId q =
+  runExceptT $ isolateQueueId "deleteQueue_" ms rId $
+    deleteQueue' ms rId q >>= mapM remove
+  where
+    remove r@(_, mq_) = do
+      mapM_ closeMsgQueueHandles mq_
+      removeQueueDirectory ms rId
+      pure r
+
+closeMsgQueue :: JournalQueue -> IO ()
+closeMsgQueue JournalQueue {msgQueue_} = atomically (swapTVar msgQueue_ Nothing) >>= mapM_ closeMsgQueueHandles
 
 closeMsgQueueHandles :: JournalMsgQueue -> IO ()
 closeMsgQueueHandles q = readTVarIO (handles q) >>= mapM_ closeHandles
@@ -613,9 +691,12 @@ closeMsgQueueHandles q = readTVarIO (handles q) >>= mapM_ closeHandles
       mapM_ hClose wh_
 
 removeQueueDirectory :: JournalMsgStore -> RecipientId -> IO ()
-removeQueueDirectory st rId =
-  let dir = msgQueueDirectory st rId
-   in removePathForcibly dir `catchAny` (\e -> logError $ "STORE: removeQueueDirectory, " <> T.pack dir <> ", " <> tshow e)
+removeQueueDirectory st = removeQueueDirectory_ . msgQueueDirectory st
+
+removeQueueDirectory_ :: FilePath -> IO ()
+removeQueueDirectory_ dir =
+  removePathForcibly dir `catchAny` \e ->
+    logError $ "STORE: removeQueueDirectory, " <> T.pack dir <> ", " <> tshow e
 
 hAppend :: Handle -> Int64 -> ByteString -> IO ()
 hAppend h pos s = do
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index 1b27b6a10..b1412421c 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -7,11 +8,11 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Simplex.Messaging.Server.MsgStore.STM
   ( STMMsgStore (..),
-    STMMsgQueue (msgQueue),
     STMStoreConfig (..),
   )
 where
@@ -20,21 +21,35 @@ import Control.Concurrent.STM
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import Data.Functor (($>))
-import Simplex.Messaging.Protocol (ErrorType, Message (..), RecipientId)
+import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.MsgStore.Types
+import Simplex.Messaging.Server.QueueStore
+import Simplex.Messaging.Server.QueueStore.STM
+import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-
-data STMMsgQueue = STMMsgQueue
-  { msgQueue :: TQueue Message,
-    quota :: Int,
-    canWrite :: TVar Bool,
-    size :: TVar Int
-  }
+import Simplex.Messaging.Util ((<$$>))
+import System.IO (IOMode (..))
 
 data STMMsgStore = STMMsgStore
   { storeConfig :: STMStoreConfig,
-    msgQueues :: TMap RecipientId STMMsgQueue
+    queues :: TMap RecipientId STMQueue,
+    senders :: TMap SenderId RecipientId,
+    notifiers :: TMap NotifierId RecipientId,
+    storeLog :: TVar (Maybe (StoreLog 'WriteMode))
+  }
+
+data STMQueue = STMQueue
+  { -- To avoid race conditions and errors when restoring queues,
+    -- Nothing is written to TVar when queue is deleted.
+    queueRec :: TVar (Maybe QueueRec),
+    msgQueue_ :: TVar (Maybe STMMsgQueue)
+  }
+
+data STMMsgQueue = STMMsgQueue
+  { msgQueue :: TQueue Message,
+    canWrite :: TVar Bool,
+    size :: TVar Int
   }
 
 data STMStoreConfig = STMStoreConfig
@@ -42,19 +57,34 @@ data STMStoreConfig = STMStoreConfig
     quota :: Int
   }
 
+instance STMQueueStore STMMsgStore where
+  queues' = queues
+  senders' = senders
+  notifiers' = notifiers
+  storeLog' = storeLog
+  mkQueue _ qr = STMQueue <$> (newTVar $! Just qr) <*> newTVar Nothing
+  msgQueue_' = msgQueue_
+
 instance MsgStoreClass STMMsgStore where
   type StoreMonad STMMsgStore = STM
+  type StoreQueue STMMsgStore = STMQueue
   type MsgQueue STMMsgStore = STMMsgQueue
   type MsgStoreConfig STMMsgStore = STMStoreConfig
 
   newMsgStore :: STMStoreConfig -> IO STMMsgStore
   newMsgStore storeConfig = do
-    msgQueues <- TM.emptyIO
-    pure STMMsgStore {storeConfig, msgQueues}
+    queues <- TM.emptyIO
+    senders <- TM.emptyIO
+    notifiers <- TM.emptyIO
+    storeLog <- newTVarIO Nothing
+    pure STMMsgStore {storeConfig, queues, senders, notifiers, storeLog}
 
-  closeMsgStore _ = pure ()
+  setStoreLog :: STMMsgStore -> StoreLog 'WriteMode -> IO ()
+  setStoreLog st sl = atomically $ writeTVar (storeLog st) (Just sl)
 
-  activeMsgQueues = msgQueues
+  closeMsgStore st = readTVarIO (storeLog st) >>= mapM_ closeStoreLog
+
+  activeMsgQueues = queues
   {-# INLINE activeMsgQueues #-}
 
   withAllMsgQueues _ = withActiveMsgQueues
@@ -64,39 +94,44 @@ instance MsgStoreClass STMMsgStore where
 
   logQueueState _ = pure ()
 
-  -- The reason for double lookup is that majority of messaging queues exist,
-  -- because multiple messages are sent to the same queue,
-  -- so the first lookup without STM transaction will return the queue faster.
-  -- In case the queue does not exist, it needs to be looked-up again inside transaction.
-  getMsgQueue :: STMMsgStore -> RecipientId -> ExceptT ErrorType IO STMMsgQueue
-  getMsgQueue STMMsgStore {msgQueues = qs, storeConfig = STMStoreConfig {quota}} rId =
-    liftIO $ TM.lookupIO rId qs >>= maybe (atomically maybeNewQ) pure
+  queueRec' = queueRec
+  {-# INLINE queueRec' #-}
+
+  getMsgQueue :: STMMsgStore -> RecipientId -> STMQueue -> STM STMMsgQueue
+  getMsgQueue _ _ STMQueue {msgQueue_} = readTVar msgQueue_ >>= maybe newQ pure
     where
-      maybeNewQ = TM.lookup rId qs >>= maybe newQ pure
       newQ = do
         msgQueue <- newTQueue
         canWrite <- newTVar True
         size <- newTVar 0
-        let q = STMMsgQueue {msgQueue, quota, canWrite, size}
-        TM.insert rId q qs
+        let q = STMMsgQueue {msgQueue, canWrite, size}
+        writeTVar msgQueue_ $! Just q
         pure q
 
-  delMsgQueue :: STMMsgStore -> RecipientId -> IO ()
-  delMsgQueue st rId = atomically $ TM.delete rId $ msgQueues st
+  openedMsgQueue :: STMQueue -> STM (Maybe STMMsgQueue)
+  openedMsgQueue = readTVar . msgQueue_
+  {-# INLINE openedMsgQueue #-}
 
-  delMsgQueueSize :: STMMsgStore -> RecipientId -> IO Int
-  delMsgQueueSize st rId = atomically (TM.lookupDelete rId $ msgQueues st) >>= maybe (pure 0) (\STMMsgQueue {size} -> readTVarIO size)
+  deleteQueue :: STMMsgStore -> RecipientId -> STMQueue -> IO (Either ErrorType QueueRec)
+  deleteQueue ms rId q = fst <$$> deleteQueue' ms rId q
 
-  getQueueMessages :: Bool -> STMMsgQueue -> IO [Message]
-  getQueueMessages drainMsgs = atomically . (if drainMsgs then flushTQueue else snapshotTQueue) . msgQueue
+  deleteQueueSize :: STMMsgStore -> RecipientId -> STMQueue -> IO (Either ErrorType (QueueRec, Int))
+  deleteQueueSize ms rId q = deleteQueue' ms rId q >>= mapM (traverse getSize)
+    -- traverse operates on the second tuple element
+    where
+      getSize = maybe (pure 0) (\STMMsgQueue {size} -> readTVarIO size)
+
+  getQueueMessages_ :: Bool -> STMMsgQueue -> STM [Message]
+  getQueueMessages_ drainMsgs = (if drainMsgs then flushTQueue else snapshotTQueue) . msgQueue
     where
       snapshotTQueue q = do
         msgs <- flushTQueue q
         mapM_ (writeTQueue q) msgs
         pure msgs
 
-  writeMsg :: STMMsgStore -> STMMsgQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  writeMsg _ STMMsgQueue {msgQueue = q, quota, canWrite, size} _logState msg = liftIO $ atomically $ do
+  writeMsg :: STMMsgStore -> RecipientId -> STMQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  writeMsg ms rId q' _logState msg = liftIO $ atomically $ do
+    STMMsgQueue {msgQueue = q, canWrite, size} <- getMsgQueue ms rId q'
     canWrt <- readTVar canWrite
     empty <- isEmptyTQueue q
     if canWrt || empty
@@ -109,13 +144,14 @@ instance MsgStoreClass STMMsgStore where
           else (writeTQueue q $! msgQuota) $> Nothing
       else pure Nothing
     where
-      msgQuota = MessageQuota {msgId = msgId msg, msgTs = msgTs msg}
+      STMMsgStore {storeConfig = STMStoreConfig {quota}} = ms
+      msgQuota = MessageQuota {msgId = messageId msg, msgTs = messageTs msg}
 
-  setOverQuota_ :: STMMsgQueue -> IO ()
-  setOverQuota_ q = atomically $ writeTVar (canWrite q) False
+  setOverQuota_ :: STMQueue -> IO ()
+  setOverQuota_ q = readTVarIO (msgQueue_ q) >>= mapM_ (\mq -> atomically $ writeTVar (canWrite mq) False)
 
-  getQueueSize :: STMMsgQueue -> IO Int
-  getQueueSize STMMsgQueue {size} = readTVarIO size
+  getQueueSize_ :: STMMsgQueue -> STM Int
+  getQueueSize_ STMMsgQueue {size} = readTVar size
 
   tryPeekMsg_ :: STMMsgQueue -> STM (Maybe Message)
   tryPeekMsg_ = tryPeekTQueue . msgQueue
@@ -127,5 +163,5 @@ instance MsgStoreClass STMMsgStore where
       Just _ -> modifyTVar' size (subtract 1)
       _ -> pure ()
 
-  isolateQueue :: STMMsgQueue -> String -> STM a -> ExceptT ErrorType IO a
-  isolateQueue _ _ = liftIO . atomically
+  isolateQueue :: RecipientId -> STMQueue -> String -> STM a -> ExceptT ErrorType IO a
+  isolateQueue _ _ _ = liftIO . atomically
diff --git a/src/Simplex/Messaging/Server/MsgStore/Types.hs b/src/Simplex/Messaging/Server/MsgStore/Types.hs
index 0486804f3..28f250b70 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Types.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Types.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -16,29 +17,44 @@ import Data.Int (Int64)
 import Data.Kind
 import qualified Data.Map.Strict as M
 import Data.Time.Clock.System (SystemTime (systemSeconds))
-import Simplex.Messaging.Protocol (ErrorType, Message (..), MsgId, RecipientId)
+import Simplex.Messaging.Protocol
+import Simplex.Messaging.Server.QueueStore
+import Simplex.Messaging.Server.StoreLog.Types
 import Simplex.Messaging.TMap (TMap)
+import System.IO (IOMode (..))
+
+class MsgStoreClass s => STMQueueStore s where
+  queues' :: s -> TMap RecipientId (StoreQueue s)
+  senders' :: s -> TMap SenderId RecipientId
+  notifiers' :: s -> TMap NotifierId RecipientId
+  storeLog' :: s -> TVar (Maybe (StoreLog 'WriteMode))
+  mkQueue :: s -> QueueRec -> STM (StoreQueue s)
+  msgQueue_' :: StoreQueue s -> TVar (Maybe (MsgQueue s))
 
 class Monad (StoreMonad s) => MsgStoreClass s where
   type StoreMonad s = (m :: Type -> Type) | m -> s
   type MsgStoreConfig s = c | c -> s
+  type StoreQueue s = q | q -> s
   type MsgQueue s = q | q -> s
   newMsgStore :: MsgStoreConfig s -> IO s
+  setStoreLog :: s -> StoreLog 'WriteMode -> IO ()
   closeMsgStore :: s -> IO ()
-  activeMsgQueues :: s -> TMap RecipientId (MsgQueue s)
-  withAllMsgQueues :: Monoid a => Bool -> s -> (RecipientId -> MsgQueue s -> IO a) -> IO a
+  activeMsgQueues :: s -> TMap RecipientId (StoreQueue s)
+  withAllMsgQueues :: Monoid a => Bool -> s -> (RecipientId -> StoreQueue s -> IO a) -> IO a
   logQueueStates :: s -> IO ()
-  logQueueState :: MsgQueue s -> IO ()
-  getMsgQueue :: s -> RecipientId -> ExceptT ErrorType IO (MsgQueue s)
-  delMsgQueue :: s -> RecipientId -> IO ()
-  delMsgQueueSize :: s -> RecipientId -> IO Int
-  getQueueMessages :: Bool -> MsgQueue s -> IO [Message]
-  writeMsg :: s -> MsgQueue s -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  setOverQuota_ :: MsgQueue s -> IO () -- can ONLY be used while restoring messages, not while server running
-  getQueueSize :: MsgQueue s -> IO Int
+  logQueueState :: StoreQueue s -> IO ()
+  queueRec' :: StoreQueue s -> TVar (Maybe QueueRec)
+  getMsgQueue :: s -> RecipientId -> StoreQueue s -> StoreMonad s (MsgQueue s)
+  openedMsgQueue :: StoreQueue s -> StoreMonad s (Maybe (MsgQueue s))
+  deleteQueue :: s -> RecipientId -> StoreQueue s -> IO (Either ErrorType QueueRec)
+  deleteQueueSize :: s -> RecipientId -> StoreQueue s -> IO (Either ErrorType (QueueRec, Int))
+  getQueueMessages_ :: Bool -> MsgQueue s -> StoreMonad s [Message]
+  writeMsg :: s -> RecipientId -> StoreQueue s -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
+  setOverQuota_ :: StoreQueue s -> IO () -- can ONLY be used while restoring messages, not while server running
+  getQueueSize_ :: MsgQueue s -> StoreMonad s Int
   tryPeekMsg_ :: MsgQueue s -> StoreMonad s (Maybe Message)
   tryDeleteMsg_ :: MsgQueue s -> Bool -> StoreMonad s ()
-  isolateQueue :: MsgQueue s -> String -> StoreMonad s a -> ExceptT ErrorType IO a
+  isolateQueue :: RecipientId -> StoreQueue s -> String -> StoreMonad s a -> ExceptT ErrorType IO a
 
 data MSType = MSMemory | MSJournal
 
@@ -48,42 +64,55 @@ data SMSType :: MSType -> Type where
 
 data AMSType = forall s. AMSType (SMSType s)
 
-withActiveMsgQueues :: (MsgStoreClass s, Monoid a) => s -> (RecipientId -> MsgQueue s -> IO a) -> IO a
+withActiveMsgQueues :: (MsgStoreClass s, Monoid a) => s -> (RecipientId -> StoreQueue s -> IO a) -> IO a
 withActiveMsgQueues st f = readTVarIO (activeMsgQueues st) >>= foldM run mempty . M.assocs
   where
     run !acc (k, v) = do
       r <- f k v
       pure $! acc <> r
 
-tryPeekMsg :: MsgStoreClass s => MsgQueue s -> ExceptT ErrorType IO (Maybe Message)
-tryPeekMsg mq = isolateQueue mq "tryPeekMsg" $ tryPeekMsg_ mq
+getQueueMessages :: MsgStoreClass s => Bool -> s -> RecipientId -> StoreQueue s -> ExceptT ErrorType IO [Message]
+getQueueMessages drainMsgs st rId q = withMsgQueue st rId q "getQueueSize" $ getQueueMessages_ drainMsgs
+{-# INLINE getQueueMessages #-}
+
+getQueueSize :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> ExceptT ErrorType IO Int
+getQueueSize st rId q = withMsgQueue st rId q "getQueueSize" $ getQueueSize_
+{-# INLINE getQueueSize #-}
+
+tryPeekMsg :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> ExceptT ErrorType IO (Maybe Message)
+tryPeekMsg st rId q = withMsgQueue st rId q "tryPeekMsg" $ tryPeekMsg_
 {-# INLINE tryPeekMsg #-}
 
-tryDelMsg :: MsgStoreClass s => MsgQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message)
-tryDelMsg mq msgId' =
-  isolateQueue mq "tryDelMsg" $
+tryDelMsg :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message)
+tryDelMsg st rId q msgId' =
+  withMsgQueue st rId q "tryDelMsg" $ \mq ->
     tryPeekMsg_ mq >>= \case
       msg_@(Just msg)
-        | msgId msg == msgId' ->
+        | messageId msg == msgId' ->
             tryDeleteMsg_ mq True >> pure msg_
       _ -> pure Nothing
 
 -- atomic delete (== read) last and peek next message if available
-tryDelPeekMsg :: MsgStoreClass s => MsgQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
-tryDelPeekMsg mq msgId' =
-  isolateQueue mq "tryDelPeekMsg" $
+tryDelPeekMsg :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
+tryDelPeekMsg st rId q msgId' =
+  withMsgQueue st rId q "tryDelPeekMsg" $ \mq ->
     tryPeekMsg_ mq >>= \case
       msg_@(Just msg)
-        | msgId msg == msgId' -> (msg_,) <$> (tryDeleteMsg_ mq True >> tryPeekMsg_ mq)
+        | messageId msg == msgId' -> (msg_,) <$> (tryDeleteMsg_ mq True >> tryPeekMsg_ mq)
         | otherwise -> pure (Nothing, msg_)
       _ -> pure (Nothing, Nothing)
 
-deleteExpiredMsgs :: MsgStoreClass s => MsgQueue s -> Bool -> Int64 -> ExceptT ErrorType IO Int
-deleteExpiredMsgs mq logState old = isolateQueue mq "deleteExpiredMsgs" $ loop 0
+withMsgQueue :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> String -> (MsgQueue s -> StoreMonad s a) -> ExceptT ErrorType IO a
+withMsgQueue st rId q op a = isolateQueue rId q op $ getMsgQueue st rId q >>= a
+{-# INLINE withMsgQueue #-}
+
+deleteExpiredMsgs :: MsgStoreClass s => RecipientId -> StoreQueue s -> Bool -> Int64 -> ExceptT ErrorType IO Int
+deleteExpiredMsgs rId q logState old =
+  isolateQueue rId q "deleteExpiredMsgs" $ openedMsgQueue q >>= maybe (pure 0) (loop 0)
   where
-    loop dc =
+    loop dc mq =
       tryPeekMsg_ mq >>= \case
         Just Message {msgTs}
           | systemSeconds msgTs < old ->
-              tryDeleteMsg_ mq logState >> loop (dc + 1)
+              tryDeleteMsg_ mq logState >> loop (dc + 1) mq
         _ -> pure dc
diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index 4cd499430..d83d26f08 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -1,120 +1,196 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Simplex.Messaging.Server.QueueStore.STM
-  ( QueueStore (..),
-    newQueueStore,
-    addQueue,
+  ( addQueue,
     getQueue,
+    getQueueRec,
     secureQueue,
     addQueueNotifier,
     deleteQueueNotifier,
     suspendQueue,
     updateQueueTime,
-    deleteQueue,
+    deleteQueue',
+    readQueueStore,
+    withLog',
   )
 where
 
+import qualified Control.Exception as E
+import Control.Logger.Simple
 import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
+import Data.Bitraversable (bimapM)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Functor (($>))
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeLatin1)
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
+import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
-import Simplex.Messaging.TMap (TMap)
+import Simplex.Messaging.Server.StoreLog
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (ifM, ($>>=))
+import Simplex.Messaging.Util (ifM, tshow, ($>>=), (<$$))
+import System.IO
 import UnliftIO.STM
 
-data QueueStore = QueueStore
-  { queues :: TMap RecipientId (TVar QueueRec),
-    senders :: TMap SenderId RecipientId,
-    notifiers :: TMap NotifierId RecipientId
-  }
-
-newQueueStore :: IO QueueStore
-newQueueStore = do
-  queues <- TM.emptyIO
-  senders <- TM.emptyIO
-  notifiers <- TM.emptyIO
-  pure QueueStore {queues, senders, notifiers}
-
-addQueue :: QueueStore -> QueueRec -> IO (Either ErrorType ())
-addQueue QueueStore {queues, senders, notifiers} q@QueueRec {recipientId = rId, senderId = sId, notifier} = atomically $ do
-  ifM hasId (pure $ Left DUPLICATE_) $ do
-    TM.insertM rId (newTVar q) queues
-    TM.insert sId rId senders
-    forM_ notifier $ \NtfCreds {notifierId} -> TM.insert notifierId rId notifiers
-    pure $ Right ()
+addQueue :: STMQueueStore s => s -> QueueRec -> IO (Either ErrorType (StoreQueue s))
+addQueue st qr@QueueRec {recipientId = rId, senderId = sId, notifier}=
+  atomically add
+    $>>= \q -> q <$$ withLog "addQueue" st (`logCreateQueue` qr)
   where
-    hasId = (||) <$> TM.member rId queues <*> TM.member sId senders
+    add = ifM hasId (pure $ Left DUPLICATE_) $ do
+      q <- mkQueue st qr -- STMQueue lock <$> (newTVar $! Just qr) <*> newTVar Nothing
+      TM.insert rId q $ queues' st
+      TM.insert sId rId $ senders' st
+      forM_ notifier $ \NtfCreds {notifierId} -> TM.insert notifierId rId $ notifiers' st
+      pure $ Right q
+    hasId = or <$> sequence [TM.member rId $ queues' st, TM.member sId $ senders' st, hasNotifier]
+    hasNotifier = maybe (pure False) (\NtfCreds {notifierId} -> TM.member notifierId (notifiers' st)) notifier
 
-getQueue :: DirectParty p => QueueStore -> SParty p -> QueueId -> IO (Either ErrorType QueueRec)
-getQueue QueueStore {queues, senders, notifiers} party qId =
-  toResult <$> (mapM readTVarIO =<< getVar)
+getQueue :: (STMQueueStore s, DirectParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s))
+getQueue st party qId =
+  maybe (Left AUTH) Right <$> case party of
+    SRecipient -> TM.lookupIO qId $ queues' st
+    SSender -> TM.lookupIO qId (senders' st) $>>= (`TM.lookupIO` queues' st)
+    SNotifier -> TM.lookupIO qId (notifiers' st) $>>= (`TM.lookupIO` queues' st)
+
+getQueueRec :: (STMQueueStore s, DirectParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s, QueueRec))
+getQueueRec st party qId =
+  getQueue st party qId
+    $>>= (\q -> maybe (Left AUTH) (Right . (q,)) <$> readTVarIO (queueRec' q))
+
+secureQueue :: STMQueueStore s => s -> StoreQueue s -> SndPublicAuthKey -> IO (Either ErrorType ())
+secureQueue st sq sKey =
+  atomically (readQueueRec qr $>>= secure)
+    $>>= \rId -> withLog "secureQueue" st $ \s -> logSecureQueue s rId sKey
   where
-    getVar = case party of
-      SRecipient -> TM.lookupIO qId queues
-      SSender -> TM.lookupIO qId senders $>>= (`TM.lookupIO` queues)
-      SNotifier -> TM.lookupIO qId notifiers $>>= (`TM.lookupIO` queues)
+    qr = queueRec' sq
+    secure q@QueueRec {recipientId = rId} = case senderKey q of
+      Just k -> pure $ if sKey == k then Right rId else Left AUTH
+      Nothing -> do
+        writeTVar qr $! Just q {senderKey = Just sKey}
+        pure $ Right rId
 
-secureQueue :: QueueStore -> RecipientId -> SndPublicAuthKey -> IO (Either ErrorType QueueRec)
-secureQueue QueueStore {queues} rId sKey = toResult <$> do
-  TM.lookupIO rId queues $>>= \qVar -> atomically $ 
-    readTVar qVar >>= \q -> case senderKey q of
-      Just k -> pure $ if sKey == k then Just q else Nothing
-      _ ->
-        let !q' = q {senderKey = Just sKey}
-         in writeTVar qVar q' $> Just q'
-
-addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType (Maybe NotifierId))
-addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = do
-  TM.lookupIO rId queues >>= \case
-    Just qVar -> atomically $ ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $ do
-      q <- readTVar qVar
-      nId_ <- forM (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers $> notifierId
+addQueueNotifier :: STMQueueStore s => s -> StoreQueue s -> NtfCreds -> IO (Either ErrorType (Maybe NotifierId))
+addQueueNotifier st sq ntfCreds@NtfCreds {notifierId = nId} =
+  atomically (readQueueRec qr $>>= add)
+    $>>= \(rId, nId_) -> nId_ <$$ withLog "addQueueNotifier" st (\s -> logAddNotifier s rId ntfCreds)
+  where
+    qr = queueRec' sq
+    add q@QueueRec {recipientId = rId} = ifM (TM.member nId (notifiers' st)) (pure $ Left DUPLICATE_) $ do
+      nId_ <- forM (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId (notifiers' st) $> notifierId
       let !q' = q {notifier = Just ntfCreds}
-      writeTVar qVar q'
-      TM.insert nId rId notifiers
-      pure $ Right nId_
-    Nothing -> pure $ Left AUTH
+      writeTVar qr $! Just q'
+      TM.insert nId rId $ notifiers' st
+      pure $ Right (rId, nId_)
 
-deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType (Maybe NotifierId))
-deleteQueueNotifier QueueStore {queues, notifiers} rId =
-  withQueue rId queues $ \qVar -> do
-    q <- readTVar qVar
-    forM (notifier q) $ \NtfCreds {notifierId} -> do
-      TM.delete notifierId notifiers
-      writeTVar qVar $! q {notifier = Nothing}
+deleteQueueNotifier :: STMQueueStore s => s -> StoreQueue s -> IO (Either ErrorType (Maybe NotifierId))
+deleteQueueNotifier st sq =
+  atomically (readQueueRec qr >>= mapM delete)
+    $>>= \(rId, nId_) -> nId_ <$$ withLog "deleteQueueNotifier" st (`logDeleteNotifier` rId)
+  where
+    qr = queueRec' sq
+    delete q = fmap (recipientId q,) $ forM (notifier q) $ \NtfCreds {notifierId} -> do
+      TM.delete notifierId $ notifiers' st
+      writeTVar qr $! Just q {notifier = Nothing}
       pure notifierId
 
-suspendQueue :: QueueStore -> RecipientId -> IO (Either ErrorType ())
-suspendQueue QueueStore {queues} rId =
-  withQueue rId queues (`modifyTVar'` \q -> q {status = QueueOff})
+suspendQueue :: STMQueueStore s => s -> StoreQueue s -> IO (Either ErrorType ())
+suspendQueue st sq =
+  atomically (readQueueRec qr >>= mapM suspend)
+    $>>= \rId -> withLog "suspendQueue" st (`logSuspendQueue` rId)
+  where
+    qr = queueRec' sq
+    suspend q = do
+      writeTVar qr $! Just q {status = QueueOff}
+      pure $ recipientId q
 
-updateQueueTime :: QueueStore -> RecipientId -> RoundedSystemTime -> IO ()
-updateQueueTime QueueStore {queues} rId t =
-  void $ withQueue rId queues (`modifyTVar'` \q -> q {updatedAt = Just t})
+updateQueueTime :: STMQueueStore s => s -> StoreQueue s -> RoundedSystemTime -> IO (Either ErrorType QueueRec)
+updateQueueTime st sq t = atomically (readQueueRec qr >>= mapM update) $>>= log'
+  where
+    qr = queueRec' sq
+    update q@QueueRec {updatedAt}
+      | updatedAt == Just t = pure (q, False)
+      | otherwise =
+          let !q' = q {updatedAt = Just t}
+           in (writeTVar qr $! Just q') $> (q', True)
+    log' (q, changed)
+      | changed = q <$$ withLog "updateQueueTime" st (\sl -> logUpdateQueueTime sl (recipientId q) t)
+      | otherwise = pure $ Right q
 
-deleteQueue :: QueueStore -> RecipientId -> IO (Either ErrorType QueueRec)
-deleteQueue QueueStore {queues, senders, notifiers} rId = atomically $ do
-  TM.lookupDelete rId queues >>= \case
-    Just qVar ->
-      readTVar qVar >>= \q -> do
-        TM.delete (senderId q) senders
-        forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers
-        pure $ Right q
-    _ -> pure $ Left AUTH
+deleteQueue' :: STMQueueStore s => s -> RecipientId -> StoreQueue s -> IO (Either ErrorType (QueueRec, Maybe (MsgQueue s)))
+deleteQueue' st rId sq =
+  atomically (readQueueRec qr >>= mapM delete)
+    $>>= \q -> withLog "deleteQueue" st (`logDeleteQueue` rId)
+    >>= bimapM pure (\_ -> (q,) <$> atomically (swapTVar (msgQueue_' sq) Nothing))
+  where
+    qr = queueRec' sq
+    delete q = do
+      writeTVar qr Nothing
+      TM.delete (senderId q) $ senders' st
+      forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId $ notifiers' st
+      pure q
 
-toResult :: Maybe a -> Either ErrorType a
-toResult = maybe (Left AUTH) Right
+readQueueRec :: TVar (Maybe QueueRec) -> STM (Either ErrorType QueueRec)
+readQueueRec qr = maybe (Left AUTH) Right <$> readTVar qr
+{-# INLINE readQueueRec #-}
 
-withQueue :: RecipientId -> TMap RecipientId (TVar QueueRec) -> (TVar QueueRec -> STM a) -> IO (Either ErrorType a)
-withQueue rId queues f = toResult <$> TM.lookupIO rId queues >>= atomically . mapM f
+withLog' :: String -> TVar (Maybe (StoreLog 'WriteMode)) -> (StoreLog 'WriteMode -> IO ()) -> IO (Either ErrorType ())
+withLog' name sl action =
+  readTVarIO sl
+    >>= maybe (pure $ Right ()) (E.try . action >=> bimapM logErr pure)
+  where
+    logErr :: E.SomeException -> IO ErrorType
+    logErr e = logError ("STORE: " <> T.pack err) $> STORE err
+      where
+        err = name <> ", withLog, " <> show e
+
+withLog :: STMQueueStore s => String -> s -> (StoreLog 'WriteMode -> IO ()) -> IO (Either ErrorType ())
+withLog name = withLog' name . storeLog'
+
+readQueueStore :: forall s. STMQueueStore s => FilePath -> s -> IO ()
+readQueueStore f st = withFile f ReadMode $ LB.hGetContents >=> mapM_ processLine . LB.lines
+  where
+    processLine :: LB.ByteString -> IO ()
+    processLine s' = either printError procLogRecord (strDecode s)
+      where
+        s = LB.toStrict s'
+        procLogRecord :: StoreLogRecord -> IO ()
+        procLogRecord = \case
+          CreateQueue q -> addQueue st q >>= qError (recipientId q) "CreateQueue"
+          SecureQueue qId sKey -> withQueue qId "SecureQueue" $ \q -> secureQueue st q sKey
+          AddNotifier qId ntfCreds -> withQueue qId "AddNotifier" $ \q -> addQueueNotifier st q ntfCreds
+          SuspendQueue qId -> withQueue qId "SuspendQueue" $ suspendQueue st
+          DeleteQueue qId -> withQueue qId "DeleteQueue" $ deleteQueue st qId
+          DeleteNotifier qId -> withQueue qId "DeleteNotifier" $ deleteQueueNotifier st
+          UpdateTime qId t -> withQueue qId "UpdateTime" $ \q -> updateQueueTime st q t
+        printError :: String -> IO ()
+        printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s
+        withQueue :: forall a. RecipientId -> T.Text -> (StoreQueue s -> IO (Either ErrorType a)) -> IO ()
+        withQueue qId op a = runExceptT go >>= qError qId op
+          where
+            go = do
+              q <- ExceptT $ getQueue st SRecipient qId
+              liftIO (readTVarIO $ queueRec' q) >>= \case
+                Nothing -> logWarn $ logPfx qId op <> "already deleted"
+                Just _ -> void $ ExceptT $ a q
+        qError qId op = \case
+          Left e -> logError $ logPfx qId op <> tshow e
+          Right _ -> pure ()
+        logPfx qId op = "STORE: " <> op <> ", stored queue " <> decodeLatin1 (strEncode qId) <> ", "
diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs
index 2e272260a..2da3398f2 100644
--- a/src/Simplex/Messaging/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Server/StoreLog.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Simplex.Messaging.Server.StoreLog
@@ -23,36 +24,33 @@ module Simplex.Messaging.Server.StoreLog
     logDeleteQueue,
     logDeleteNotifier,
     logUpdateQueueTime,
-    readWriteQueueStore,
     readWriteStoreLog,
+    writeQueueStore,
   )
 where
 
 import Control.Applicative (optional, (<|>))
 import Control.Concurrent.STM
+import qualified Control.Exception as E
 import Control.Logger.Simple
 import Control.Monad
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as LB
-import qualified Data.ByteString.Base64.URL as B64
+import qualified Data.Map.Strict as M
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
+import GHC.IO (catchAny)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
+import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
-import Simplex.Messaging.Server.QueueStore.STM
-import Simplex.Messaging.Util (bshow, ifM, unlessM, whenM)
+import Simplex.Messaging.Server.StoreLog.Types
+import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Util (ifM, tshow, unlessM, whenM)
 import System.Directory (doesFileExist, renameFile)
 import System.IO
 
--- | opaque container for file handle with a type-safe IOMode
--- constructors are not exported, openWriteStoreLog and openReadStoreLog should be used instead
-data StoreLog (a :: IOMode) where
-  ReadStoreLog :: FilePath -> Handle -> StoreLog 'ReadMode
-  WriteStoreLog :: FilePath -> Handle -> StoreLog 'WriteMode
-
 data StoreLogRecord
   = CreateQueue QueueRec
   | SecureQueue QueueId SndPublicAuthKey
@@ -159,11 +157,13 @@ storeLogFilePath = \case
 
 closeStoreLog :: StoreLog a -> IO ()
 closeStoreLog = \case
-  WriteStoreLog _ h -> hClose h
-  ReadStoreLog _ h -> hClose h
+  WriteStoreLog _ h -> close_ h
+  ReadStoreLog _ h -> close_ h
+  where
+    close_ h = hClose h `catchAny` \e -> logError ("STORE: closeStoreLog, error closing, " <> tshow e)
 
 writeStoreLogRecord :: StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
-writeStoreLogRecord (WriteStoreLog _ h) r = do
+writeStoreLogRecord (WriteStoreLog _ h) r = E.uninterruptibleMask_ $ do
   B.hPut h $ strEncode r `B.snoc` '\n' -- hPutStrLn makes write non-atomic for length > 1024
   hFlush h
 
@@ -188,9 +188,6 @@ logDeleteNotifier s = writeStoreLogRecord s . DeleteNotifier
 logUpdateQueueTime :: StoreLog 'WriteMode -> QueueId -> RoundedSystemTime -> IO ()
 logUpdateQueueTime s qId t = writeStoreLogRecord s $ UpdateTime qId t
 
-readWriteQueueStore :: FilePath -> QueueStore -> IO (StoreLog 'WriteMode)
-readWriteQueueStore = readWriteStoreLog readQueues writeQueues
-
 readWriteStoreLog :: (FilePath -> s -> IO ()) -> (StoreLog 'WriteMode -> s -> IO ()) -> FilePath -> s -> IO (StoreLog 'WriteMode)
 readWriteStoreLog readStore writeStore f st =
   ifM
@@ -226,31 +223,11 @@ readWriteStoreLog readStore writeStore f st =
       renameFile tempBackup timedBackup
       logInfo $ "original state preserved as " <> T.pack timedBackup
 
-writeQueues :: StoreLog 'WriteMode -> QueueStore -> IO ()
-writeQueues s st = readTVarIO (queues st) >>= mapM_ writeQueue
+writeQueueStore :: STMQueueStore s => StoreLog 'WriteMode -> s -> IO ()
+writeQueueStore s st = readTVarIO (activeMsgQueues st) >>= mapM_ writeQueue . M.assocs
   where
-    writeQueue v = readTVarIO v >>= \q -> when (active q) $ logCreateQueue s q
+    writeQueue (rId, q) =
+      readTVarIO (queueRec' q) >>= \case
+        Just q' -> when (active q') $ logCreateQueue s q' -- TODO we should log suspended queues when we use them
+        Nothing -> atomically $ TM.delete rId $ activeMsgQueues st
     active QueueRec {status} = status == QueueActive
-
-readQueues :: FilePath -> QueueStore -> IO ()
-readQueues f st = withFile f ReadMode $ LB.hGetContents >=> mapM_ processLine . LB.lines
-  where
-    processLine :: LB.ByteString -> IO ()
-    processLine s' = either printError procLogRecord (strDecode s)
-      where
-        s = LB.toStrict s'
-        procLogRecord :: StoreLogRecord -> IO ()
-        procLogRecord = \case
-          CreateQueue q -> addQueue st q >>= qError "create" (recipientId q)
-          SecureQueue qId sKey -> secureQueue st qId sKey >>= qError "secure" qId
-          AddNotifier qId ntfCreds -> addQueueNotifier st qId ntfCreds >>= qError "addNotifier" qId
-          SuspendQueue qId -> suspendQueue st qId >>= qError "suspend" qId
-          DeleteQueue qId -> deleteQueue st qId >>= qError "delete" qId
-          DeleteNotifier qId -> deleteQueueNotifier st qId >>= qError "deleteNotifier" qId
-          UpdateTime qId t -> updateQueueTime st qId t
-        printError :: String -> IO ()
-        printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s
-        qError :: B.ByteString -> RecipientId -> Either ErrorType a -> IO ()
-        qError op (EntityId qId) = \case
-          Left e -> B.putStrLn $ op <> " stored queue " <> B64.encode qId <> " error: " <> bshow e
-          Right _ -> pure ()
diff --git a/src/Simplex/Messaging/Server/StoreLog/Types.hs b/src/Simplex/Messaging/Server/StoreLog/Types.hs
new file mode 100644
index 000000000..6b711f9d7
--- /dev/null
+++ b/src/Simplex/Messaging/Server/StoreLog/Types.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+
+module Simplex.Messaging.Server.StoreLog.Types where
+
+import System.IO (Handle, IOMode (..))
+
+-- | opaque container for file handle with a type-safe IOMode
+-- constructors are not exported, openWriteStoreLog and openReadStoreLog should be used instead
+data StoreLog (a :: IOMode) where
+  ReadStoreLog :: FilePath -> Handle -> StoreLog 'ReadMode
+  WriteStoreLog :: FilePath -> Handle -> StoreLog 'WriteMode
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index ea0322b74..b467c5ea9 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -35,12 +35,16 @@ raceAny_ = r []
     r as (m : ms) = withAsync m $ \a -> r (a : as) ms
     r as [] = void $ waitAnyCancel as
 
-infixl 4 <$$>, <$?>
+infixl 4 <$$>, <$$, <$?>
 
 (<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
 (<$$>) = fmap . fmap
 {-# INLINE (<$$>) #-}
 
+(<$$) :: (Functor f, Functor g) => b -> f (g a) -> f (g b)
+(<$$) = fmap . fmap . const
+{-# INLINE (<$$) #-}
+
 (<$?>) :: MonadFail m => (a -> Either String b) -> m a -> m b
 f <$?> m = either fail pure . f =<< m
 {-# INLINE (<$?>) #-}
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index 16e3a12f0..4fc48d6c7 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -7,6 +8,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -17,19 +19,25 @@ import Control.Concurrent.STM
 import Control.Exception (bracket)
 import Control.Monad
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
+import Crypto.Random (ChaChaDRG)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Base64.URL as B64
+import Data.Maybe (fromJust)
 import Data.Time.Clock.System (getSystemTime)
 import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (EntityId (..), Message (..), noMsgFlags)
+import Simplex.Messaging.Protocol (EntityId (..), Message (..), RecipientId, SParty (..), noMsgFlags)
 import Simplex.Messaging.Server (MessageStats (..), exportMessages, importMessages, printMessageStats)
-import Simplex.Messaging.Server.Env.STM (journalMsgStoreDepth)
+import Simplex.Messaging.Server.Env.STM (journalMsgStoreDepth, readWriteQueueStore)
 import Simplex.Messaging.Server.MsgStore.Journal
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
-import SMPClient (testStoreMsgsDir, testStoreMsgsDir2, testStoreMsgsFile, testStoreMsgsFile2)
+import Simplex.Messaging.Server.QueueStore
+import Simplex.Messaging.Server.QueueStore.STM
+import Simplex.Messaging.Server.StoreLog (closeStoreLog, logCreateQueue)
+import SMPClient (testStoreLogFile, testStoreMsgsDir, testStoreMsgsDir2, testStoreMsgsFile, testStoreMsgsFile2)
 import System.Directory (copyFile, createDirectoryIfMissing, listDirectory, removeFile, renameFile)
 import System.FilePath ((</>))
 import System.IO (IOMode (..), hClose, withFile)
@@ -44,13 +52,18 @@ msgStoreTests = do
     describe "queue state" $ do
       it "should restore queue state from the last line" testQueueState
       it "should recover when message is written and state is not" testMessageState
+    describe "missing files" $ do
+      it "should create read file when missing" testReadFileMissing
+      it "should switch to write file when read file missing" testReadFileMissingSwitch
+      it "should create write file when missing" testWriteFileMissing
+      it "should create read file when read and write files are missing" testReadAndWriteFilesMissing
   where
-    someMsgStoreTests :: MsgStoreClass s => SpecWith s
+    someMsgStoreTests :: STMQueueStore s => SpecWith s
     someMsgStoreTests = do
       it "should get queue and store/read messages" testGetQueue
       it "should not fail on EOF when changing read journal" testChangeReadJournal
 
-withMsgStore :: MsgStoreClass s => MsgStoreConfig s -> (s -> IO ()) -> IO ()
+withMsgStore :: STMQueueStore s => MsgStoreConfig s -> (s -> IO ()) -> IO ()
 withMsgStore cfg = bracket (newMsgStore cfg) closeMsgStore
 
 testSMTStoreConfig :: STMStoreConfig
@@ -83,98 +96,121 @@ deriving instance Eq (JournalState t)
 
 deriving instance Eq (SJournalType t)
 
-testGetQueue :: MsgStoreClass s => s -> IO ()
+testNewQueueRec :: TVar ChaChaDRG -> Bool -> IO (RecipientId, QueueRec)
+testNewQueueRec g sndSecure = do
+  rId <- atomically $ EntityId <$> C.randomBytes 24 g
+  senderId <- atomically $ EntityId <$> C.randomBytes 24 g
+  (recipientKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
+  (k, pk) <- atomically $ C.generateKeyPair @'C.X25519 g
+  let qr =
+        QueueRec
+          { recipientId = rId,
+            recipientKey,
+            rcvDhSecret = C.dh' k pk,
+            senderId,
+            senderKey = Nothing,
+            sndSecure,
+            notifier = Nothing,
+            status = QueueActive,
+            updatedAt = Nothing
+          }
+  pure (rId, qr)
+
+testGetQueue :: STMQueueStore s => s -> IO ()
 testGetQueue ms = do
   g <- C.newRandom
-  rId <- EntityId <$> atomically (C.randomBytes 24 g)
+  (rId, qr) <- testNewQueueRec g True
   runRight_ $ do
-    q <- getMsgQueue ms rId
-    let write s = writeMsg ms q True =<< mkMessage s
+    q <- ExceptT $ addQueue ms qr
+    let write s = writeMsg ms rId q True =<< mkMessage s
     Just (Message {msgId = mId1}, True) <- write "message 1"
     Just (Message {msgId = mId2}, False) <- write "message 2"
     Just (Message {msgId = mId3}, False) <- write "message 3"
-    Msg "message 1" <- tryPeekMsg q
-    Msg "message 1" <- tryPeekMsg q
-    Nothing <- tryDelMsg q mId2
-    Msg "message 1" <- tryDelMsg q mId1
-    Nothing <- tryDelMsg q mId1
-    Msg "message 2" <- tryPeekMsg q
-    Nothing <- tryDelMsg q mId1
-    (Nothing, Msg "message 2") <- tryDelPeekMsg q mId1
-    (Msg "message 2", Msg "message 3") <- tryDelPeekMsg q mId2
-    (Nothing, Msg "message 3") <- tryDelPeekMsg q mId2
-    Msg "message 3" <- tryPeekMsg q
-    (Msg "message 3", Nothing) <- tryDelPeekMsg q mId3
-    Nothing <- tryDelMsg q mId2
-    Nothing <- tryDelMsg q mId3
-    Nothing <- tryPeekMsg q
+    Msg "message 1" <- tryPeekMsg ms rId q
+    Msg "message 1" <- tryPeekMsg ms rId q
+    Nothing <- tryDelMsg ms rId q mId2
+    Msg "message 1" <- tryDelMsg ms rId q mId1
+    Nothing <- tryDelMsg ms rId q mId1
+    Msg "message 2" <- tryPeekMsg ms rId q
+    Nothing <- tryDelMsg ms rId q mId1
+    (Nothing, Msg "message 2") <- tryDelPeekMsg ms rId q mId1
+    (Msg "message 2", Msg "message 3") <- tryDelPeekMsg ms rId q mId2
+    (Nothing, Msg "message 3") <- tryDelPeekMsg ms rId q mId2
+    Msg "message 3" <- tryPeekMsg ms rId q
+    (Msg "message 3", Nothing) <- tryDelPeekMsg ms rId q mId3
+    Nothing <- tryDelMsg ms rId q mId2
+    Nothing <- tryDelMsg ms rId q mId3
+    Nothing <- tryPeekMsg ms rId q
     Just (Message {msgId = mId4}, True) <- write "message 4"
-    Msg "message 4" <- tryPeekMsg q
+    Msg "message 4" <- tryPeekMsg ms rId q
     Just (Message {msgId = mId5}, False) <- write "message 5"
-    (Nothing, Msg "message 4") <- tryDelPeekMsg q mId3
-    (Msg "message 4", Msg "message 5") <- tryDelPeekMsg q mId4
+    (Nothing, Msg "message 4") <- tryDelPeekMsg ms rId q mId3
+    (Msg "message 4", Msg "message 5") <- tryDelPeekMsg ms rId q mId4
     Just (Message {msgId = mId6}, False) <- write "message 6"
     Just (Message {msgId = mId7}, False) <- write "message 7"
     Nothing <- write "message 8"
-    Msg "message 5" <- tryPeekMsg q
-    (Nothing, Msg "message 5") <- tryDelPeekMsg q mId4
-    (Msg "message 5", Msg "message 6") <- tryDelPeekMsg q mId5
-    (Msg "message 6", Msg "message 7") <- tryDelPeekMsg q mId6
-    (Msg "message 7", Just MessageQuota {msgId = mId8}) <- tryDelPeekMsg q mId7
-    (Just MessageQuota {}, Nothing) <- tryDelPeekMsg q mId8
-    (Nothing, Nothing) <- tryDelPeekMsg q mId8
-    pure ()
-  delMsgQueue ms rId
+    Msg "message 5" <- tryPeekMsg ms rId q
+    (Nothing, Msg "message 5") <- tryDelPeekMsg ms rId q mId4
+    (Msg "message 5", Msg "message 6") <- tryDelPeekMsg ms rId q mId5
+    (Msg "message 6", Msg "message 7") <- tryDelPeekMsg ms rId q mId6
+    (Msg "message 7", Just MessageQuota {msgId = mId8}) <- tryDelPeekMsg ms rId q mId7
+    (Just MessageQuota {}, Nothing) <- tryDelPeekMsg ms rId q mId8
+    (Nothing, Nothing) <- tryDelPeekMsg ms rId q mId8
+    void $ ExceptT $ deleteQueue ms rId q
 
-testChangeReadJournal :: MsgStoreClass s => s -> IO ()
+testChangeReadJournal :: STMQueueStore s => s -> IO ()
 testChangeReadJournal ms = do
   g <- C.newRandom
-  rId <- EntityId <$> atomically (C.randomBytes 24 g)
+  (rId, qr) <- testNewQueueRec g True
   runRight_ $ do
-    q <- getMsgQueue ms rId
-    let write s = writeMsg ms q True =<< mkMessage s
+    q <- ExceptT $ addQueue ms qr
+    let write s = writeMsg ms rId q True =<< mkMessage s
     Just (Message {msgId = mId1}, True) <- write "message 1"
-    (Msg "message 1", Nothing) <- tryDelPeekMsg q mId1
+    (Msg "message 1", Nothing) <- tryDelPeekMsg ms rId q mId1
     Just (Message {msgId = mId2}, True) <- write "message 2"
-    (Msg "message 2", Nothing) <- tryDelPeekMsg q mId2
+    (Msg "message 2", Nothing) <- tryDelPeekMsg ms rId q mId2
     Just (Message {msgId = mId3}, True) <- write "message 3"
-    (Msg "message 3", Nothing) <- tryDelPeekMsg q mId3
+    (Msg "message 3", Nothing) <- tryDelPeekMsg ms rId q mId3
     Just (Message {msgId = mId4}, True) <- write "message 4"
-    (Msg "message 4", Nothing) <- tryDelPeekMsg q mId4
+    (Msg "message 4", Nothing) <- tryDelPeekMsg ms rId q mId4
     Just (Message {msgId = mId5}, True) <- write "message 5"
-    (Msg "message 5", Nothing) <- tryDelPeekMsg q mId5
-    pure ()
-  delMsgQueue ms rId
+    (Msg "message 5", Nothing) <- tryDelPeekMsg ms rId q mId5
+    void $ ExceptT $ deleteQueue ms rId q
 
 testExportImportStore :: JournalMsgStore -> IO ()
 testExportImportStore ms = do
   g <- C.newRandom
-  rId1 <- EntityId <$> atomically (C.randomBytes 24 g)
-  rId2 <- EntityId <$> atomically (C.randomBytes 24 g)
+  (rId1, qr1) <- testNewQueueRec g True
+  (rId2, qr2) <- testNewQueueRec g True
+  sl <- readWriteQueueStore testStoreLogFile ms
   runRight_ $ do
-    let write q s = writeMsg ms q True =<< mkMessage s
-    q1 <- getMsgQueue ms rId1
-    Just (Message {}, True) <- write q1 "message 1"
-    Just (Message {}, False) <- write q1 "message 2"
-    q2 <- getMsgQueue ms rId2
-    Just (Message {msgId = mId3}, True) <- write q2 "message 3"
-    Just (Message {msgId = mId4}, False) <- write q2 "message 4"
-    (Msg "message 3", Msg "message 4") <- tryDelPeekMsg q2 mId3
-    (Msg "message 4", Nothing) <- tryDelPeekMsg q2 mId4
-    Just (Message {}, True) <- write q2 "message 5"
-    Just (Message {}, False) <- write q2 "message 6"
-    Just (Message {}, False) <- write q2 "message 7"
-    Nothing <- write q2 "message 8"
+    let write rId q s = writeMsg ms rId q True =<< mkMessage s
+    q1 <- ExceptT $ addQueue ms qr1
+    liftIO $ logCreateQueue sl qr1
+    Just (Message {}, True) <- write rId1 q1 "message 1"
+    Just (Message {}, False) <- write rId1 q1 "message 2"
+    q2 <- ExceptT $ addQueue ms qr2
+    liftIO $ logCreateQueue sl qr2
+    Just (Message {msgId = mId3}, True) <- write rId2 q2 "message 3"
+    Just (Message {msgId = mId4}, False) <- write rId2 q2 "message 4"
+    (Msg "message 3", Msg "message 4") <- tryDelPeekMsg ms rId2 q2 mId3
+    (Msg "message 4", Nothing) <- tryDelPeekMsg ms rId2 q2 mId4
+    Just (Message {}, True) <- write rId2 q2 "message 5"
+    Just (Message {}, False) <- write rId2 q2 "message 6"
+    Just (Message {}, False) <- write rId2 q2 "message 7"
+    Nothing <- write rId2 q2 "message 8"
     pure ()
   length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
   length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 3
   exportMessages False ms testStoreMsgsFile False
   renameFile testStoreMsgsFile (testStoreMsgsFile <> ".copy")
   closeMsgStore ms
+  closeStoreLog sl
   exportMessages False ms testStoreMsgsFile False
   (B.readFile testStoreMsgsFile `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".copy")
   let cfg = (testJournalStoreCfg :: JournalStoreConfig) {storePath = testStoreMsgsDir2}
   ms' <- newMsgStore cfg
+  readWriteQueueStore testStoreLogFile ms' >>= closeStoreLog
   stats@MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
     importMessages False ms' testStoreMsgsFile Nothing
   printMessageStats "Messages" stats
@@ -183,6 +219,7 @@ testExportImportStore ms = do
   exportMessages False ms' testStoreMsgsFile2 False
   (B.readFile testStoreMsgsFile2 `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".bak")
   stmStore <- newMsgStore testSMTStoreConfig
+  readWriteQueueStore testStoreLogFile stmStore >>= closeStoreLog
   MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
     importMessages False stmStore testStoreMsgsFile2 Nothing
   exportMessages False stmStore testStoreMsgsFile False
@@ -256,24 +293,121 @@ testQueueState ms = do
 testMessageState :: JournalMsgStore -> IO ()
 testMessageState ms = do
   g <- C.newRandom
-  rId <- EntityId <$> atomically (C.randomBytes 24 g)
+  (rId, qr) <- testNewQueueRec g True
   let dir = msgQueueDirectory ms rId
       statePath = msgQueueStatePath dir $ B.unpack (B64.encode $ unEntityId rId)
-      write q s = writeMsg ms q True =<< mkMessage s
+      write q s = writeMsg ms rId q True =<< mkMessage s
 
   mId1 <- runRight $ do
-    q <- getMsgQueue ms rId
+    q <- ExceptT $ addQueue ms qr
     Just (Message {msgId = mId1}, True) <- write q "message 1"
     Just (Message {}, False) <- write q "message 2"
-    liftIO $ closeMsgQueue ms rId
+    liftIO $ closeMsgQueue q
     pure mId1
 
   ls <- B.lines <$> B.readFile statePath
   B.writeFile statePath $ B.unlines $ take (length ls - 1) ls
 
   runRight_ $ do
-    q <- getMsgQueue ms rId
+    q <- ExceptT $ getQueue ms SRecipient rId
     Just (Message {msgId = mId3}, False) <- write q "message 3"
-    (Msg "message 1", Msg "message 3") <- tryDelPeekMsg q mId1
-    (Msg "message 3", Nothing) <- tryDelPeekMsg q mId3
-    liftIO $ closeMsgQueueHandles q
+    (Msg "message 1", Msg "message 3") <- tryDelPeekMsg ms rId q mId1
+    (Msg "message 3", Nothing) <- tryDelPeekMsg ms rId q mId3
+    liftIO $ closeMsgQueue q
+
+testReadFileMissing :: JournalMsgStore -> IO ()
+testReadFileMissing ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g True
+  let write q s = writeMsg ms rId q True =<< mkMessage s
+  q <- runRight $ do
+    q <- ExceptT $ addQueue ms qr
+    Just (Message {}, True) <- write q "message 1"
+    Msg "message 1" <- tryPeekMsg ms rId q
+    pure q
+
+  mq <- fromJust <$> readTVarIO (msgQueue_' q)
+  MsgQueueState {readState = rs} <- readTVarIO $ state mq
+  closeMsgStore ms
+  let path = journalFilePath (queueDirectory $ queue mq) $ journalId rs
+  removeFile path
+
+  runRight_ $ do
+    q' <- ExceptT $ getQueue ms SRecipient rId
+    Nothing <- tryPeekMsg ms rId q'
+    Just (Message {}, True) <- write q' "message 2"
+    Msg "message 2" <- tryPeekMsg ms rId q'
+    pure ()
+
+testReadFileMissingSwitch :: JournalMsgStore -> IO ()
+testReadFileMissingSwitch ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g True
+  q <- writeMessages ms rId qr
+
+  mq <- fromJust <$> readTVarIO (msgQueue_' q)
+  MsgQueueState {readState = rs} <- readTVarIO $ state mq
+  closeMsgStore ms
+  let path = journalFilePath (queueDirectory $ queue mq) $ journalId rs
+  removeFile path
+
+  runRight_ $ do
+    q' <- ExceptT $ getQueue ms SRecipient rId
+    Just (Message {}, False) <- writeMsg ms rId q' True =<< mkMessage "message 6"
+    Msg "message 5" <- tryPeekMsg ms rId q'
+    pure ()
+
+testWriteFileMissing :: JournalMsgStore -> IO ()
+testWriteFileMissing ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g True
+  q <- writeMessages ms rId qr
+
+  mq <- fromJust <$> readTVarIO (msgQueue_' q)
+  MsgQueueState {writeState = ws} <- readTVarIO $ state mq
+  closeMsgStore ms
+  let path = journalFilePath (queueDirectory $ queue mq) $ journalId ws
+  print path
+  removeFile path
+
+  runRight_ $ do
+    q' <- ExceptT $ getQueue ms SRecipient rId
+    Just Message {msgId = mId3} <- tryPeekMsg ms rId q'
+    (Msg "message 3", Msg "message 4") <- tryDelPeekMsg ms rId q' mId3
+    Just Message {msgId = mId4} <- tryPeekMsg ms rId q'
+    (Msg "message 4", Nothing) <- tryDelPeekMsg ms rId q' mId4
+    Just (Message {}, True) <- writeMsg ms rId q' True =<< mkMessage "message 6"
+    Msg "message 6" <- tryPeekMsg ms rId q'
+    pure ()
+
+testReadAndWriteFilesMissing :: JournalMsgStore -> IO ()
+testReadAndWriteFilesMissing ms = do
+  g <- C.newRandom
+  (rId, qr) <- testNewQueueRec g True
+  q <- writeMessages ms rId qr
+
+  mq <- fromJust <$> readTVarIO (msgQueue_' q)
+  MsgQueueState {readState = rs, writeState = ws} <- readTVarIO $ state mq
+  closeMsgStore ms
+  removeFile $ journalFilePath (queueDirectory $ queue mq) $ journalId rs
+  removeFile $ journalFilePath (queueDirectory $ queue mq) $ journalId ws
+
+  runRight_ $ do
+    q' <- ExceptT $ getQueue ms SRecipient rId
+    Nothing <- tryPeekMsg ms rId q'
+    Just (Message {}, True) <- writeMsg ms rId q' True =<< mkMessage "message 6"
+    Msg "message 6" <- tryPeekMsg ms rId q'
+    pure ()
+
+writeMessages :: JournalMsgStore -> RecipientId -> QueueRec -> IO JournalQueue
+writeMessages ms rId qr = runRight $ do
+  q <- ExceptT $ addQueue ms qr
+  let write s = writeMsg ms rId q True =<< mkMessage s
+  Just (Message {msgId = mId1}, True) <- write "message 1"
+  Just (Message {msgId = mId2}, False) <- write "message 2"
+  Just (Message {}, False) <- write "message 3"
+  (Msg "message 1", Msg "message 2") <- tryDelPeekMsg ms rId q mId1
+  (Msg "message 2", Msg "message 3") <- tryDelPeekMsg ms rId q mId2
+  Just (Message {}, False) <- write "message 4"
+  Just (Message {}, False) <- write "message 5"
+  pure q
diff --git a/tests/CoreTests/StoreLogTests.hs b/tests/CoreTests/StoreLogTests.hs
index 7ee5767fd..e24f9f1ea 100644
--- a/tests/CoreTests/StoreLogTests.hs
+++ b/tests/CoreTests/StoreLogTests.hs
@@ -16,32 +16,17 @@ import Data.Either (partitionEithers)
 import qualified Data.Map.Strict as M
 import SMPClient
 import AgentTests.SQLiteTests
+import CoreTests.MsgStoreTests
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Server.StoreLog
+import Simplex.Messaging.Server.Env.STM (readWriteQueueStore)
+import Simplex.Messaging.Server.MsgStore.Journal
+import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
-import Simplex.Messaging.Server.QueueStore.STM (QueueStore (..), newQueueStore)
+import Simplex.Messaging.Server.StoreLog
 import Test.Hspec
 
-testNewQueueRec :: TVar ChaChaDRG -> Bool -> IO QueueRec
-testNewQueueRec g sndSecure = do
-  recipientId <- atomically $ EntityId <$> C.randomBytes 24 g
-  senderId <- atomically $ EntityId <$> C.randomBytes 24 g
-  (recipientKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
-  (k, pk) <- atomically $ C.generateKeyPair @'C.X25519 g
-  pure QueueRec
-    { recipientId,
-      recipientKey,
-      rcvDhSecret = C.dh' k pk,
-      senderId,
-      senderKey = Nothing,
-      sndSecure,
-      notifier = Nothing,
-      status = QueueActive,
-      updatedAt = Nothing
-    }
-
 testNtfCreds :: TVar ChaChaDRG -> IO NtfCreds
 testNtfCreds g = do
   (notifierKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
@@ -66,7 +51,7 @@ deriving instance Eq NtfCreds
 storeLogTests :: Spec
 storeLogTests =
   forM_ [False, True] $ \sndSecure -> do
-    (qr, ntfCreds, date) <- runIO $ do
+    ((rId, qr), ntfCreds, date) <- runIO $ do
       g <- C.newRandom
       (,,) <$> testNewQueueRec g sndSecure <*> testNtfCreds g <*> getSystemDate
     testSMPStoreLog ("SMP server store log, sndSecure = " <> show sndSecure)
@@ -74,37 +59,37 @@ storeLogTests =
           { name = "create new queue",
             saved = [CreateQueue qr],
             compacted = [CreateQueue qr],
-            state = M.fromList [(recipientId qr, qr)]
+            state = M.fromList [(rId, qr)]
           },
         SLTC
           { name = "secure queue",
-            saved = [CreateQueue qr, SecureQueue (recipientId qr) testPublicAuthKey],
+            saved = [CreateQueue qr, SecureQueue rId testPublicAuthKey],
             compacted = [CreateQueue qr {senderKey = Just testPublicAuthKey}],
-            state = M.fromList [(recipientId qr, qr {senderKey = Just testPublicAuthKey})]
+            state = M.fromList [(rId, qr {senderKey = Just testPublicAuthKey})]
           },          
         SLTC
           { name = "create and delete queue",
-            saved = [CreateQueue qr, DeleteQueue $ recipientId qr],
+            saved = [CreateQueue qr, DeleteQueue rId],
             compacted = [],
             state = M.fromList []
           },
         SLTC
           { name = "create queue and add notifier",
-            saved = [CreateQueue qr, AddNotifier (recipientId qr) ntfCreds],
+            saved = [CreateQueue qr, AddNotifier rId ntfCreds],
             compacted = [CreateQueue $ qr {notifier = Just ntfCreds}],
-            state = M.fromList [(recipientId qr, qr {notifier = Just ntfCreds})]
+            state = M.fromList [(rId, qr {notifier = Just ntfCreds})]
           },
         SLTC
           { name = "delete notifier",
-            saved = [CreateQueue qr, AddNotifier (recipientId qr) ntfCreds, DeleteNotifier (recipientId qr)],
+            saved = [CreateQueue qr, AddNotifier rId ntfCreds, DeleteNotifier rId],
             compacted = [CreateQueue qr],
-            state = M.fromList [(recipientId qr, qr)]
+            state = M.fromList [(rId, qr)]
           },
         SLTC
           { name = "update time",
-            saved = [CreateQueue qr, UpdateTime (recipientId qr) date],
+            saved = [CreateQueue qr, UpdateTime rId date],
             compacted = [CreateQueue qr {updatedAt = Just date}],
-            state = M.fromList [(recipientId qr, qr {updatedAt = Just date})]
+            state = M.fromList [(rId, qr {updatedAt = Just date})]
           }          
       ]
 
@@ -117,11 +102,11 @@ testSMPStoreLog testSuite tests =
     replicateM_ 3 $ testReadWrite t
   where
     testReadWrite SLTC {compacted, state} = do
-      st <- newQueueStore
+      st <- newMsgStore testJournalStoreCfg
       l <- readWriteQueueStore testStoreLogFile st
       storeState st `shouldReturn` state
       closeStoreLog l
       ([], compacted') <- partitionEithers . map strDecode . B.lines <$> B.readFile testStoreLogFile
       compacted' `shouldBe` compacted
-    storeState :: QueueStore -> IO (M.Map RecipientId QueueRec)
-    storeState st = readTVarIO (queues st) >>= mapM readTVarIO
+    storeState :: JournalMsgStore -> IO (M.Map RecipientId QueueRec)
+    storeState st = M.mapMaybe id <$> (readTVarIO (queues st) >>= mapM (readTVarIO . queueRec'))
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index e80d39897..28073d5e4 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -37,11 +37,12 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server (exportMessages)
-import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
+import Simplex.Messaging.Server.Env.STM (ServerConfig (..), readWriteQueueStore)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore.Journal (JournalStoreConfig (..))
 import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..), newMsgStore)
 import Simplex.Messaging.Server.Stats (PeriodStatsData (..), ServerStatsData (..))
+import Simplex.Messaging.Server.StoreLog (closeStoreLog)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Util (whenM)
 import Simplex.Messaging.Version (mkVersionRange)
@@ -812,6 +813,7 @@ testRestoreExpireMessages =
     exportStoreMessages = \case
       AMSType SMSJournal -> do
         ms <- newMsgStore testJournalStoreCfg {quota = 4}
+        readWriteQueueStore testStoreLogFile ms >>= closeStoreLog
         removeFileIfExists testStoreMsgsFile
         exportMessages False ms testStoreMsgsFile False
       AMSType SMSMemory -> pure ()

From 3017d143924d837c941ebf2f378437d5a8e3caea Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 7 Nov 2024 08:13:45 +0000
Subject: [PATCH 188/195] 6.2.0.2

---
 simplexmq.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 9dd60595b..25969b2ff 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           simplexmq
-version:        6.2.0.101
+version:        6.2.0.2
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 17a0be10fa4bf90d5afc3e0f0119caeb5cbdacc1 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 15 Nov 2024 10:26:24 +0000
Subject: [PATCH 189/195] smp server: expire messages in idle message queues
 (including not opened) (#1403)

* smp server: expire messages in idle message queues (including not opened)

* use message expiration interval

* simpler

* version

* remove version
---
 src/Simplex/Messaging/Server.hs               | 21 ++++-----
 src/Simplex/Messaging/Server/Env/STM.hs       |  5 +-
 src/Simplex/Messaging/Server/Main.hs          |  2 +-
 .../Messaging/Server/MsgStore/Journal.hs      | 46 +++++++++++++------
 src/Simplex/Messaging/Server/MsgStore/STM.hs  | 12 +++--
 .../Messaging/Server/MsgStore/Types.hs        | 35 ++++++++++----
 tests/AgentTests/FunctionalAPITests.hs        |  5 +-
 tests/CoreTests/MsgStoreTests.hs              |  3 +-
 tests/CoreTests/RetryIntervalTests.hs         |  2 +-
 9 files changed, 84 insertions(+), 47 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index b0e499d3f..3d8fac5e4 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -296,7 +296,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
         deliverNtfs ns stats (AClient _ Client {clientId, ntfSubscriptions, sndQ, connected}) =
           whenM (currentClient readTVarIO) $ do
             subs <- readTVarIO ntfSubscriptions
-            logDebug $ "NOTIFICATIONS: client #" <> tshow clientId <> " is current with " <> tshow (M.size subs) <> " subs"
             ntfQs <- M.assocs . M.filterWithKey (\nId _ -> M.member nId subs) <$> readTVarIO ns
             tryAny (atomically $ flushSubscribedNtfs ntfQs) >>= \case
               Right len -> updateNtfStats len
@@ -321,12 +320,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
                   writeTVar v []
                   pure $ foldl' (\acc' ntf -> nmsg nId ntf : acc') acc ntfs -- reverses, to order by time
             nmsg nId MsgNtf {ntfNonce, ntfEncMeta} = (CorrId "", nId, NMSG ntfNonce ntfEncMeta)
-            updateNtfStats 0 = logDebug $ "NOTIFICATIONS: no ntfs for client #" <> tshow clientId
+            updateNtfStats 0 = pure ()
             updateNtfStats len = liftIO $ do
               atomicModifyIORef'_ (ntfCount stats) (subtract len)
               atomicModifyIORef'_ (msgNtfs stats) (+ len)
               atomicModifyIORef'_ (msgNtfsB stats) (+ (len `div` 80 + 1)) -- up to 80 NMSG in the batch
-              logDebug $ "NOTIFICATIONS: delivered to client #" <> tshow clientId <> " " <> tshow len <> " ntfs"
 
     sendPendingEvtsThread :: Server -> M ()
     sendPendingEvtsThread s = do
@@ -386,13 +384,13 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
       liftIO $ forever $ do
         threadDelay' interval
         old <- expireBeforeEpoch expCfg
-        Sum deleted <- withActiveMsgQueues ms $ expireQueueMsgs stats old
+        now <- systemSeconds <$> getSystemTime
+        Sum deleted <- withActiveMsgQueues ms $ expireQueueMsgs now ms old
+        atomicModifyIORef'_ (msgExpired stats) (+ deleted)
         logInfo $ "STORE: expireMessagesThread, expired " <> tshow deleted <> " messages"
       where
-        expireQueueMsgs stats old rId q =
-          runExceptT (deleteExpiredMsgs rId q True old) >>= \case
-            Right deleted -> Sum deleted <$ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
-            Left _ -> pure 0
+        expireQueueMsgs now ms old rId q =
+          either (const 0) Sum <$> runExceptT (idleDeleteExpiredMsgs now ms rId q old)
 
     expireNtfsThread :: ServerConfig -> M ()
     expireNtfsThread ServerConfig {notificationExpiration = expCfg} = do
@@ -1469,7 +1467,7 @@ client
 
             expireMessages :: Maybe ExpirationConfig -> ServerStats -> ExceptT ErrorType IO ()
             expireMessages msgExp stats = do
-              deleted <- maybe (pure 0) (deleteExpiredMsgs (recipientId qr) q True <=< liftIO . expireBeforeEpoch) msgExp
+              deleted <- maybe (pure 0) (deleteExpiredMsgs ms (recipientId qr) q <=< liftIO . expireBeforeEpoch) msgExp
               liftIO $ when (deleted > 0) $ atomicModifyIORef'_ (msgExpired stats) (+ deleted)
 
             -- The condition for delivery of the message is:
@@ -1763,9 +1761,8 @@ processServerMessages = do
                   exitFailure
               where
                 expireQueue = do
-                  expired'' <- deleteExpiredMsgs rId q False old
+                  expired'' <- deleteExpiredMsgs ms rId q old
                   stored'' <- getQueueSize ms rId q
-                  liftIO $ logQueueState q
                   liftIO $ closeMsgQueue q
                   pure (stored'', expired'')
             processValidateQueue :: RecipientId -> JournalQueue -> IO MessageStats
@@ -1823,7 +1820,7 @@ importMessages tty ms f old_ = do
                 -- if the first message in queue head is "quota", remove it.
                 mergeQuotaMsgs = withMsgQueue ms rId q "mergeQuotaMsgs" $ \mq ->
                   tryPeekMsg_ mq >>= \case
-                    Just MessageQuota {} -> tryDeleteMsg_ mq False
+                    Just MessageQuota {} -> tryDeleteMsg_ q mq False
                     _ -> pure ()
         msgErr :: Show e => String -> e -> String
         msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 5e60757c1..9e0b65beb 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -121,7 +121,7 @@ defaultMessageExpiration :: ExpirationConfig
 defaultMessageExpiration =
   ExpirationConfig
     { ttl = defMsgExpirationDays * 86400, -- seconds
-      checkInterval = 43200 -- seconds, 12 hours
+      checkInterval = 21600 -- seconds, 6 hours
     }
 
 defNtfExpirationHours :: Int64
@@ -290,7 +290,8 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, msgSt
     AMSType SMSMemory -> AMS SMSMemory <$> newMsgStore STMStoreConfig {storePath = storeMsgsFile, quota = msgQueueQuota}
     AMSType SMSJournal -> case storeMsgsFile of
       Just storePath -> 
-        let cfg = JournalStoreConfig {storePath, quota = msgQueueQuota, pathParts = journalMsgStoreDepth, maxMsgCount = maxJournalMsgCount, maxStateLines = maxJournalStateLines, stateTailSize = defaultStateTailSize}
+        let idleInterval = maybe maxBound checkInterval messageExpiration
+            cfg = JournalStoreConfig {storePath, quota = msgQueueQuota, pathParts = journalMsgStoreDepth, maxMsgCount = maxJournalMsgCount, maxStateLines = maxJournalStateLines, stateTailSize = defaultStateTailSize, idleInterval}
          in AMS SMSJournal <$> newMsgStore cfg
       Nothing -> putStrLn "Error: journal msg store require path in [STORE_LOG], restore_messages" >> exitFailure
   ntfStore <- NtfStore <$> TM.emptyIO
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 79709d3eb..8b189c6f7 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -148,7 +148,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       doesFileExist iniFile >>= \case
         True -> readIniFile iniFile >>= either exitError a
         _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
-    newJournalMsgStore = newMsgStore JournalStoreConfig {storePath = storeMsgsJournalDir, pathParts = journalMsgStoreDepth, quota = defaultMsgQueueQuota, maxMsgCount = defaultMaxJournalMsgCount, maxStateLines = defaultMaxJournalStateLines, stateTailSize = defaultStateTailSize}
+    newJournalMsgStore = newMsgStore JournalStoreConfig {storePath = storeMsgsJournalDir, pathParts = journalMsgStoreDepth, quota = defaultMsgQueueQuota, maxMsgCount = defaultMaxJournalMsgCount, maxStateLines = defaultMaxJournalStateLines, stateTailSize = defaultStateTailSize, idleInterval = checkInterval defaultMessageExpiration}
     iniFile = combine cfgPath "smp-server.ini"
     serverVersion = "SMP server v" <> simplexMQVersion
     defaultServerPorts = "5223,443"
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index 0310a5991..3df894652 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -53,6 +53,7 @@ import Data.List (intercalate)
 import Data.Maybe (catMaybes, fromMaybe)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
+import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import GHC.IO (catchAny)
 import Simplex.Messaging.Agent.Client (getMapLock, withLockMap)
@@ -92,7 +93,9 @@ data JournalStoreConfig = JournalStoreConfig
     -- This number should be set bigger than queue quota.
     maxMsgCount :: Int,
     maxStateLines :: Int,
-    stateTailSize :: Int
+    stateTailSize :: Int,
+    -- time in seconds after which the queue will be closed after message expiration
+    idleInterval :: Int64
   }
 
 data JournalQueue = JournalQueue
@@ -100,7 +103,9 @@ data JournalQueue = JournalQueue
     -- To avoid race conditions and errors when restoring queues,
     -- Nothing is written to TVar when queue is deleted.
     queueRec :: TVar (Maybe QueueRec),
-    msgQueue_ :: TVar (Maybe JournalMsgQueue)
+    msgQueue_ :: TVar (Maybe JournalMsgQueue),
+    -- system time in seconds since epoch
+    activeAt :: TVar Int64
   }
 
 data JMQueue = JMQueue
@@ -221,7 +226,8 @@ instance STMQueueStore JournalMsgStore where
     lock <- getMapLock (queueLocks st) $ recipientId qr
     q <- newTVar $! Just qr
     mq <- newTVar Nothing
-    pure $ JournalQueue lock q mq
+    activeAt <- newTVar 0
+    pure $ JournalQueue lock q mq activeAt
   msgQueue_' = msgQueue_
 
 instance MsgStoreClass JournalMsgStore where
@@ -295,11 +301,11 @@ instance MsgStoreClass JournalMsgStore where
               (Nothing <$ putStrLn ("Error: path " <> path' <> " is not a directory, skipping"))
 
   logQueueStates :: JournalMsgStore -> IO ()
-  logQueueStates ms = withActiveMsgQueues ms $ \_ -> logQueueState
+  logQueueStates ms = withActiveMsgQueues ms $ \_ -> unStoreIO . logQueueState
 
-  logQueueState :: JournalQueue -> IO ()
+  logQueueState :: JournalQueue -> StoreIO ()
   logQueueState q =
-    void $
+    StoreIO . void $
       readTVarIO (msgQueue_ q)
         $>>= \mq -> readTVarIO (handles mq)
         $>>= (\hs -> (readTVarIO (state mq) >>= appendState (stateHandle hs)) $> Just ())
@@ -326,9 +332,20 @@ instance MsgStoreClass JournalMsgStore where
             journalId <- newJournalId random
             mkJournalQueue queue (newMsgQueueState journalId) Nothing
 
-  openedMsgQueue :: JournalQueue -> StoreIO (Maybe JournalMsgQueue)
-  openedMsgQueue = StoreIO . readTVarIO . msgQueue_
-  {-# INLINE openedMsgQueue #-}
+  withIdleMsgQueue :: Int64 -> JournalMsgStore -> RecipientId -> JournalQueue -> (JournalMsgQueue -> StoreIO a) -> StoreIO (Maybe a)
+  withIdleMsgQueue now ms@JournalMsgStore {config} rId q action =
+    StoreIO $ readTVarIO (msgQueue_ q) >>= \case
+      Nothing ->
+        Just <$>
+          E.bracket
+            (unStoreIO $ getMsgQueue ms rId q)
+            (\_ -> closeMsgQueue q)
+            (unStoreIO . action)
+      Just mq -> do
+        ts <- readTVarIO $ activeAt q
+        if now - ts >= idleInterval config
+          then Just <$> unStoreIO (action mq) `E.finally` closeMsgQueue q
+          else pure Nothing
 
   deleteQueue :: JournalMsgStore -> RecipientId -> JournalQueue -> IO (Either ErrorType QueueRec)
   deleteQueue ms rId q =
@@ -355,7 +372,7 @@ instance MsgStoreClass JournalMsgStore where
   writeMsg :: JournalMsgStore -> RecipientId -> JournalQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
   writeMsg ms rId q' logState msg = isolateQueue rId q' "writeMsg" $ do
     q <- getMsgQueue ms rId q'
-    StoreIO $ do
+    StoreIO $ (`E.finally` updateActiveAt q') $ do
       st@MsgQueueState {canWrite, size} <- readTVarIO (state q)
       let empty = size == 0
       if canWrite || empty
@@ -419,18 +436,21 @@ instance MsgStoreClass JournalMsgStore where
             atomically $ writeTVar tipMsg $ Just (Just ml)
             pure $ Just msg
 
-  tryDeleteMsg_ :: JournalMsgQueue -> Bool -> StoreIO ()
-  tryDeleteMsg_ q@JournalMsgQueue {tipMsg, handles} logState = StoreIO $
+  tryDeleteMsg_ :: JournalQueue -> JournalMsgQueue -> Bool -> StoreIO ()
+  tryDeleteMsg_ q mq@JournalMsgQueue {tipMsg, handles} logState = StoreIO $ (`E.finally` when logState (updateActiveAt q)) $
     void $
       readTVarIO tipMsg -- if there is no cached tipMsg, do nothing
         $>>= (pure . fmap snd)
         $>>= \len -> readTVarIO handles
-        $>>= \hs -> updateReadPos q logState len hs $> Just ()
+        $>>= \hs -> updateReadPos mq logState len hs $> Just ()
 
   isolateQueue :: RecipientId -> JournalQueue -> String -> StoreIO a -> ExceptT ErrorType IO a
   isolateQueue rId JournalQueue {queueLock} op =
     tryStore' op rId . withLock' queueLock op . unStoreIO
 
+updateActiveAt :: JournalQueue -> IO ()
+updateActiveAt q = atomically . writeTVar (activeAt q) . systemSeconds =<< getSystemTime
+
 tryStore' :: String -> RecipientId -> IO a -> ExceptT ErrorType IO a
 tryStore' op rId = tryStore op rId . fmap Right
 
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index b1412421c..33c91374c 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -21,6 +21,7 @@ import Control.Concurrent.STM
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import Data.Functor (($>))
+import Data.Int (Int64)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
@@ -108,9 +109,10 @@ instance MsgStoreClass STMMsgStore where
         writeTVar msgQueue_ $! Just q
         pure q
 
-  openedMsgQueue :: STMQueue -> STM (Maybe STMMsgQueue)
-  openedMsgQueue = readTVar . msgQueue_
-  {-# INLINE openedMsgQueue #-}
+  -- does not create queue if it does not exist, does not delete it if it does (can't just close in-memory queue)
+  withIdleMsgQueue :: Int64 -> STMMsgStore -> RecipientId -> STMQueue -> (STMMsgQueue -> STM a) -> STM (Maybe a)
+  withIdleMsgQueue _ _ _ STMQueue {msgQueue_} action = readTVar msgQueue_ >>= mapM action
+  {-# INLINE withIdleMsgQueue #-}
 
   deleteQueue :: STMMsgStore -> RecipientId -> STMQueue -> IO (Either ErrorType QueueRec)
   deleteQueue ms rId q = fst <$$> deleteQueue' ms rId q
@@ -157,8 +159,8 @@ instance MsgStoreClass STMMsgStore where
   tryPeekMsg_ = tryPeekTQueue . msgQueue
   {-# INLINE tryPeekMsg_ #-}
 
-  tryDeleteMsg_ :: STMMsgQueue -> Bool -> STM ()
-  tryDeleteMsg_ STMMsgQueue {msgQueue = q, size} _logState =
+  tryDeleteMsg_ :: STMQueue -> STMMsgQueue -> Bool -> STM ()
+  tryDeleteMsg_ _ STMMsgQueue {msgQueue = q, size} _logState =
     tryReadTQueue q >>= \case
       Just _ -> modifyTVar' size (subtract 1)
       _ -> pure ()
diff --git a/src/Simplex/Messaging/Server/MsgStore/Types.hs b/src/Simplex/Messaging/Server/MsgStore/Types.hs
index 28f250b70..33d376a20 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Types.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Types.hs
@@ -15,6 +15,7 @@ import Control.Monad (foldM)
 import Control.Monad.Trans.Except
 import Data.Int (Int64)
 import Data.Kind
+import Data.Maybe (fromMaybe)
 import qualified Data.Map.Strict as M
 import Data.Time.Clock.System (SystemTime (systemSeconds))
 import Simplex.Messaging.Protocol
@@ -42,10 +43,11 @@ class Monad (StoreMonad s) => MsgStoreClass s where
   activeMsgQueues :: s -> TMap RecipientId (StoreQueue s)
   withAllMsgQueues :: Monoid a => Bool -> s -> (RecipientId -> StoreQueue s -> IO a) -> IO a
   logQueueStates :: s -> IO ()
-  logQueueState :: StoreQueue s -> IO ()
+  logQueueState :: StoreQueue s -> StoreMonad s ()
   queueRec' :: StoreQueue s -> TVar (Maybe QueueRec)
   getMsgQueue :: s -> RecipientId -> StoreQueue s -> StoreMonad s (MsgQueue s)
-  openedMsgQueue :: StoreQueue s -> StoreMonad s (Maybe (MsgQueue s))
+  -- the journal queue will be closed after action if it was initially closed or idle longer than interval in config
+  withIdleMsgQueue :: Int64 -> s -> RecipientId -> StoreQueue s -> (MsgQueue s -> StoreMonad s a) -> StoreMonad s (Maybe a)
   deleteQueue :: s -> RecipientId -> StoreQueue s -> IO (Either ErrorType QueueRec)
   deleteQueueSize :: s -> RecipientId -> StoreQueue s -> IO (Either ErrorType (QueueRec, Int))
   getQueueMessages_ :: Bool -> MsgQueue s -> StoreMonad s [Message]
@@ -53,7 +55,7 @@ class Monad (StoreMonad s) => MsgStoreClass s where
   setOverQuota_ :: StoreQueue s -> IO () -- can ONLY be used while restoring messages, not while server running
   getQueueSize_ :: MsgQueue s -> StoreMonad s Int
   tryPeekMsg_ :: MsgQueue s -> StoreMonad s (Maybe Message)
-  tryDeleteMsg_ :: MsgQueue s -> Bool -> StoreMonad s ()
+  tryDeleteMsg_ :: StoreQueue s -> MsgQueue s -> Bool -> StoreMonad s ()
   isolateQueue :: RecipientId -> StoreQueue s -> String -> StoreMonad s a -> ExceptT ErrorType IO a
 
 data MSType = MSMemory | MSJournal
@@ -89,7 +91,7 @@ tryDelMsg st rId q msgId' =
     tryPeekMsg_ mq >>= \case
       msg_@(Just msg)
         | messageId msg == msgId' ->
-            tryDeleteMsg_ mq True >> pure msg_
+            tryDeleteMsg_ q mq True >> pure msg_
       _ -> pure Nothing
 
 -- atomic delete (== read) last and peek next message if available
@@ -98,7 +100,7 @@ tryDelPeekMsg st rId q msgId' =
   withMsgQueue st rId q "tryDelPeekMsg" $ \mq ->
     tryPeekMsg_ mq >>= \case
       msg_@(Just msg)
-        | messageId msg == msgId' -> (msg_,) <$> (tryDeleteMsg_ mq True >> tryPeekMsg_ mq)
+        | messageId msg == msgId' -> (msg_,) <$> (tryDeleteMsg_ q mq True >> tryPeekMsg_ mq)
         | otherwise -> pure (Nothing, msg_)
       _ -> pure (Nothing, Nothing)
 
@@ -106,13 +108,26 @@ withMsgQueue :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> String ->
 withMsgQueue st rId q op a = isolateQueue rId q op $ getMsgQueue st rId q >>= a
 {-# INLINE withMsgQueue #-}
 
-deleteExpiredMsgs :: MsgStoreClass s => RecipientId -> StoreQueue s -> Bool -> Int64 -> ExceptT ErrorType IO Int
-deleteExpiredMsgs rId q logState old =
-  isolateQueue rId q "deleteExpiredMsgs" $ openedMsgQueue q >>= maybe (pure 0) (loop 0)
+deleteExpiredMsgs :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> Int64 -> ExceptT ErrorType IO Int
+deleteExpiredMsgs st rId q old =
+  isolateQueue rId q "deleteExpiredMsgs" $
+    getMsgQueue st rId q >>= deleteExpireMsgs_ old q
+
+-- closed and idle queues will be closed after expiration
+idleDeleteExpiredMsgs :: MsgStoreClass s => Int64 -> s -> RecipientId -> StoreQueue s -> Int64 -> ExceptT ErrorType IO Int
+idleDeleteExpiredMsgs now st rId q old =
+  isolateQueue rId q "idleDeleteExpiredMsgs" $ 
+    fromMaybe 0 <$> withIdleMsgQueue now st rId q (deleteExpireMsgs_ old q)
+
+deleteExpireMsgs_ :: MsgStoreClass s => Int64 -> StoreQueue s -> MsgQueue s -> StoreMonad s Int
+deleteExpireMsgs_ old q mq = do
+  n <- loop 0
+  logQueueState q
+  pure n
   where
-    loop dc mq =
+    loop dc =
       tryPeekMsg_ mq >>= \case
         Just Message {msgTs}
           | systemSeconds msgTs < old ->
-              tryDeleteMsg_ mq logState >> loop (dc + 1) mq
+              tryDeleteMsg_ q mq False >> loop (dc + 1)
         _ -> pure dc
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 55fc8070f..b281d8001 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -3076,8 +3076,9 @@ testTwoUsers = withAgentClients2 $ \a b -> do
     ("", "", DOWN _ _) <- nGet a
     ("", "", DOWN _ _) <- nGet a
     ("", "", DOWN _ _) <- nGet a
-    ("", "", DOWN _ _) <- nGet a
-    ("", "", UP _ _) <- nGet a
+    -- to avoice race condition
+    nGet a =##> \case ("", "", DOWN _ _) -> True; ("", "", UP _ _) -> True; _ -> False
+    nGet a =##> \case ("", "", UP _ _) -> True; ("", "", DOWN _ _) -> True; _ -> False
     ("", "", UP _ _) <- nGet a
     ("", "", UP _ _) <- nGet a
     ("", "", UP _ _) <- nGet a
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index 4fc48d6c7..35c27c22e 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -77,7 +77,8 @@ testJournalStoreCfg =
       quota = 3,
       maxMsgCount = 4,
       maxStateLines = 2,
-      stateTailSize = 256
+      stateTailSize = 256,
+      idleInterval = 21600
     }
 
 mkMessage :: MonadIO m => ByteString -> m Message
diff --git a/tests/CoreTests/RetryIntervalTests.hs b/tests/CoreTests/RetryIntervalTests.hs
index da96d0208..d4eee9ed6 100644
--- a/tests/CoreTests/RetryIntervalTests.hs
+++ b/tests/CoreTests/RetryIntervalTests.hs
@@ -66,7 +66,7 @@ testRetryIntervalSameMode =
 
 testRetryIntervalSwitchMode :: Spec
 testRetryIntervalSwitchMode =
-  it "should increase elapased time and interval when the mode stays the same" $ do
+  it "should increase elapased time and interval when the mode switches" $ do
     lock <- newEmptyTMVarIO
     intervals <- newTVarIO []
     reportedIntervals <- newTVarIO []

From 21fbbf9106e5403befb046cdc8b1f119976a9fed Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 17 Nov 2024 09:44:40 +0000
Subject: [PATCH 190/195] smp server: update message counts during message
 expiration, increase idle interval (#1404)

* smp server: update message counts during message expiration, increase idle interval

* version

* fix

* flip results

* version
---
 simplexmq.cabal                               |  2 +-
 src/Simplex/Messaging/Server.hs               | 41 +++++++++++--------
 src/Simplex/Messaging/Server/Env/STM.hs       | 12 ++++--
 src/Simplex/Messaging/Server/Main.hs          |  1 +
 .../Messaging/Server/MsgStore/Journal.hs      | 15 +++----
 src/Simplex/Messaging/Server/MsgStore/STM.hs  | 10 +++--
 .../Messaging/Server/MsgStore/Types.hs        | 10 ++---
 tests/SMPClient.hs                            |  1 +
 tests/ServerTests.hs                          |  2 +-
 9 files changed, 55 insertions(+), 39 deletions(-)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 25969b2ff..7cee47e0d 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           simplexmq
-version:        6.2.0.2
+version:        6.2.0.3
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 3d8fac5e4..4b78f3cb4 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -163,11 +163,11 @@ smpServer :: TMVar Bool -> ServerConfig -> Maybe AttachHTTP -> M ()
 smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHTTP_ = do
   s <- asks server
   pa <- asks proxyAgent
-  msgStats <- processServerMessages
+  msgStats_ <- processServerMessages
   ntfStats <- restoreServerNtfs
-  liftIO $ printMessageStats "messages" msgStats
+  liftIO $ mapM_ (printMessageStats "messages") msgStats_
   liftIO $ printMessageStats "notifications" ntfStats
-  restoreServerStats msgStats ntfStats
+  restoreServerStats msgStats_ ntfStats
   raceAny_
     ( serverThread s "server subscribedQ" subscribedQ subscribers subClients pendingSubEvents subscriptions cancelSub
         : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubClients pendingNtfSubEvents ntfSubscriptions (\_ -> pure ())
@@ -385,12 +385,15 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} attachHT
         threadDelay' interval
         old <- expireBeforeEpoch expCfg
         now <- systemSeconds <$> getSystemTime
-        Sum deleted <- withActiveMsgQueues ms $ expireQueueMsgs now ms old
-        atomicModifyIORef'_ (msgExpired stats) (+ deleted)
-        logInfo $ "STORE: expireMessagesThread, expired " <> tshow deleted <> " messages"
+        msgStats@MessageStats {storedMsgsCount = stored, expiredMsgsCount = expired} <-
+          withActiveMsgQueues ms $ expireQueueMsgs now ms old
+        atomicWriteIORef (msgCount stats) stored
+        atomicModifyIORef'_ (msgExpired stats) (+ expired)
+        printMessageStats "STORE: messages" msgStats
       where
-        expireQueueMsgs now ms old rId q =
-          either (const 0) Sum <$> runExceptT (idleDeleteExpiredMsgs now ms rId q old)
+        expireQueueMsgs now ms old rId q = fmap (fromRight newMessageStats) . runExceptT $ do
+          (expired_, stored) <- idleDeleteExpiredMsgs now ms rId q old
+          pure MessageStats {storedMsgsCount = stored, expiredMsgsCount = fromMaybe 0 expired_, storedQueues = 1}
 
     expireNtfsThread :: ServerConfig -> M ()
     expireNtfsThread ServerConfig {notificationExpiration = expCfg} = do
@@ -1731,26 +1734,26 @@ exportMessages tty ms f drainMsgs = do
           exitFailure
     encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
 
-processServerMessages :: M MessageStats
+processServerMessages :: M (Maybe MessageStats)
 processServerMessages = do
   old_ <- asks (messageExpiration . config) $>>= (liftIO . fmap Just . expireBeforeEpoch)
   expire <- asks $ expireMessagesOnStart . config
   asks msgStore >>= liftIO . processMessages old_ expire
     where
-      processMessages :: Maybe Int64 -> Bool -> AMsgStore -> IO MessageStats
+      processMessages :: Maybe Int64 -> Bool -> AMsgStore -> IO (Maybe MessageStats)
       processMessages old_ expire = \case
         AMS SMSMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-          Just f -> ifM (doesFileExist f) (importMessages False ms f old_) (pure newMessageStats)
-          Nothing -> pure newMessageStats
+          Just f -> ifM (doesFileExist f) (Just <$> importMessages False ms f old_) (pure Nothing)
+          Nothing -> pure Nothing
         AMS SMSJournal ms
-          | expire -> case old_ of
+          | expire -> Just <$> case old_ of
               Just old -> do
                 logInfo "expiring journal store messages..."
                 withAllMsgQueues False ms $ processExpireQueue old
               Nothing -> do
                 logInfo "validating journal store messages..."
                 withAllMsgQueues False ms $ processValidateQueue
-          | otherwise -> logWarn "skipping message expiration" $> newMessageStats
+          | otherwise -> logWarn "skipping message expiration" $> Nothing
           where
             processExpireQueue old rId q =
               runExceptT expireQueue >>= \case
@@ -1887,8 +1890,8 @@ saveServerStats =
       B.writeFile f $ strEncode stats
       logInfo "server stats saved"
 
-restoreServerStats :: MessageStats -> MessageStats -> M ()
-restoreServerStats msgStats ntfStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
+restoreServerStats :: Maybe MessageStats -> MessageStats -> M ()
+restoreServerStats msgStats_ ntfStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
   where
     restoreStats f = whenM (doesFileExist f) $ do
       logInfo $ "restoring server stats from file " <> T.pack f
@@ -1897,9 +1900,11 @@ restoreServerStats msgStats ntfStats = asks (serverStatsBackupFile . config) >>=
           s <- asks serverStats
           AMS _ st <- asks msgStore
           _qCount <- M.size <$> readTVarIO (activeMsgQueues st)
-          let _msgCount = storedMsgsCount msgStats
+          let _msgCount = maybe statsMsgCount storedMsgsCount msgStats_
               _ntfCount = storedMsgsCount ntfStats
-          liftIO $ setServerStats s d {_qCount, _msgCount, _ntfCount, _msgExpired = _msgExpired d + expiredMsgsCount msgStats, _msgNtfExpired = _msgNtfExpired d + expiredMsgsCount ntfStats}
+              _msgExpired' = _msgExpired d + maybe 0 expiredMsgsCount msgStats_
+              _msgNtfExpired' = _msgNtfExpired d + expiredMsgsCount ntfStats
+          liftIO $ setServerStats s d {_qCount, _msgCount, _ntfCount, _msgExpired = _msgExpired', _msgNtfExpired = _msgNtfExpired'}
           renameFile f $ f <> ".bak"
           logInfo "server stats restored"
           compareCounts "Queue" statsQCount _qCount
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 9e0b65beb..f598bdcb8 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -80,6 +80,8 @@ data ServerConfig = ServerConfig
     -- | time after which the messages can be removed from the queues and check interval, seconds
     messageExpiration :: Maybe ExpirationConfig,
     expireMessagesOnStart :: Bool,
+    -- | interval of inactivity after which journal queue is closed
+    idleQueueInterval :: Int64,
     -- | notification expiration interval (seconds)
     notificationExpiration :: ExpirationConfig,
     -- | time after which the socket with inactive client can be disconnected (without any messages or commands, incl. PING),
@@ -121,9 +123,12 @@ defaultMessageExpiration :: ExpirationConfig
 defaultMessageExpiration =
   ExpirationConfig
     { ttl = defMsgExpirationDays * 86400, -- seconds
-      checkInterval = 21600 -- seconds, 6 hours
+      checkInterval = 14400 -- seconds, 4 hours
     }
 
+defaultIdleQueueInterval :: Int64
+defaultIdleQueueInterval = 28800 -- seconds, 8 hours
+
 defNtfExpirationHours :: Int64
 defNtfExpirationHours = 24
 
@@ -283,15 +288,14 @@ newProhibitedSub = do
   return Sub {subThread = ProhibitSub, delivered}
 
 newEnv :: ServerConfig -> IO Env
-newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, msgStoreType, storeMsgsFile, smpAgentCfg, information, messageExpiration, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines} = do
+newEnv config@ServerConfig {smpCredentials, httpCredentials, storeLogFile, msgStoreType, storeMsgsFile, smpAgentCfg, information, messageExpiration, idleQueueInterval, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines} = do
   serverActive <- newTVarIO True
   server <- newServer
   msgStore@(AMS _ store) <- case msgStoreType of
     AMSType SMSMemory -> AMS SMSMemory <$> newMsgStore STMStoreConfig {storePath = storeMsgsFile, quota = msgQueueQuota}
     AMSType SMSJournal -> case storeMsgsFile of
       Just storePath -> 
-        let idleInterval = maybe maxBound checkInterval messageExpiration
-            cfg = JournalStoreConfig {storePath, quota = msgQueueQuota, pathParts = journalMsgStoreDepth, maxMsgCount = maxJournalMsgCount, maxStateLines = maxJournalStateLines, stateTailSize = defaultStateTailSize, idleInterval}
+        let cfg = JournalStoreConfig {storePath, quota = msgQueueQuota, pathParts = journalMsgStoreDepth, maxMsgCount = maxJournalMsgCount, maxStateLines = maxJournalStateLines, stateTailSize = defaultStateTailSize, idleInterval = idleQueueInterval}
          in AMS SMSJournal <$> newMsgStore cfg
       Nothing -> putStrLn "Error: journal msg store require path in [STORE_LOG], restore_messages" >> exitFailure
   ntfStore <- NtfStore <$> TM.emptyIO
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 8b189c6f7..3da2aaeb4 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -416,6 +416,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                     { ttl = 86400 * readIniDefault defMsgExpirationDays "STORE_LOG" "expire_messages_days" ini
                     },
               expireMessagesOnStart = fromMaybe True $ iniOnOff "STORE_LOG" "expire_messages_on_start" ini,
+              idleQueueInterval = defaultIdleQueueInterval,
               notificationExpiration =
                 defaultNtfExpiration
                   { ttl = 3600 * readIniDefault defNtfExpirationHours "STORE_LOG" "expire_ntfs_hours" ini
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index 3df894652..e3a70786c 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -332,20 +332,21 @@ instance MsgStoreClass JournalMsgStore where
             journalId <- newJournalId random
             mkJournalQueue queue (newMsgQueueState journalId) Nothing
 
-  withIdleMsgQueue :: Int64 -> JournalMsgStore -> RecipientId -> JournalQueue -> (JournalMsgQueue -> StoreIO a) -> StoreIO (Maybe a)
+  withIdleMsgQueue :: Int64 -> JournalMsgStore -> RecipientId -> JournalQueue -> (JournalMsgQueue -> StoreIO a) -> StoreIO (Maybe a, Int)
   withIdleMsgQueue now ms@JournalMsgStore {config} rId q action =
     StoreIO $ readTVarIO (msgQueue_ q) >>= \case
       Nothing ->
-        Just <$>
-          E.bracket
-            (unStoreIO $ getMsgQueue ms rId q)
-            (\_ -> closeMsgQueue q)
-            (unStoreIO . action)
+        E.bracket (unStoreIO $ getMsgQueue ms rId q) (\_ -> closeMsgQueue q) $ \mq -> unStoreIO $ do
+          r <- action mq
+          sz <- getQueueSize_ mq
+          pure (Just r, sz)
       Just mq -> do
         ts <- readTVarIO $ activeAt q
-        if now - ts >= idleInterval config
+        r <- if now - ts >= idleInterval config
           then Just <$> unStoreIO (action mq) `E.finally` closeMsgQueue q
           else pure Nothing
+        sz <- unStoreIO $ getQueueSize_ mq
+        pure (r, sz)
 
   deleteQueue :: JournalMsgStore -> RecipientId -> JournalQueue -> IO (Either ErrorType QueueRec)
   deleteQueue ms rId q =
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index 33c91374c..42c3360d7 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -110,9 +110,13 @@ instance MsgStoreClass STMMsgStore where
         pure q
 
   -- does not create queue if it does not exist, does not delete it if it does (can't just close in-memory queue)
-  withIdleMsgQueue :: Int64 -> STMMsgStore -> RecipientId -> STMQueue -> (STMMsgQueue -> STM a) -> STM (Maybe a)
-  withIdleMsgQueue _ _ _ STMQueue {msgQueue_} action = readTVar msgQueue_ >>= mapM action
-  {-# INLINE withIdleMsgQueue #-}
+  withIdleMsgQueue :: Int64 -> STMMsgStore -> RecipientId -> STMQueue -> (STMMsgQueue -> STM a) -> STM (Maybe a, Int)
+  withIdleMsgQueue _ _ _ STMQueue {msgQueue_} action = readTVar msgQueue_ >>= \case
+    Just q -> do
+      r <- action q
+      sz <- getQueueSize_ q
+      pure (Just r, sz)
+    Nothing -> pure (Nothing, 0)
 
   deleteQueue :: STMMsgStore -> RecipientId -> STMQueue -> IO (Either ErrorType QueueRec)
   deleteQueue ms rId q = fst <$$> deleteQueue' ms rId q
diff --git a/src/Simplex/Messaging/Server/MsgStore/Types.hs b/src/Simplex/Messaging/Server/MsgStore/Types.hs
index 33d376a20..0b514659e 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Types.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Types.hs
@@ -15,7 +15,6 @@ import Control.Monad (foldM)
 import Control.Monad.Trans.Except
 import Data.Int (Int64)
 import Data.Kind
-import Data.Maybe (fromMaybe)
 import qualified Data.Map.Strict as M
 import Data.Time.Clock.System (SystemTime (systemSeconds))
 import Simplex.Messaging.Protocol
@@ -47,7 +46,7 @@ class Monad (StoreMonad s) => MsgStoreClass s where
   queueRec' :: StoreQueue s -> TVar (Maybe QueueRec)
   getMsgQueue :: s -> RecipientId -> StoreQueue s -> StoreMonad s (MsgQueue s)
   -- the journal queue will be closed after action if it was initially closed or idle longer than interval in config
-  withIdleMsgQueue :: Int64 -> s -> RecipientId -> StoreQueue s -> (MsgQueue s -> StoreMonad s a) -> StoreMonad s (Maybe a)
+  withIdleMsgQueue :: Int64 -> s -> RecipientId -> StoreQueue s -> (MsgQueue s -> StoreMonad s a) -> StoreMonad s (Maybe a, Int)
   deleteQueue :: s -> RecipientId -> StoreQueue s -> IO (Either ErrorType QueueRec)
   deleteQueueSize :: s -> RecipientId -> StoreQueue s -> IO (Either ErrorType (QueueRec, Int))
   getQueueMessages_ :: Bool -> MsgQueue s -> StoreMonad s [Message]
@@ -114,10 +113,11 @@ deleteExpiredMsgs st rId q old =
     getMsgQueue st rId q >>= deleteExpireMsgs_ old q
 
 -- closed and idle queues will be closed after expiration
-idleDeleteExpiredMsgs :: MsgStoreClass s => Int64 -> s -> RecipientId -> StoreQueue s -> Int64 -> ExceptT ErrorType IO Int
+-- returns (expired count, queue size after expiration)
+idleDeleteExpiredMsgs :: MsgStoreClass s => Int64 -> s -> RecipientId -> StoreQueue s -> Int64 -> ExceptT ErrorType IO (Maybe Int, Int)
 idleDeleteExpiredMsgs now st rId q old =
-  isolateQueue rId q "idleDeleteExpiredMsgs" $ 
-    fromMaybe 0 <$> withIdleMsgQueue now st rId q (deleteExpireMsgs_ old q)
+  isolateQueue rId q "idleDeleteExpiredMsgs" $
+    withIdleMsgQueue now st rId q (deleteExpireMsgs_ old q)
 
 deleteExpireMsgs_ :: MsgStoreClass s => Int64 -> StoreQueue s -> MsgQueue s -> StoreMonad s Int
 deleteExpireMsgs_ old q mq = do
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index b28f2b804..423b81074 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -133,6 +133,7 @@ cfgMS msType =
       controlPortAdminAuth = Nothing,
       messageExpiration = Just defaultMessageExpiration,
       expireMessagesOnStart = True,
+      idleQueueInterval = defaultIdleQueueInterval,
       notificationExpiration = defaultNtfExpiration,
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
       logStatsInterval = Nothing,
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 28073d5e4..744ceb437 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -972,7 +972,7 @@ testMsgExpireOnInterval =
   xit' "should expire messages that are not received before messageTTL after expiry interval" $ \(ATransport (t :: TProxy c), msType) -> do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    let cfg' = (cfgMS msType) {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
+    let cfg' = (cfgMS msType) {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}, idleQueueInterval = 1}
     withSmpServerConfigOn (ATransport t) cfg' testPort $ \_ ->
       testSMPClient @c $ \sh -> do
         (sId, rId, rKey, _) <- testSMPClient @c $ \rh -> createAndSecureQueue rh sPub

From a64c1aa2c41938c5e18cc49d08075f14e5d25f0d Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 17 Nov 2024 09:45:17 +0000
Subject: [PATCH 191/195] 6.2.0.3


From bbcb1abfdad5725db9badaf356fee15476000715 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 21 Nov 2024 22:01:19 +0000
Subject: [PATCH 192/195] agent: treat blocked STM and other critical errors
 that offer restart as temporary (#1405)

---
 src/Simplex/Messaging/Agent/Client.hs     | 1 +
 src/Simplex/Messaging/Agent/Env/SQLite.hs | 6 ++++--
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 571a044a3..33a3c2a10 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1388,6 +1388,7 @@ temporaryAgentError = \case
   PROXY _ _ (ProxyProtocolError (SMP.PROXY (SMP.BROKER e))) -> tempBrokerError e
   PROXY _ _ (ProxyProtocolError (SMP.PROXY SMP.NO_SESSION)) -> True
   INACTIVE -> True
+  CRITICAL True _ -> True -- critical errors that do not show restart button are likely to be permanent
   _ -> False
   where
     tempBrokerError = \case
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 069470f0b..c08ccef63 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -42,6 +42,7 @@ module Simplex.Messaging.Agent.Env.SQLite
 where
 
 import Control.Concurrent (ThreadId)
+import Control.Exception (BlockedIndefinitelyOnSTM (..), SomeException, fromException)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
@@ -78,7 +79,6 @@ import Simplex.Messaging.Transport (SMPVersion)
 import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors')
 import System.Mem.Weak (Weak)
 import System.Random (StdGen, newStdGen)
-import UnliftIO (SomeException)
 import UnliftIO.STM
 
 type AM' a = ReaderT Env IO a
@@ -313,7 +313,9 @@ agentFinally = allFinally mkInternal
 {-# INLINE agentFinally #-}
 
 mkInternal :: SomeException -> AgentErrorType
-mkInternal = INTERNAL . show
+mkInternal e = case fromException e of
+  Just BlockedIndefinitelyOnSTM -> CRITICAL True "Thread blocked indefinitely in STM transaction"
+  _ -> INTERNAL $ show e
 {-# INLINE mkInternal #-}
 
 data Worker = Worker

From 45333bd3408603d9030942103df2cd9316685934 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 22 Nov 2024 12:29:31 +0000
Subject: [PATCH 193/195] smp server: do not open/read journal message queues
 that are known to be empty (#1406)

* smp server: do not open/read journal message queues that are known to be empty

* cleanup

* version

* close empty queues on first subscription

* revert version
---
 src/Simplex/Messaging/Server.hs               |  6 +-
 .../Messaging/Server/MsgStore/Journal.hs      | 59 ++++++++++++++-----
 src/Simplex/Messaging/Server/MsgStore/STM.hs  | 16 ++---
 .../Messaging/Server/MsgStore/Types.hs        | 46 +++++++++------
 .../Messaging/Server/QueueStore/STM.hs        |  4 +-
 5 files changed, 86 insertions(+), 45 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 4b78f3cb4..51b35d0a3 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -1821,9 +1821,9 @@ importMessages tty ms f old_ = do
               mergeQuotaMsgs >> writeMsg ms rId q False msg $> (stored, expired, M.insert rId q overQuota)
               where
                 -- if the first message in queue head is "quota", remove it.
-                mergeQuotaMsgs = withMsgQueue ms rId q "mergeQuotaMsgs" $ \mq ->
-                  tryPeekMsg_ mq >>= \case
-                    Just MessageQuota {} -> tryDeleteMsg_ q mq False
+                mergeQuotaMsgs = withPeekMsgQueue ms rId q "mergeQuotaMsgs" $ maybe (pure ()) $ \(mq, msg) ->
+                  case msg of
+                    MessageQuota {} -> tryDeleteMsg_ q mq False
                     _ -> pure ()
         msgErr :: Show e => String -> e -> String
         msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
index e3a70786c..4e5496f66 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
@@ -11,8 +11,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TupleSections #-}
 
 module Simplex.Messaging.Server.MsgStore.Journal
   ( JournalMsgStore (queues, senders, notifiers, random),
@@ -20,7 +20,6 @@ module Simplex.Messaging.Server.MsgStore.Journal
     JournalMsgQueue (queue, state),
     JMQueue (queueDirectory, statePath),
     JournalStoreConfig (..),
-    getQueueMessages,
     closeMsgQueue,
     closeMsgQueueHandles,
     -- below are exported for tests
@@ -50,7 +49,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (intercalate)
-import Data.Maybe (catMaybes, fromMaybe)
+import Data.Maybe (catMaybes, fromMaybe, isNothing)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
@@ -105,7 +104,9 @@ data JournalQueue = JournalQueue
     queueRec :: TVar (Maybe QueueRec),
     msgQueue_ :: TVar (Maybe JournalMsgQueue),
     -- system time in seconds since epoch
-    activeAt :: TVar Int64
+    activeAt :: TVar Int64,
+    -- Just True - empty, Just False - non-empty, Nothing - unknown
+    isEmpty :: TVar (Maybe Bool)
   }
 
 data JMQueue = JMQueue
@@ -224,10 +225,11 @@ instance STMQueueStore JournalMsgStore where
   storeLog' = storeLog
   mkQueue st qr = do
     lock <- getMapLock (queueLocks st) $ recipientId qr
-    q <- newTVar $! Just qr
+    q <- newTVar $ Just qr
     mq <- newTVar Nothing
     activeAt <- newTVar 0
-    pure $ JournalQueue lock q mq activeAt
+    isEmpty <- newTVar Nothing
+    pure $ JournalQueue lock q mq activeAt isEmpty
   msgQueue_' = msgQueue_
 
 instance MsgStoreClass JournalMsgStore where
@@ -322,7 +324,7 @@ instance MsgStoreClass JournalMsgStore where
             statePath = msgQueueStatePath dir $ B.unpack (strEncode rId)
             queue = JMQueue {queueDirectory = dir, statePath}
         q <- ifM (doesDirectoryExist dir) (openMsgQueue ms queue) (createQ queue)
-        atomically $ writeTVar msgQueue_ $! Just q
+        atomically $ writeTVar msgQueue_ $ Just q
         pure q
         where
           createQ :: JMQueue -> IO JournalMsgQueue
@@ -332,14 +334,39 @@ instance MsgStoreClass JournalMsgStore where
             journalId <- newJournalId random
             mkJournalQueue queue (newMsgQueueState journalId) Nothing
 
+  getPeekMsgQueue :: JournalMsgStore -> RecipientId -> JournalQueue -> StoreIO (Maybe (JournalMsgQueue, Message))
+  getPeekMsgQueue ms rId q@JournalQueue {isEmpty} =
+    StoreIO (readTVarIO isEmpty) >>= \case
+      Just True -> pure Nothing
+      Just False -> peek
+      Nothing -> do
+        -- We only close the queue if we just learnt it's empty.
+        -- This is needed to reduce file descriptors and memory usage
+        -- after the server just started and many clients subscribe.
+        -- In case the queue became non-empty on write and then again empty on read
+        -- we won't be closing it, to avoid frequent open/close on active queues.
+        r <- peek
+        when (isNothing r) $ StoreIO $ closeMsgQueue q
+        pure r
+    where
+      peek = do
+        mq <- getMsgQueue ms rId q
+        (mq,) <$$> tryPeekMsg_ q mq
+
+  -- only runs action if queue is not empty
   withIdleMsgQueue :: Int64 -> JournalMsgStore -> RecipientId -> JournalQueue -> (JournalMsgQueue -> StoreIO a) -> StoreIO (Maybe a, Int)
   withIdleMsgQueue now ms@JournalMsgStore {config} rId q action =
     StoreIO $ readTVarIO (msgQueue_ q) >>= \case
       Nothing ->
-        E.bracket (unStoreIO $ getMsgQueue ms rId q) (\_ -> closeMsgQueue q) $ \mq -> unStoreIO $ do
-          r <- action mq
-          sz <- getQueueSize_ mq
-          pure (Just r, sz)
+        E.bracket
+          (unStoreIO $ getPeekMsgQueue ms rId q)
+          (mapM_ $ \_ -> closeMsgQueue q)
+          (maybe (pure (Nothing, 0)) (unStoreIO . run))
+        where
+          run (mq, _) = do
+            r <- action mq
+            sz <- getQueueSize_ mq
+            pure (Just r, sz)
       Just mq -> do
         ts <- readTVarIO $ activeAt q
         r <- if now - ts >= idleInterval config
@@ -378,6 +405,7 @@ instance MsgStoreClass JournalMsgStore where
       let empty = size == 0
       if canWrite || empty
         then do
+          atomically $ writeTVar (isEmpty q') (Just False)
           let canWrt' = quota > size
           if canWrt'
             then writeToJournal q st canWrt' msg $> Just (msg, empty)
@@ -426,9 +454,9 @@ instance MsgStoreClass JournalMsgStore where
   getQueueSize_ :: JournalMsgQueue -> StoreIO Int
   getQueueSize_ JournalMsgQueue {state} = StoreIO $ size <$> readTVarIO state
 
-  tryPeekMsg_ :: JournalMsgQueue -> StoreIO (Maybe Message)
-  tryPeekMsg_ q@JournalMsgQueue {tipMsg, handles} =
-    StoreIO $ readTVarIO handles $>>= chooseReadJournal q True $>>= peekMsg
+  tryPeekMsg_ :: JournalQueue -> JournalMsgQueue -> StoreIO (Maybe Message)
+  tryPeekMsg_ q mq@JournalMsgQueue {tipMsg, handles} =
+    StoreIO $ (readTVarIO handles $>>= chooseReadJournal mq True $>>= peekMsg) >>= setEmpty
     where
       peekMsg (rs, h) = readTVarIO tipMsg >>= maybe readMsg (pure . fmap fst)
         where
@@ -436,6 +464,9 @@ instance MsgStoreClass JournalMsgStore where
             ml@(msg, _) <- hGetMsgAt h $ bytePos rs
             atomically $ writeTVar tipMsg $ Just (Just ml)
             pure $ Just msg
+      setEmpty msg = do
+        atomically $ writeTVar (isEmpty q) (Just $ isNothing msg)
+        pure msg
 
   tryDeleteMsg_ :: JournalQueue -> JournalMsgQueue -> Bool -> StoreIO ()
   tryDeleteMsg_ q mq@JournalMsgQueue {tipMsg, handles} logState = StoreIO $ (`E.finally` when logState (updateActiveAt q)) $
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index 42c3360d7..cbeb75f9c 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -8,8 +7,8 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TupleSections #-}
 
 module Simplex.Messaging.Server.MsgStore.STM
   ( STMMsgStore (..),
@@ -29,7 +28,7 @@ import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util ((<$$>))
+import Simplex.Messaging.Util ((<$$>), ($>>=))
 import System.IO (IOMode (..))
 
 data STMMsgStore = STMMsgStore
@@ -63,7 +62,7 @@ instance STMQueueStore STMMsgStore where
   senders' = senders
   notifiers' = notifiers
   storeLog' = storeLog
-  mkQueue _ qr = STMQueue <$> (newTVar $! Just qr) <*> newTVar Nothing
+  mkQueue _ qr = STMQueue <$> newTVar (Just qr) <*> newTVar Nothing
   msgQueue_' = msgQueue_
 
 instance MsgStoreClass STMMsgStore where
@@ -106,9 +105,12 @@ instance MsgStoreClass STMMsgStore where
         canWrite <- newTVar True
         size <- newTVar 0
         let q = STMMsgQueue {msgQueue, canWrite, size}
-        writeTVar msgQueue_ $! Just q
+        writeTVar msgQueue_ (Just q)
         pure q
 
+  getPeekMsgQueue :: STMMsgStore -> RecipientId -> STMQueue -> STM (Maybe (STMMsgQueue, Message))
+  getPeekMsgQueue _ _ q@STMQueue {msgQueue_} = readTVar msgQueue_ $>>= \mq -> (mq,) <$$> tryPeekMsg_ q mq
+
   -- does not create queue if it does not exist, does not delete it if it does (can't just close in-memory queue)
   withIdleMsgQueue :: Int64 -> STMMsgStore -> RecipientId -> STMQueue -> (STMMsgQueue -> STM a) -> STM (Maybe a, Int)
   withIdleMsgQueue _ _ _ STMQueue {msgQueue_} action = readTVar msgQueue_ >>= \case
@@ -159,8 +161,8 @@ instance MsgStoreClass STMMsgStore where
   getQueueSize_ :: STMMsgQueue -> STM Int
   getQueueSize_ STMMsgQueue {size} = readTVar size
 
-  tryPeekMsg_ :: STMMsgQueue -> STM (Maybe Message)
-  tryPeekMsg_ = tryPeekTQueue . msgQueue
+  tryPeekMsg_ :: STMQueue -> STMMsgQueue -> STM (Maybe Message)
+  tryPeekMsg_ _ = tryPeekTQueue . msgQueue
   {-# INLINE tryPeekMsg_ #-}
 
   tryDeleteMsg_ :: STMQueue -> STMMsgQueue -> Bool -> STM ()
diff --git a/src/Simplex/Messaging/Server/MsgStore/Types.hs b/src/Simplex/Messaging/Server/MsgStore/Types.hs
index 0b514659e..8754767cd 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Types.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Types.hs
@@ -4,15 +4,20 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Redundant multi-way if" #-}
 
 module Simplex.Messaging.Server.MsgStore.Types where
 
 import Control.Concurrent.STM
 import Control.Monad (foldM)
 import Control.Monad.Trans.Except
+import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Kind
 import qualified Data.Map.Strict as M
@@ -21,6 +26,7 @@ import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.StoreLog.Types
 import Simplex.Messaging.TMap (TMap)
+import Simplex.Messaging.Util ((<$$>))
 import System.IO (IOMode (..))
 
 class MsgStoreClass s => STMQueueStore s where
@@ -44,7 +50,9 @@ class Monad (StoreMonad s) => MsgStoreClass s where
   logQueueStates :: s -> IO ()
   logQueueState :: StoreQueue s -> StoreMonad s ()
   queueRec' :: StoreQueue s -> TVar (Maybe QueueRec)
+  getPeekMsgQueue :: s -> RecipientId -> StoreQueue s -> StoreMonad s (Maybe (MsgQueue s, Message))
   getMsgQueue :: s -> RecipientId -> StoreQueue s -> StoreMonad s (MsgQueue s)
+
   -- the journal queue will be closed after action if it was initially closed or idle longer than interval in config
   withIdleMsgQueue :: Int64 -> s -> RecipientId -> StoreQueue s -> (MsgQueue s -> StoreMonad s a) -> StoreMonad s (Maybe a, Int)
   deleteQueue :: s -> RecipientId -> StoreQueue s -> IO (Either ErrorType QueueRec)
@@ -53,7 +61,7 @@ class Monad (StoreMonad s) => MsgStoreClass s where
   writeMsg :: s -> RecipientId -> StoreQueue s -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
   setOverQuota_ :: StoreQueue s -> IO () -- can ONLY be used while restoring messages, not while server running
   getQueueSize_ :: MsgQueue s -> StoreMonad s Int
-  tryPeekMsg_ :: MsgQueue s -> StoreMonad s (Maybe Message)
+  tryPeekMsg_ :: StoreQueue s -> MsgQueue s -> StoreMonad s (Maybe Message)
   tryDeleteMsg_ :: StoreQueue s -> MsgQueue s -> Bool -> StoreMonad s ()
   isolateQueue :: RecipientId -> StoreQueue s -> String -> StoreMonad s a -> ExceptT ErrorType IO a
 
@@ -73,39 +81,39 @@ withActiveMsgQueues st f = readTVarIO (activeMsgQueues st) >>= foldM run mempty
       pure $! acc <> r
 
 getQueueMessages :: MsgStoreClass s => Bool -> s -> RecipientId -> StoreQueue s -> ExceptT ErrorType IO [Message]
-getQueueMessages drainMsgs st rId q = withMsgQueue st rId q "getQueueSize" $ getQueueMessages_ drainMsgs
+getQueueMessages drainMsgs st rId q = withPeekMsgQueue st rId q "getQueueSize" $ maybe (pure []) (getQueueMessages_ drainMsgs . fst)
 {-# INLINE getQueueMessages #-}
 
 getQueueSize :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> ExceptT ErrorType IO Int
-getQueueSize st rId q = withMsgQueue st rId q "getQueueSize" $ getQueueSize_
+getQueueSize st rId q = withPeekMsgQueue st rId q "getQueueSize" $ maybe (pure 0) (getQueueSize_ . fst)
 {-# INLINE getQueueSize #-}
 
 tryPeekMsg :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> ExceptT ErrorType IO (Maybe Message)
-tryPeekMsg st rId q = withMsgQueue st rId q "tryPeekMsg" $ tryPeekMsg_
+tryPeekMsg st rId q = snd <$$> withPeekMsgQueue st rId q "tryPeekMsg" pure
 {-# INLINE tryPeekMsg #-}
 
 tryDelMsg :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message)
 tryDelMsg st rId q msgId' =
-  withMsgQueue st rId q "tryDelMsg" $ \mq ->
-    tryPeekMsg_ mq >>= \case
-      msg_@(Just msg)
+  withPeekMsgQueue st rId q "tryDelMsg" $
+    maybe (pure Nothing) $ \(mq, msg) ->
+      if
         | messageId msg == msgId' ->
-            tryDeleteMsg_ q mq True >> pure msg_
-      _ -> pure Nothing
+            tryDeleteMsg_ q mq True $> Just msg
+        | otherwise -> pure Nothing
 
 -- atomic delete (== read) last and peek next message if available
 tryDelPeekMsg :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
 tryDelPeekMsg st rId q msgId' =
-  withMsgQueue st rId q "tryDelPeekMsg" $ \mq ->
-    tryPeekMsg_ mq >>= \case
-      msg_@(Just msg)
-        | messageId msg == msgId' -> (msg_,) <$> (tryDeleteMsg_ q mq True >> tryPeekMsg_ mq)
-        | otherwise -> pure (Nothing, msg_)
-      _ -> pure (Nothing, Nothing)
+  withPeekMsgQueue st rId q "tryDelPeekMsg" $
+    maybe (pure (Nothing, Nothing)) $ \(mq, msg) ->
+      if
+        | messageId msg == msgId' -> (Just msg,) <$> (tryDeleteMsg_ q mq True >> tryPeekMsg_ q mq)
+        | otherwise -> pure (Nothing, Just msg)
 
-withMsgQueue :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> String -> (MsgQueue s -> StoreMonad s a) -> ExceptT ErrorType IO a
-withMsgQueue st rId q op a = isolateQueue rId q op $ getMsgQueue st rId q >>= a
-{-# INLINE withMsgQueue #-}
+-- The action is called with Nothing when it is known that the queue is empty
+withPeekMsgQueue :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> String -> (Maybe (MsgQueue s, Message) -> StoreMonad s a) -> ExceptT ErrorType IO a
+withPeekMsgQueue st rId q op a = isolateQueue rId q op $ getPeekMsgQueue st rId q >>= a
+{-# INLINE withPeekMsgQueue #-}
 
 deleteExpiredMsgs :: MsgStoreClass s => s -> RecipientId -> StoreQueue s -> Int64 -> ExceptT ErrorType IO Int
 deleteExpiredMsgs st rId q old =
@@ -126,7 +134,7 @@ deleteExpireMsgs_ old q mq = do
   pure n
   where
     loop dc =
-      tryPeekMsg_ mq >>= \case
+      tryPeekMsg_ q mq >>= \case
         Just Message {msgTs}
           | systemSeconds msgTs < old ->
               tryDeleteMsg_ q mq False >> loop (dc + 1)
diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index d83d26f08..7bf4f3a4a 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -84,7 +84,7 @@ secureQueue st sq sKey =
     secure q@QueueRec {recipientId = rId} = case senderKey q of
       Just k -> pure $ if sKey == k then Right rId else Left AUTH
       Nothing -> do
-        writeTVar qr $! Just q {senderKey = Just sKey}
+        writeTVar qr $ Just q {senderKey = Just sKey}
         pure $ Right rId
 
 addQueueNotifier :: STMQueueStore s => s -> StoreQueue s -> NtfCreds -> IO (Either ErrorType (Maybe NotifierId))
@@ -96,7 +96,7 @@ addQueueNotifier st sq ntfCreds@NtfCreds {notifierId = nId} =
     add q@QueueRec {recipientId = rId} = ifM (TM.member nId (notifiers' st)) (pure $ Left DUPLICATE_) $ do
       nId_ <- forM (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId (notifiers' st) $> notifierId
       let !q' = q {notifier = Just ntfCreds}
-      writeTVar qr $! Just q'
+      writeTVar qr $ Just q'
       TM.insert nId rId $ notifiers' st
       pure $ Right (rId, nId_)
 

From 97104988a307bd27b8bf5da7ed67455f3531d7ae Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Fri, 22 Nov 2024 16:43:37 +0000
Subject: [PATCH 194/195] server: support server roles and operators (#1343)

* server: support server roles and operators

* make server operator optional

* allRoles

* fix test

* different server host in tests

* remove ServerCfg fields used only in UI

* comments

* choose different server for invitation when connecting via address

* fix test in ghc8107

* simplify
---
 simplexmq.cabal                           |  1 +
 src/Simplex/FileTransfer/Agent.hs         |  8 +-
 src/Simplex/Messaging/Agent.hs            | 31 ++++---
 src/Simplex/Messaging/Agent/Client.hs     | 99 +++++++++++++++++------
 src/Simplex/Messaging/Agent/Env/SQLite.hs | 49 +++++++----
 src/Simplex/Messaging/Server.hs           |  6 +-
 tests/AgentTests.hs                       |  2 +
 tests/AgentTests/ServerChoice.hs          | 85 +++++++++++++++++++
 tests/SMPAgentClient.hs                   |  6 +-
 tests/SMPClient.hs                        |  3 +
 tests/SMPProxyTests.hs                    |  4 +-
 11 files changed, 230 insertions(+), 64 deletions(-)
 create mode 100644 tests/AgentTests/ServerChoice.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 7cee47e0d..cbdc7d66d 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -384,6 +384,7 @@ test-suite simplexmq-test
       AgentTests.MigrationTests
       AgentTests.NotificationTests
       AgentTests.SchemaDump
+      AgentTests.ServerChoice
       AgentTests.SQLiteTests
       CLITests
       CoreTests.BatchingTests
diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index aabe3ff28..9f9525154 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -461,14 +461,14 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
           pure srv
           where
             tryCreate = do
-              usedSrvs <- newTVarIO ([] :: [XFTPServer])
+              triedHosts <- newTVarIO S.empty
               let AgentClient {xftpServers} = c
               userSrvCount <- liftIO $ length <$> TM.lookupIO userId xftpServers
               withRetryIntervalCount (riFast ri) $ \n _ loop -> do
                 liftIO $ waitWhileSuspended c
                 liftIO $ waitForUserNetwork c
                 let triedAllSrvs = n > userSrvCount
-                createWithNextSrv usedSrvs
+                createWithNextSrv triedHosts
                   `catchAgentError` \e -> retryOnError "XFTP prepare worker" (retryLoop loop triedAllSrvs e) (throwE e) e
               where
                 -- we don't do closeXFTPServerClient here to not risk closing connection for concurrent chunk upload
@@ -477,10 +477,10 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
                     when (triedAllSrvs && serverHostError e) $ notify c sndFileEntityId $ SFWARN e
                   liftIO $ assertAgentForeground c
                   loop
-            createWithNextSrv usedSrvs = do
+            createWithNextSrv triedHosts = do
               deleted <- withStore' c $ \db -> getSndFileDeleted db sndFileId
               when deleted $ throwE $ FILE NO_FILE
-              withNextSrv c userId usedSrvs [] $ \srvAuth -> do
+              withNextSrv c userId storageSrvs triedHosts [] $ \srvAuth -> do
                 replica <- agentXFTPNewChunk c ch numRecipients' srvAuth
                 pure (replica, srvAuth)
 
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index dc6f4ad17..94db36e28 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -120,6 +120,8 @@ module Simplex.Messaging.Agent
     debugAgentLocks,
     getAgentSubscriptions,
     logConnection,
+    -- for tests
+    withAgentEnv,
   )
 where
 
@@ -815,11 +817,13 @@ newConnToAccept c connId enableNtfs invId pqSup = do
 
 joinConn :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured
 joinConn c userId connId enableNtfs cReq cInfo pqSupport subMode = do
-  srv <- case cReq of
-    CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ ->
-      getNextServer c userId [qServer q]
-    _ -> getSMPServer c userId
+  srv <- getNextSMPServer c userId [qServer cReqQueue]
   joinConnSrv c userId connId enableNtfs cReq cInfo pqSupport subMode srv
+  where
+    cReqQueue :: SMPQueueUri
+    cReqQueue = case cReq of
+      CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q
+      CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q
 
 startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448)
 startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
@@ -1194,14 +1198,13 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
     processCmd ri PendingCommand {cmdId, corrId, userId, command} pendingCmds = case command of
       AClientCommand cmd -> case cmd of
         NEW enableNtfs (ACM cMode) pqEnc subMode -> noServer $ do
-          usedSrvs <- newTVarIO ([] :: [SMPServer])
-          tryCommand . withNextSrv c userId usedSrvs [] $ \srv -> do
+          triedHosts <- newTVarIO S.empty
+          tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do
             cReq <- newRcvConnSrv c userId connId enableNtfs cMode Nothing pqEnc subMode srv
             notify $ INV (ACR cMode cReq)
         JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do
-          let initUsed = [qServer q]
-          usedSrvs <- newTVarIO initUsed
-          tryCommand . withNextSrv c userId usedSrvs initUsed $ \srv -> do
+          triedHosts <- newTVarIO S.empty
+          tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
             sqSecured <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv
             notify $ JOINED sqSecured
         LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK
@@ -1649,8 +1652,8 @@ switchDuplexConnection c (DuplexConnection cData@ConnData {connId, userId} rqs s
   checkRQSwchStatus rq RSSwitchStarted
   clientVRange <- asks $ smpClientVRange . config
   -- try to get the server that is different from all queues, or at least from the primary rcv queue
-  srvAuth@(ProtoServerWithAuth srv _) <- getNextServer c userId $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
-  srv' <- if srv == server then getNextServer c userId [server] else pure srvAuth
+  srvAuth@(ProtoServerWithAuth srv _) <- getNextSMPServer c userId $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
+  srv' <- if srv == server then getNextSMPServer c userId [server] else pure srvAuth
   (q, qUri, tSess, sessId) <- newRcvQueue c userId connId srv' clientVRange SMSubscribe False
   let rq' = (q :: NewRcvQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
   rq'' <- withStore c $ \db -> addConnRcvQueue db connId rq'
@@ -2158,9 +2161,13 @@ debugAgentLocks AgentClient {connLocks = cs, invLocks = is, deleteLock = d} = do
     getLocks ls = atomically $ M.mapKeys (B.unpack . strEncode) . M.mapMaybe id <$> (mapM tryReadTMVar =<< readTVar ls)
 
 getSMPServer :: AgentClient -> UserId -> AM SMPServerWithAuth
-getSMPServer c userId = withUserServers c userId pickServer
+getSMPServer c userId = getNextSMPServer c userId []
 {-# INLINE getSMPServer #-}
 
+getNextSMPServer :: AgentClient -> UserId -> [SMPServer] -> AM SMPServerWithAuth
+getNextSMPServer c userId = getNextServer c userId storageSrvs
+{-# INLINE getNextSMPServer #-}
+
 subscriber :: AgentClient -> AM' ()
 subscriber c@AgentClient {msgQ} = forever $ do
   t <- atomically $ readTBQueue msgQ
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 33a3c2a10..af241c2f4 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -149,7 +149,6 @@ module Simplex.Messaging.Agent.Client
     userServers,
     pickServer,
     getNextServer,
-    withUserServers,
     withNextSrv,
     incSMPServerStat,
     incSMPServerStat',
@@ -193,12 +192,12 @@ import qualified Data.ByteString.Char8 as B
 import Data.Either (isRight, partitionEithers)
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (deleteFirstsBy, find, foldl', partition, (\\))
+import Data.List (find, foldl', 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 (catMaybes, fromMaybe, isJust, isNothing, listToMaybe)
+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe)
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Text (Text)
@@ -264,7 +263,6 @@ import Simplex.Messaging.Protocol
     VersionSMPC,
     XFTPServer,
     XFTPServerWithAuth,
-    sameSrvAddr',
     pattern NoEntity,
   )
 import qualified Simplex.Messaging.Protocol as SMP
@@ -619,7 +617,7 @@ getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
 getSMPProxyClient :: AgentClient -> Maybe SMPServerWithAuth -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
 getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq} proxySrv_ destSess@(userId, destSrv, qId) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
-  proxySrv <- maybe (getNextServer c userId [destSrv]) pure proxySrv_
+  proxySrv <- maybe (getNextServer c userId proxySrvs [destSrv]) pure proxySrv_
   ts <- liftIO getCurrentTime
   atomically (getClientVar proxySrv ts) >>= \(tSess, auth, v) ->
     either (newProxyClient tSess auth ts) (waitForProxyClient tSess auth) v
@@ -1074,7 +1072,7 @@ sendOrProxySMPCommand ::
   (SMPClient -> ProxiedRelay -> ExceptT SMPClientError IO (Either ProxyClientError ())) ->
   (SMPClient -> ExceptT SMPClientError IO ()) ->
   AM (Maybe SMPServer)
-sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
+sendOrProxySMPCommand c userId destSrv@ProtocolServer {host = destHosts} connId cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
   tSess <- mkTransportSession c userId destSrv connId
   ifM shouldUseProxy (sendViaProxy Nothing tSess) (sendDirectly tSess $> Nothing)
   where
@@ -1093,7 +1091,7 @@ sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendCmdViaProxy se
         SPFAllow -> True
         SPFAllowProtected -> ipAddressProtected cfg destSrv
         SPFProhibit -> False
-    unknownServer = liftIO $ maybe True (notElem destSrv . knownSrvs) <$> TM.lookupIO userId (smpServers c)
+    unknownServer = liftIO $ maybe True (\srvs -> all (`S.notMember` knownHosts srvs) destHosts) <$> TM.lookupIO userId (smpServers c)
     sendViaProxy :: Maybe SMPServerWithAuth -> SMPTransportSession -> AM (Maybe SMPServer)
     sendViaProxy proxySrv_ destSess@(_, _, connId_) = do
       r <- tryAgentError . withProxySession c proxySrv_ destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess@ProxiedRelay {prBasicAuth}) -> do
@@ -2036,33 +2034,82 @@ userServers c = case protocolTypeI @p of
   SPXFTP -> xftpServers c
 {-# INLINE userServers #-}
 
-pickServer :: forall p. NonEmpty (ProtoServerWithAuth p) -> AM (ProtoServerWithAuth p)
+pickServer :: NonEmpty (Maybe OperatorId, ProtoServerWithAuth p) -> AM (ProtoServerWithAuth p)
 pickServer = \case
-  srv :| [] -> pure srv
+  (_, srv) :| [] -> pure srv
   servers -> do
     gen <- asks randomServer
-    atomically $ (servers L.!!) <$> stateTVar gen (randomR (0, L.length servers - 1))
+    atomically $ snd . (servers L.!!) <$> stateTVar gen (randomR (0, L.length servers - 1))
 
-getNextServer :: forall p. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> [ProtocolServer p] -> AM (ProtoServerWithAuth p)
-getNextServer c userId usedSrvs = withUserServers c userId $ \srvs ->
-  case L.nonEmpty $ deleteFirstsBy sameSrvAddr' (L.toList srvs) (map noAuthSrv usedSrvs) of
-    Just srvs' -> pickServer srvs'
-    _ -> pickServer srvs
+getNextServer ::
+  (ProtocolTypeI p, UserProtocol p) =>
+  AgentClient ->
+  UserId -> 
+  (UserServers p -> NonEmpty (Maybe OperatorId, ProtoServerWithAuth p)) ->
+  [ProtocolServer p] ->
+  AM (ProtoServerWithAuth p)
+getNextServer c userId srvsSel usedSrvs = do
+  srvs <- getUserServers_ c userId srvsSel
+  snd <$> getNextServer_ srvs (usedOperatorsHosts srvs usedSrvs)
 
-withUserServers :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> (NonEmpty (ProtoServerWithAuth p) -> AM a) -> AM a
-withUserServers c userId action =
+usedOperatorsHosts :: NonEmpty (Maybe OperatorId, ProtoServerWithAuth p) -> [ProtocolServer p] -> (Set (Maybe OperatorId), Set TransportHost)
+usedOperatorsHosts srvs usedSrvs = (usedOperators, usedHosts)
+  where
+    usedHosts = S.unions $ map serverHosts usedSrvs
+    usedOperators = S.fromList $ mapMaybe usedOp $ L.toList srvs
+    usedOp (op, srv) = if hasUsedHost srv then Just op else Nothing
+    hasUsedHost (ProtoServerWithAuth srv _) = any (`S.member` usedHosts) $ serverHosts srv
+
+getNextServer_ ::
+  (ProtocolTypeI p, UserProtocol p) =>
+  NonEmpty (Maybe OperatorId, ProtoServerWithAuth p) ->
+  (Set (Maybe OperatorId), Set TransportHost) ->
+  AM (NonEmpty (Maybe OperatorId, ProtoServerWithAuth p), ProtoServerWithAuth p)
+getNextServer_ servers (usedOperators, usedHosts) = do
+  -- choose from servers of unused operators, when possible
+  let otherOpsSrvs = filterOrAll ((`S.notMember` usedOperators) . fst) servers
+      -- choose from servers with unused hosts when possible
+      unusedSrvs = filterOrAll (isUnusedServer usedHosts) otherOpsSrvs
+  (otherOpsSrvs,) <$> pickServer unusedSrvs
+  where
+    filterOrAll p srvs = fromMaybe srvs $ L.nonEmpty $ L.filter p srvs
+
+isUnusedServer :: Set TransportHost -> (Maybe OperatorId, ProtoServerWithAuth p) -> Bool
+isUnusedServer usedHosts (_, ProtoServerWithAuth ProtocolServer {host} _) = all (`S.notMember` usedHosts) host
+
+getUserServers_ ::
+  (ProtocolTypeI p, UserProtocol p) =>
+  AgentClient ->
+  UserId ->
+  (UserServers p -> NonEmpty (Maybe OperatorId, ProtoServerWithAuth p)) ->
+  AM (NonEmpty (Maybe OperatorId, ProtoServerWithAuth p))
+getUserServers_ c userId srvsSel =
   liftIO (TM.lookupIO userId $ userServers c) >>= \case
-    Just srvs -> action $ enabledSrvs srvs
+    Just srvs -> pure $ srvsSel srvs
     _ -> throwE $ INTERNAL "unknown userId - no user servers"
 
-withNextSrv :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> TVar [ProtocolServer p] -> [ProtocolServer p] -> (ProtoServerWithAuth p -> AM a) -> AM a
-withNextSrv c userId usedSrvs initUsed action = do
-  used <- readTVarIO usedSrvs
-  srvAuth@(ProtoServerWithAuth srv _) <- getNextServer c userId used
-  srvs_ <- liftIO $ TM.lookupIO userId $ userServers c
-  let unused = maybe [] ((\\ used) . map protoServer . L.toList . enabledSrvs) srvs_
-      used' = if null unused then initUsed else srv : used
-  atomically $ writeTVar usedSrvs $! used'
+-- This function checks used servers and operators every time to allow
+-- changing configuration while retry look is executing.
+-- This function is not thread safe.
+withNextSrv ::
+  (ProtocolTypeI p, UserProtocol p) =>
+  AgentClient ->
+  UserId ->
+  (UserServers p -> NonEmpty (Maybe OperatorId, ProtoServerWithAuth p)) ->
+  TVar (Set TransportHost) ->
+  [ProtocolServer p] -> 
+  (ProtoServerWithAuth p -> AM a) ->
+  AM a
+withNextSrv c userId srvsSel triedHosts usedSrvs action = do
+  srvs <- getUserServers_ c userId srvsSel
+  let (usedOperators, usedHosts) = usedOperatorsHosts srvs usedSrvs
+  tried <- readTVarIO triedHosts
+  let triedOrUsed = S.union tried usedHosts
+  (otherOpsSrvs, srvAuth@(ProtoServerWithAuth srv _)) <- getNextServer_ srvs (usedOperators, triedOrUsed)
+  let newHosts = serverHosts srv
+      unusedSrvs = L.filter (isUnusedServer $ S.union triedOrUsed newHosts) otherOpsSrvs
+      !tried' = if null unusedSrvs then S.empty else S.union tried newHosts
+  atomically $ writeTVar triedHosts tried'
   action srvAuth
 
 incSMPServerStat :: AgentClient -> UserId -> SMPServer -> (AgentSMPServerStats -> TVar Int) -> STM ()
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index c08ccef63..a78fb428e 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -17,11 +17,14 @@ module Simplex.Messaging.Agent.Env.SQLite
     AgentConfig (..),
     InitialAgentServers (..),
     ServerCfg (..),
+    ServerRoles (..),
+    OperatorId,
     UserServers (..),
     NetworkConfig (..),
     presetServerCfg,
-    enabledServerCfg,
+    allRoles,
     mkUserServers,
+    serverHosts,
     defaultAgentConfig,
     defaultReconnectInterval,
     tryAgentError,
@@ -55,6 +58,8 @@ import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import Data.Maybe (fromMaybe)
+import Data.Set (Set)
+import qualified Data.Set as S
 import Data.Time.Clock (NominalDiffTime, nominalDay)
 import Data.Time.Clock.System (SystemTime (..))
 import Data.Word (Word16)
@@ -72,10 +77,11 @@ import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
 import Simplex.Messaging.Notifications.Transport (NTFVersion)
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (defaultJSON)
-import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth, ProtocolServer, ProtocolType (..), ProtocolTypeI, VersionRangeSMPC, XFTPServer, supportedSMPClientVRange)
+import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI, VersionRangeSMPC, XFTPServer, supportedSMPClientVRange)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPVersion)
+import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors')
 import System.Mem.Weak (Weak)
 import System.Random (StdGen, newStdGen)
@@ -94,29 +100,42 @@ data InitialAgentServers = InitialAgentServers
 
 data ServerCfg p = ServerCfg
   { server :: ProtoServerWithAuth p,
-    preset :: Bool,
-    tested :: Maybe Bool,
-    enabled :: Bool
+    operator :: Maybe OperatorId,
+    enabled :: Bool,
+    roles :: ServerRoles
   }
   deriving (Show)
 
-enabledServerCfg :: ProtoServerWithAuth p -> ServerCfg p
-enabledServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True}
+data ServerRoles = ServerRoles
+  { storage :: Bool,
+    proxy :: Bool
+  }
+  deriving (Show)
 
-presetServerCfg :: Bool -> ProtoServerWithAuth p -> ServerCfg p
-presetServerCfg enabled server = ServerCfg {server, preset = True, tested = Nothing, enabled}
+allRoles :: ServerRoles
+allRoles = ServerRoles True True
+
+presetServerCfg :: Bool -> ServerRoles -> Maybe OperatorId -> ProtoServerWithAuth p -> ServerCfg p
+presetServerCfg enabled roles operator server =
+  ServerCfg {server, operator, enabled, roles}
 
 data UserServers p = UserServers
-  { enabledSrvs :: NonEmpty (ProtoServerWithAuth p),
-    knownSrvs :: NonEmpty (ProtocolServer p)
+  { storageSrvs :: NonEmpty (Maybe OperatorId, ProtoServerWithAuth p),
+    proxySrvs :: NonEmpty (Maybe OperatorId, ProtoServerWithAuth p),
+    knownHosts :: Set TransportHost
   }
 
+type OperatorId = Int64
+
 -- This function sets all servers as enabled in case all passed servers are disabled.
 mkUserServers :: NonEmpty (ServerCfg p) -> UserServers p
-mkUserServers srvs = UserServers {enabledSrvs, knownSrvs}
+mkUserServers srvs = UserServers {storageSrvs = filterSrvs storage, proxySrvs = filterSrvs proxy, knownHosts}
   where
-    enabledSrvs = L.map (\ServerCfg {server} -> server) $ fromMaybe srvs $ L.nonEmpty $ L.filter (\ServerCfg {enabled} -> enabled) srvs
-    knownSrvs = L.map (\ServerCfg {server = ProtoServerWithAuth srv _} -> srv) srvs
+    filterSrvs role = L.map (\ServerCfg {operator, server} -> (operator, server)) $ fromMaybe srvs $ L.nonEmpty $ L.filter (\ServerCfg {enabled, roles} -> enabled && role roles) srvs
+    knownHosts = S.unions $ L.map (\ServerCfg {server = ProtoServerWithAuth srv _} -> serverHosts srv) srvs
+
+serverHosts :: ProtocolServer p -> Set TransportHost
+serverHosts ProtocolServer {host} = S.fromList $ L.toList host
 
 data AgentConfig = AgentConfig
   { tcpPort :: Maybe ServiceName,
@@ -337,6 +356,8 @@ updateRestartCount t (RestartCount minute count) = do
 
 $(pure [])
 
+$(JQ.deriveJSON defaultJSON ''ServerRoles)
+
 instance ProtocolTypeI p => ToJSON (ServerCfg p) where
   toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerCfg)
   toJSON = $(JQ.mkToJSON defaultJSON ''ServerCfg)
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 51b35d0a3..988639f5c 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -1821,9 +1821,9 @@ importMessages tty ms f old_ = do
               mergeQuotaMsgs >> writeMsg ms rId q False msg $> (stored, expired, M.insert rId q overQuota)
               where
                 -- if the first message in queue head is "quota", remove it.
-                mergeQuotaMsgs = withPeekMsgQueue ms rId q "mergeQuotaMsgs" $ maybe (pure ()) $ \(mq, msg) ->
-                  case msg of
-                    MessageQuota {} -> tryDeleteMsg_ q mq False
+                mergeQuotaMsgs =
+                  withPeekMsgQueue ms rId q "mergeQuotaMsgs" $ maybe (pure ()) $ \case
+                    (mq, MessageQuota {}) -> tryDeleteMsg_ q mq False
                     _ -> pure ()
         msgErr :: Show e => String -> e -> String
         msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs
index c9e11f296..56a7fef1f 100644
--- a/tests/AgentTests.hs
+++ b/tests/AgentTests.hs
@@ -16,6 +16,7 @@ import AgentTests.FunctionalAPITests (functionalAPITests)
 import AgentTests.MigrationTests (migrationTests)
 import AgentTests.NotificationTests (notificationTests)
 import AgentTests.SQLiteTests (storeTests)
+import AgentTests.ServerChoice (serverChoiceTests)
 import Simplex.Messaging.Transport (ATransport (..))
 import Test.Hspec
 
@@ -26,4 +27,5 @@ agentTests (ATransport t) = do
   describe "Functional API" $ functionalAPITests (ATransport t)
   describe "Notification tests" $ notificationTests (ATransport t)
   describe "SQLite store" storeTests
+  describe "Chosen servers" serverChoiceTests
   describe "Migration tests" migrationTests
diff --git a/tests/AgentTests/ServerChoice.hs b/tests/AgentTests/ServerChoice.hs
new file mode 100644
index 000000000..0df995d08
--- /dev/null
+++ b/tests/AgentTests/ServerChoice.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module AgentTests.ServerChoice where
+
+import AgentTests.FunctionalAPITests
+import Control.Monad.IO.Class
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.Map.Strict as M
+import SMPAgentClient
+import Simplex.Messaging.Agent (withAgentEnv)
+import Simplex.Messaging.Agent.Client hiding (userServers)
+import Simplex.Messaging.Agent.Env.SQLite
+import Simplex.Messaging.Client (defaultNetworkConfig)
+import Simplex.Messaging.Protocol
+import Test.Hspec
+import Test.QuickCheck
+import XFTPClient (testXFTPServer)
+
+serverChoiceTests :: Spec
+serverChoiceTests = do
+  describe "Server operators" $ do
+    it "should choose server of different operator" $ ioProperty $ testChooseDifferentOperator
+
+operatorSimpleX :: Maybe OperatorId
+operatorSimpleX = Just 1
+
+operator2 :: Maybe OperatorId
+operator2 = Just 2
+
+testOp1Srv1 :: ProtoServerWithAuth 'PSMP
+testOp1Srv1 = "smp://LcJU@test1.simplex.im"
+
+testOp1Srv2 :: ProtoServerWithAuth 'PSMP
+testOp1Srv2 = "smp://LcJU@test2.simplex.im"
+
+testOp2Srv1 :: ProtoServerWithAuth 'PSMP
+testOp2Srv1 = "smp://LcJU@srv1.example.com"
+
+testOp2Srv2 :: ProtoServerWithAuth 'PSMP
+testOp2Srv2 = "smp://LcJU@srv2.example.com"
+
+testSMPServers :: NonEmpty (ServerCfg 'PSMP)
+testSMPServers =
+  [ presetServerCfg True allRoles operatorSimpleX testOp1Srv1,
+    presetServerCfg True allRoles operatorSimpleX testOp1Srv2,
+    presetServerCfg True proxyOnly operator2 testOp2Srv1,
+    presetServerCfg True proxyOnly operator2 testOp2Srv2
+  ]
+
+storageOnly :: ServerRoles
+storageOnly = ServerRoles {storage = True, proxy = False}
+
+proxyOnly :: ServerRoles
+proxyOnly = ServerRoles {storage = False, proxy = True}
+
+initServers :: InitialAgentServers
+initServers =
+  InitialAgentServers
+    { smp = M.fromList [(1, testSMPServers)],
+      ntf = [testNtfServer],
+      xftp = userServers [testXFTPServer],
+      netCfg = defaultNetworkConfig
+    }
+
+testChooseDifferentOperator :: IO ()
+testChooseDifferentOperator = do
+  c <- getSMPAgentClient' 1 agentCfg initServers testDB
+  runRight_ $ do
+    -- chooses the only operator with storage role
+    srv1 <- withAgentEnv c $ getNextServer c 1 storageSrvs []
+    liftIO $ srv1 == testOp1Srv1 || srv1 == testOp1Srv2 `shouldBe` True
+    -- chooses another server for storage
+    srv2 <- withAgentEnv c $ getNextServer c 1 storageSrvs [protoServer testOp1Srv1]
+    liftIO $ srv2 `shouldBe` testOp1Srv2
+    -- chooses another operator for proxy
+    srv3 <- withAgentEnv c $ getNextServer c 1 proxySrvs [protoServer srv1]
+    liftIO $ srv3 == testOp2Srv1 || srv3 == testOp2Srv2 `shouldBe` True
+    -- chooses another operator for proxy
+    srv3' <- withAgentEnv c $ getNextServer c 1 proxySrvs [protoServer testOp1Srv1, protoServer testOp1Srv2]
+    liftIO $ srv3' == testOp2Srv1 || srv3' == testOp2Srv2 `shouldBe` True
+    -- chooses any other server
+    srv4 <- withAgentEnv c $ getNextServer c 1 proxySrvs [protoServer testOp1Srv1, protoServer testOp2Srv1]
+    liftIO $ srv4 == testOp1Srv2 || srv4 == testOp2Srv2 `shouldBe` True
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index 0bb050cbe..5e5f91b09 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -38,7 +38,7 @@ testSMPServer :: SMPServer
 testSMPServer = "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"
 
 testSMPServer2 :: SMPServer
-testSMPServer2 = "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5002"
+testSMPServer2 = "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@127.0.0.1:5002"
 
 testNtfServer :: NtfServer
 testNtfServer = "ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"
@@ -92,7 +92,7 @@ userServers :: NonEmpty (ProtocolServer p) -> Map UserId (NonEmpty (ServerCfg p)
 userServers = userServers' . L.map noAuthSrv
 
 userServers' :: NonEmpty (ProtoServerWithAuth p) -> Map UserId (NonEmpty (ServerCfg p))
-userServers' srvs = M.fromList [(1, L.map (presetServerCfg True) srvs)]
+userServers' srvs = M.fromList [(1, L.map (presetServerCfg True (ServerRoles True True) (Just 1)) srvs)]
 
 noAuthSrvCfg :: ProtocolServer p -> ServerCfg p
-noAuthSrvCfg = presetServerCfg True . noAuthSrv
+noAuthSrvCfg = presetServerCfg True (ServerRoles True True) (Just 1) . noAuthSrv
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 423b81074..d658c30a6 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -43,6 +43,9 @@ import Util
 testHost :: NonEmpty TransportHost
 testHost = "localhost"
 
+testHost2 :: NonEmpty TransportHost
+testHost2 = "127.0.0.1"
+
 testPort :: ServiceName
 testPort = "5001"
 
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index b1bf469a3..b827edda2 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -61,7 +61,7 @@ smpProxyTests = do
     xit "batching proxy requests" todo
   describe "deliver message via SMP proxy" $ do
     let srv1 = SMPServer testHost testPort testKeyHash
-        srv2 = SMPServer testHost testPort2 testKeyHash
+        srv2 = SMPServer testHost2 testPort2 testKeyHash
     describe "client API" $ do
       let maxLen = maxMessageLength encryptedBlockSMPVersion
       describe "one server" $ do
@@ -316,7 +316,7 @@ agentViaProxyVersionError :: IO ()
 agentViaProxyVersionError =
   withAgent 1 agentCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do
     Left (A.BROKER _ (TRANSPORT TEVersion)) <-
-      withAgent 2 agentCfg (servers [SMPServer testHost testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do
+      withAgent 2 agentCfg (servers [SMPServer testHost2 testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do
         (_bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
         aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
         A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe

From 601620bdde612ebdd33da2637d99b15ff32170c9 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Fri, 22 Nov 2024 19:50:04 +0000
Subject: [PATCH 195/195] 6.2.0.4

---
 simplexmq.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index cbdc7d66d..b3dcddb30 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           simplexmq
-version:        6.2.0.3
+version:        6.2.0.4
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and